Sierpinski Circled

[B+]

Code: [Select]

A new twist on an old fractal. Sierpinski triangle generalized and made dynamic for any regular poly though does not work well beyond 8 or 9.
[c_TITLE "Sierepinski Circled by bplus 2018-04-04 QB64 v 11-06-2017"
CONST xmax = 800
CONST ymax = 600
RANDOMIZE TIMER
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
FOR n = 3 TO 8
    a = 0
    COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
    WHILE a < _PI(2) - _PI(1 / 360)
        CLS
        a = a + _PI(1 / 360)
        levels = 9 - n + 3
        RecurringCircles xmax / 2, ymax / 2, ymax / 8, n, a, levels
        _DISPLAY
        _LIMIT 200
    WEND
    _DELAY 5
NEXT
SUB RecurringCircles (x, y, r, n, rao, level)
    fcirc x, y, r
    IF level > 0 THEN
        ra = _PI(2) / n
        FOR i = 0 TO n - 1
            x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
            y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
            RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
        NEXT
    END IF
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB

ode]


The screen shots are still shots of final positions (or start).

[B+]

I have just completed a Naalaa version:

Code: [Select]

'Sierpinski circled.txt
' written for Naalaa 6 by bplus 2018-07-21
' translated from Sierepinski Circled.bas by bplus 2018-04-04 QB64 v 11-06-2017

' A new twist on an old fractal.
'  Sierpinski triangle generalized and made dynamic for any regular poly though does not work well beyond 8 or 9.

randomize time() + rnd(100)
radians
constant:
wW 700
wH 700
visible:
pi# = acos#(-1.0)
pi2# = 2.0 * pi#
pip5# = pi# * 0.5
pi360# = pi# / 360.0
cx# = float(wW / 2)
cy# = float(wH / 2)
cr# = float(wH) / 6.0
r#
g#
b#
levels
hidden:
set window 100, 20, wW, wH
set redraw false
for n = 3 to 8
'n = 3
    a# = 0.0
    r# = float(56 + rnd(200)); g# = float(56 + rnd(200)); b# = float#(56 + rnd(200))
    levels = 12 - n
    shade = 255
    while a# <= pi2#
        set color 0, 0, 0
        draw rect 0, 0, wW, wH, true
        _recurringCircles cx#, cy#, cr#, a#, n, levels
        a# = a# + pi360#
        redraw
        wait 1
 wend
    _pause
next

procedure recurringCircles (x#, y#, rr#, ao#, n, level)
    cf# = float(12 - level) / 12.0

    'try this with alpha maybe 50 but kind of dark and blurry
    'without alpha, too much overlap to show fine pattern detail
    set color int(r#*cf#), int(g#*cf#), int(b#*cf#), 50
    draw ellipse int(x), int(y), int(rr#), int(rr#), true
    if level > 0
        pi5# = pi# * 0.5
        ra# = pi2# / float(n)
        for i = 0 to n - 1
            x1# = x# + 1.5 * rr# * cos#(float(i) * ra# + ao# - pip5#)
            y1# = y# + 1.5 * rr# * sin#(float(i) * ra# + ao# - pip5#)
            _recurringCircles x1#, y1#, rr# * 0.5, 2.0 * ao#, n, level - 1
        next
    endif
endproc

procedure pause()
    set color 200, 225, 250
    wln "Click mouse to continue..."
    redraw
    wait mousebutton
endproc


[B+]

Turns out a different version of the recursive code was needed for Naalaa to produce the fine detailed still shot as show for QB64. Instead of making the 3 circles tangent to the inner, I made them overlap, their origins on the outer edge of the inner circle. What a difference in quality detail! Now on par with QB64 still shots:

Code: [Select]

'Sierpinski circled best yet.txt
' written for Naalaa 6 by bplus started 2018-07-22
' translated from Sierepinski Circled.bas by bplus 2018-04-04 QB64 v 11-06-2017

' A new twist on an old fractal.
'  Sierpinski triangle made from circles only, generalized and made dynamic
'  for any regular poly though does not work well beyond 8 or 9.

'2018-07-22 max brightness, slowed down in attempt to elimianate blurriness
'2018-07-22 best yet: have the new set of 3 circles overlap the interior, instead of tangent to interior circle
'2018-07-23 calculating a couple of variables too often in recursive sub, only need ra# once with each new n
' and pip5# was already done!

radians
constant:
wW 720
wH 720
shade 50

visible:
pi# = acos#(-1.0)
pi2# = 2.0 * pi#
pip5# = pi# * 0.5
pi360# = pi# / 360.0
cx# = float(wW / 2)
cy# = float(wH / 2)
cr# = float(wH) / 4.0
ra#

hidden:
set window 100, 10, wW, wH
set redraw false
for n = 3 to 8
a# = 0.0
ra# = pi2# / float(n)
levels = 12 - n
while a# < ra#
set color 0, 0, 0
draw rect 0, 0, wW, wH, true
_recurringCircles cx#, cy#, cr#, a#, n, levels
a# = a# + pi360#
redraw
wait 10
        wend
set color 0, 0, 0
draw rect 0, 0, wW, wH, true
_recurringCircles cx#, cy#, cr#, 0.0, n, levels
_pause
next

procedure recurringCircles (x#, y#, rr#, ao#, n, level)
set color 100, 255, 100, shade
draw ellipse int(x), int(y), int(rr#), int(rr#), true
if level > 0
for i = 0 to n - 1
x1# = x# + rr# * cos#(float(i) * ra# + ao# - pip5#)
y1# = y# + rr# * sin#(float(i) * ra# + ao# - pip5#)
_recurringCircles x1#, y1#, rr# * 0.5, 2.0 * ao#, n, level - 1
next
endif
endproc

procedure pause()
set caret 10, 10
set color 200, 225, 250
wln "Click mouse to continue..."
redraw
wait mousebutton
endproc

EDIT: 2018-07-23 A couple of code fixes to eliminate extra calculations being made in the recursive sub. ra# needs to be calculated only once per new n and don't know why pip5# was being calculated AGAIN in the sub???

[johnno56]

Cool...

J

[ZXDunny]

B+, could you take a look at my code? I tried translating it from the QB64 version to SpecBAS, but cannot figure what's going wrong. I suspect a bug in SpecBAS somewhere.

Code: [Select]

10 p3=pi/360,p5=pi*-.5:
 for n=3 to 8:
    a=0:
    do while a<tau-p3:
       cls:
       a+=p3:
       levels=9-n+3:
       proc r(scrw/2,scrh/2,scrh/6,n,a,levels):
       wait screen:
    loop:
 next n
20 def proc r(x,y,r,n,rao,level):
    circle x,y,r:
    if level>0 then
       ra=tau/n:
       for i=0 to n-1:
          x1=x+1.5*r*cos(i*ra+rao+p5),
          y1=y+1.5*r*sin(i*ra+rao+p5):
          proc r(x1,y1,r*.5,n,2*rao,level-1):
       next i
30 end proc

Which results in this:



Any ideas? And I know there's no alpha filling

[ZXDunny]

Never mind, fixed it

The variable i used in the FOR loop inside the proc is being treated as global, when it should be local to the proc. That's a bug, I think

[B+]

Hi D,

Yes, i has to be local to sub for recursion to work, but also x1 and y1? Nope, never mind about x1, y1.

Now that I look at the code, I see that ra might be calculated on the main level, instead of calculating over and over again in recursive sub routine.

Yes! Here it is tested in SmallBASIC which has NOT alpha coloring but does demand local variables be declared in sub routines. Without alpha, I just shaded the rgb value by the level value. Also it gets boring waiting for a complete rotation of the sierpinsky gears so I have it quit with one ra turn.

Code: [Select]

REM SmallBASIC
REM created: 21/07/2018
'translated from Sierepinski Circled by bplus 2018-04-04 for QB64 v1.2"
' this is really nice with alpha coloring specially at 5+
 
'2018-07-23 fixed ra calculation done only once per new n
' also let's just spin one ra instead of whole circle


for n = 3 to 8
  a = 0
  red = rnd * 155 + 100 : g = rnd * 155 + 100 : b = rnd * 155 + 100
  ra = 2 * pi / n  '<<<<<<<<<<<<  here once for each n
  while a < ra
    cls
    levels = 12 - n
    RecurringCircles xmax / 2, ymax / 2, ymax / 8, n, a, levels
    a += pi /360
    showpage
    delay 10
  wend
  delay 3000
next

sub RecurringCircles (x, y, r, n, rao, level)
  local i
  cf = (12 - level) / 12
  color rgb(cf * red, cf * g, cf * b)
  circle x, y, r filled
  if level > 0 then
    'ra = 2 * pi / n  '<<<<<<<<<<<<<<<<<<<<< not here, save a calculation!
    for i = 0 to n - 1
      x1 = x + 1.5 * r * cos(i * ra + rao + pi * -.5)
      y1 = y + 1.5 * r * sin(i * ra + rao + pi * -.5)
      RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
    next
  end if
end sub