### Author Topic: Sierpinski Circled  (Read 710 times)

#### B+

• Hero Member
• Posts: 775
##### Sierpinski Circled
« on: 04. April 2018, 23:59:47 »
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 = 800CONST ymax = 600RANDOMIZE TIMERSCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60FOR 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 5NEXTSUB 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 IFEND SUB'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUBode]`
The screen shots are still shots of final positions (or start).
« Last Edit: 05. April 2018, 00:01:28 by B+ »

#### B+

• Hero Member
• Posts: 775
##### Re: Sierpinski Circled
« Reply #1 on: 22. July 2018, 02:06:25 »
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)radiansconstant:wW 700wH 700visible:pi# = acos#(-1.0)pi2# = 2.0 * pi#pip5# = pi# * 0.5pi360# = pi# / 360.0cx# = float(wW / 2)cy# = float(wH / 2)cr# = float(wH) / 6.0r#g#b#levelshidden:set window 100, 20, wW, wHset redraw falsefor 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    _pausenextprocedure 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    endifendprocprocedure pause()    set color 200, 225, 250    wln "Click mouse to continue..."    redraw    wait mousebuttonendproc`

#### B+

• Hero Member
• Posts: 775
##### Re: Sierpinski Circled
« Reply #2 on: 22. July 2018, 20:57:07 »
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!radiansconstant:wW 720wH 720shade 50visible:pi# = acos#(-1.0)pi2# = 2.0 * pi#pip5# = pi# * 0.5pi360# = pi# / 360.0cx# = float(wW / 2)cy# = float(wH / 2)cr# = float(wH) / 4.0ra#hidden:set window 100, 10, wW, wHset redraw falsefor 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 _pausenextprocedure 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 endifendprocprocedure pause() set caret 10, 10 set color 200, 225, 250 wln "Click mouse to continue..." redraw wait mousebuttonendproc`
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???
« Last Edit: 23. July 2018, 15:31:27 by B+ »

#### johnno56

• Newcomer
• Posts: 44
• Logic is the beginning of Wisdom.
##### Re: Sierpinski Circled
« Reply #3 on: 23. July 2018, 04:38:00 »
Cool...

J
May your journey be free of incident.

Live long and prosper.

#### ZXDunny

• Full Member
• Posts: 238
##### Re: Sierpinski Circled
« Reply #4 on: 23. July 2018, 13:26:22 »
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 n20 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 i30 end proc`
Which results in this:

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

#### ZXDunny

• Full Member
• Posts: 238
##### Re: Sierpinski Circled
« Reply #5 on: 23. July 2018, 13:34:32 »
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+

• Hero Member
• Posts: 775
##### Re: Sierpinski Circled
« Reply #6 on: 23. July 2018, 14:14:22 »
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 SmallBASICREM 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 circlefor 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 3000nextsub 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 ifend sub`
« Last Edit: 23. July 2018, 14:19:23 by B+ »