Author Topic: Sierpinski Circled  (Read 604 times)

Offline bplus

  • Forum Resident
  • Posts: 3797
Sierpinski Circled
« on: April 04, 2018, 05:46:12 PM »
A new twist on an old fractal! Sierpinski generalized beyond the triangle to any regular poly (though does not work well above 8 or 9) also made dynamic.

Code: QB64: [Select]
  1. _TITLE "Sierepinski Circled by bplus 2018-04-04"
  2. CONST xmax = 800
  3. CONST ymax = 600
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  5. _SCREENMOVE 360, 60
  6. FOR n = 3 TO 8
  7.     a = 0
  8.     COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
  9.     WHILE a < _PI(2) - _PI(1 / 360)
  10.         CLS
  11.         a = a + _PI(1 / 360)
  12.         levels = 9 - n + 3
  13.         RecurringCircles xmax / 2, ymax / 2, ymax / 8, n, a, levels
  14.         _DISPLAY
  15.         _LIMIT 200
  16.     WEND
  17.     _DELAY 5
  18. SUB RecurringCircles (x, y, r, n, rao, level)
  19.     fcirc x, y, r
  20.     IF level > 0 THEN
  21.         ra = _PI(2) / n
  22.         FOR i = 0 TO n - 1
  23.             x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
  24.             y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
  25.             RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
  26.         NEXT
  27.     END IF
  28.  
  29. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  30. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  31.     DIM subRadius AS LONG, RadiusError AS LONG
  32.     DIM X AS LONG, Y AS LONG
  33.  
  34.     subRadius = ABS(R)
  35.     RadiusError = -subRadius
  36.     X = subRadius
  37.     Y = 0
  38.  
  39.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  40.  
  41.     ' Draw the middle span here so we don't draw it twice in the main loop,
  42.     ' which would be a problem with blending turned on.
  43.     LINE (CX - X, CY)-(CX + X, CY), , BF
  44.  
  45.     WHILE X > Y
  46.         RadiusError = RadiusError + Y * 2 + 1
  47.         IF RadiusError >= 0 THEN
  48.             IF X <> Y + 1 THEN
  49.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  50.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  51.             END IF
  52.             X = X - 1
  53.             RadiusError = RadiusError - X * 2
  54.         END IF
  55.         Y = Y + 1
  56.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  57.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  58.     WEND
  59.  

The screen shots are stationary stills of final (or start) position.

« Last Edit: April 04, 2018, 05:54:42 PM by bplus »

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 700
  • Savage.
    • Domum
Re: Sierpinski Circled
« Reply #1 on: April 04, 2018, 11:24:52 PM »
These are immensely satisfying to watch - didn't expect it to "snap" to a final result before ending. Nice nice!
An ounce of theory outweighs a pound of code.

Offline _vince

  • Forum Regular
  • Posts: 198
Re: Sierpinski Circled
« Reply #2 on: April 05, 2018, 12:22:55 AM »
Original concept? Really great

Offline bplus

  • Forum Resident
  • Posts: 3797
Re: Sierpinski Circled
« Reply #3 on: April 05, 2018, 01:44:07 AM »
Original concept? Really great

Thanks guys!

The idea of doing Sierpinski Triangles with circles has been on the back burner of my mind for some time and this afternoon, I sat down and got it going. It was so easy that I generalized to any n and running through angle offsets was also easy. I think it a great application for alpha coloring.

Original? It is so simple an idea, I am probably not first to come up with it but I haven't seen code for anything like this. 

Offline _vince

  • Forum Regular
  • Posts: 198
Re: Sierpinski Circled
« Reply #4 on: April 05, 2018, 10:58:25 AM »
made it into an animated gif

Offline Richard Frost

  • Forum Regular
  • Posts: 101
  • My spare wheel is cheese!
Re: Sierpinski Circled
« Reply #5 on: February 02, 2019, 09:56:51 PM »
Very pretty!

It could be titled "Snowflakes are Dancing", which is an old Isao Tomita electronic music album.
It's what I thought of when I first saw it.

Perhaps download that music and use it in the program, if that's legal where you live.
It works better if you plug it in.

Offline bplus

  • Forum Resident
  • Posts: 3797
Re: Sierpinski Circled
« Reply #6 on: February 02, 2019, 11:15:59 PM »
Ah Music! :)

'paste into browser Alan Parsons Project Mammagamma from Eye in Sky Album


' or whatever...


Code: QB64: [Select]
  1. _TITLE "Sierepinski Circled" ' by bplus 2018-04-04"
  2. '2019-02-02 mod random
  3.  
  4. CONST xmax = 740
  5. CONST ymax = 740
  6. SCREEN _NEWIMAGE(xmax, ymax, 32)
  7.  
  8. 'paste into browser Alan Parson Project Mammagamma from Eye in Sky Album
  9. '  [youtube]https://www.youtube.com/watch?v=XXzOkCLdFwI[/youtube]
  10.  
  11. ' or whatever...
  12.  
  13.     n = RND * 6 \ 1 + 3
  14.     a = 0
  15.     COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
  16.     WHILE a < _PI(2) - _PI(1 / 360)
  17.         CLS
  18.         a = a + _PI(1 / 360)
  19.         levels = 9 - n + 3
  20.         RecurringCircles xmax / 2, ymax / 2, ymax / 6, n, a, levels
  21.         _DISPLAY
  22.         _LIMIT 60
  23.     WEND
  24.     _DELAY 5
  25.  
  26. SUB RecurringCircles (x, y, r, n, rao, level)
  27.     fcirc x, y, r
  28.     IF level > 0 THEN
  29.         ra = _PI(2) / n
  30.         FOR i = 0 TO n - 1
  31.             x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
  32.             y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
  33.             RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
  34.         NEXT
  35.     END IF
  36.  
  37. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  38. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  39.     DIM subRadius AS LONG, RadiusError AS LONG
  40.     DIM X AS LONG, Y AS LONG
  41.  
  42.     subRadius = ABS(R)
  43.     RadiusError = -subRadius
  44.     X = subRadius
  45.     Y = 0
  46.  
  47.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  48.  
  49.     ' Draw the middle span here so we don't draw it twice in the main loop,
  50.     ' which would be a problem with blending turned on.
  51.     LINE (CX - X, CY)-(CX + X, CY), , BF
  52.  
  53.     WHILE X > Y
  54.         RadiusError = RadiusError + Y * 2 + 1
  55.         IF RadiusError >= 0 THEN
  56.             IF X <> Y + 1 THEN
  57.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  58.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  59.             END IF
  60.             X = X - 1
  61.             RadiusError = RadiusError - X * 2
  62.         END IF
  63.         Y = Y + 1
  64.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  65.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  66.     WEND
  67.  
  68.  
« Last Edit: February 02, 2019, 11:27:32 PM by bplus »