Author Topic: Rose Patterns  (Read 4637 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Rose Patterns
« on: April 19, 2019, 11:54:57 pm »
An easy one, so I challenged myself to show a pattern only once.

Code: QB64: [Select]
  1. _TITLE "Rose Patterns for unique K values" 'started 2019-04-19 after viewing Shiffman's quicky
  2. ' coding Challenge #55
  3. ' [youtube]https://www.youtube.com/watch?v=f5QBExMNB1I&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=72
  4.  
  5. ' OK now try this without showing a k value twice, eg 1/2 = 2/4 = 3/6 = 4/8... just show .5 once!
  6.  
  7. CONST xmax = 800
  8. CONST ymax = 600
  9. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10.  
  11. ' don't show k values already shown, store k values shown in shownK() with nextKI for new K value
  12. REDIM SHARED shownK(1 TO 1000), nextKI
  13. nextKI = 1
  14.  
  15. 'review of equations
  16. n = 1
  17. d = 2
  18. k = n / d
  19. xc = xmax / 2
  20. yc = ymax / 2
  21. multiplier = 200
  22. WHILE d <= 25
  23.     WHILE n <= d
  24.         CLS
  25.         k = n / d
  26.         IF find(k) = 0 THEN
  27.             shownK(nextKI) = k
  28.             QSort 1, nextKI
  29.             nextKI = nextKI + 1
  30.             IF nextKI > UBOUND(shownK) THEN
  31.                 REDIM _PRESERVE shownK(1 TO UBOUND(shownK) + 1000)
  32.             END IF
  33.             FOR theta = 0 TO _PI(2) * d STEP .01
  34.                 'main equations, r, x, y updated with every new theta
  35.                 r = COS(k * theta)
  36.                 x = xc + multiplier * r * COS(theta)
  37.                 y = yc + multiplier * r * SIN(theta)
  38.                 IF theta > 0 THEN LINE (lastx, lasty)-(x, y)
  39.                 lastx = x: lasty = y
  40.             NEXT
  41.             PRINT "n ="; n; "  d ="; d; "  n/d = K ="; k
  42.             _DISPLAY
  43.             _LIMIT 1
  44.         END IF
  45.         n = n + 1
  46.     WEND
  47.     n = 1
  48.     d = d + 1
  49.  
  50.     'check the values being stored, OK looks good!
  51.     'IF d = 9 THEN 'dump shownK to check all unique numbers
  52.     '    CLS
  53.     '    FOR i = 1 TO nextKI - 1
  54.     '        PRINT i, shownK(i)
  55.     '        IF i MOD 30 = 0 THEN
  56.     '            INPUT "Peeking at shownK array,  press enter to cont...", wate$
  57.     '            CLS
  58.     '        END IF
  59.     '    NEXT
  60.     '    INPUT "OK finished peek of shownK array, press enter to cont...", wate$
  61.     '    CLS
  62.     'END IF
  63.  
  64. SUB QSort (Start, Finish) 'shownK needs to be shared array
  65.     i = Start
  66.     j = Finish
  67.     m = shownK(INT((i + j) / 2))
  68.     WHILE i <= j
  69.         WHILE shownK(i) < m
  70.             i = i + 1
  71.         WEND
  72.         WHILE shownK(j) > m
  73.             j = j - 1
  74.         WEND
  75.         IF i <= j THEN
  76.             l = shownK(i)
  77.             shownK(i) = shownK(j)
  78.             shownK(j) = l
  79.             i = i + 1
  80.             j = j - 1
  81.         END IF
  82.     WEND
  83.     IF j > Start THEN QSort Start, j
  84.     IF i < Finish THEN QSort i, Finish
  85.  
  86. FUNCTION find (x)
  87.     IF nextKI = 1 THEN EXIT FUNCTION
  88.     low = 1: hi = nextKI - 1
  89.     WHILE low <= hi
  90.         test = (low + hi) \ 2
  91.         IF shownK(test) = x THEN
  92.             find = test: EXIT FUNCTION
  93.         ELSE
  94.             IF shownK(test) < x THEN low = test + 1 ELSE hi = test - 1
  95.         END IF
  96.     WEND
  97.  
  98.  

So how would one color these?

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Rose Patterns
« Reply #1 on: April 20, 2019, 12:29:30 am »
Hi bplus!
Here's my one -
Code: QB64: [Select]
  1. 1 SCREEN _NEWIMAGE(600, 600, 32)
  2. 3 rr = RND * 300
  3. 4 d% = RND * 10 + 2
  4. 5 k = INT(RND * 10) / d%
  5. 6 xx = RND * _WIDTH
  6. 7 yy = RND * _HEIGHT
  7. 8 COLOR _RGB(RND * 256, RND * 256, RND * 256)
  8. 9 FOR i = 0 TO d% * 2 * _PI STEP .1
  9.    10 r = COS(k * i) + rr
  10.    11 LINE (r * COS(k * i) * COS(i) + xx, r * COS(k * i) * SIN(i) + yy)-(r * COS(k * (i + .1)) * COS(i + .1) + xx, r * COS(k * (i + .1)) * SIN(i + .1) + yy)
  11. 12 NEXT
  12. 13 LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 100), BF
  13. 14 _DELAY .1
  14. 15 GOTO 3
  15.  
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rose Patterns
« Reply #2 on: April 20, 2019, 09:30:59 am »
Hi Ashish,

Line numbers!? Ha! reminds me of the dream last night I had trying to figure out how to color these. :)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rose Patterns
« Reply #3 on: April 20, 2019, 12:07:14 pm »
Now with Coloring:
Code: QB64: [Select]
  1. _TITLE "Rose Patterns with Coloring 2" 'started 2019-04-20
  2. ' coding Challenge #55
  3. ' [youtube]https://www.youtube.com/watch?v=f5QBExMNB1I&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=72
  4.  
  5. ' OK now try this without showing a k value twice, eg 1/2 = 2/4 = 3/6 = 4/8... just show .5 once!
  6. '2019-04-20 with Coloring, by thic lines, well yuck so far trying to taper line back to xc,yc yuck 2
  7. ' try expanding / contracting  multiplier, hell no!
  8. '2019-04-20 with Coloring 2, OK alpha coloring is working well.
  9.  
  10.  
  11. CONST xmax = 800
  12. CONST ymax = 600
  13. SCREEN _NEWIMAGE(xmax, ymax, 32)
  14.  
  15. ' don't show k values already shown, store k values shown in shownK() with nextKI for new K value
  16. REDIM SHARED shownK(1 TO 1000), nextKI
  17. nextKI = 1
  18.  
  19. 'review of equations
  20. n = 1
  21. d = 2
  22. k = n / d
  23. xc = xmax / 2
  24. yc = ymax / 2
  25. multiplier = 200
  26. WHILE d <= 25
  27.     WHILE n <= d
  28.         CLS
  29.         k = n / d
  30.         IF find(k) = 0 THEN
  31.             shownK(nextKI) = k
  32.             QSort 1, nextKI
  33.             nextKI = nextKI + 1
  34.             IF nextKI > UBOUND(shownK) THEN
  35.                 REDIM _PRESERVE shownK(1 TO UBOUND(shownK) + 1000)
  36.             END IF
  37.             cnt = 0: dir = 1
  38.             FOR theta = 0 TO _PI(2) * d STEP .01
  39.                 'main equations, r, x, y updated with every new theta
  40.                 cnt = cnt + dir
  41.                 IF cnt > 255 THEN cnt = 254: dir = -1
  42.                 IF cnt < 0 THEN cnt = 1: dir = 1
  43.                 r = COS(k * theta)
  44.                 x = xc + multiplier * r * COS(theta)
  45.                 y = yc + multiplier * r * SIN(theta)
  46.                 thic2 xc, yc, x, y, 2, _RGBA32(185, 0, 50, 80)
  47.             NEXT
  48.             PRINT "n ="; n; "  d ="; d; "  n/d = K ="; k
  49.             _DISPLAY
  50.             _LIMIT 1
  51.         END IF
  52.  
  53.         n = n + 1
  54.     WEND
  55.     n = 1
  56.     d = d + 1
  57.  
  58.     'check the values being stored, OK looks good!
  59.     'IF d = 9 THEN 'dump shownK to check all unique numbers
  60.     '    CLS
  61.     '    FOR i = 1 TO nextKI - 1
  62.     '        PRINT i, shownK(i)
  63.     '        IF i MOD 30 = 0 THEN
  64.     '            INPUT "Peeking at shownK array,  press enter to cont...", wate$
  65.     '            CLS
  66.     '        END IF
  67.     '    NEXT
  68.     '    INPUT "OK finished peek of shownK array, press enter to cont...", wate$
  69.     '    CLS
  70.     'END IF
  71.  
  72. SUB QSort (Start, Finish) 'shownK needs to be shared array
  73.     i = Start
  74.     j = Finish
  75.     m = shownK(INT((i + j) / 2))
  76.     WHILE i <= j
  77.         WHILE shownK(i) < m
  78.             i = i + 1
  79.         WEND
  80.         WHILE shownK(j) > m
  81.             j = j - 1
  82.         WEND
  83.         IF i <= j THEN
  84.             l = shownK(i)
  85.             shownK(i) = shownK(j)
  86.             shownK(j) = l
  87.             i = i + 1
  88.             j = j - 1
  89.         END IF
  90.     WEND
  91.     IF j > Start THEN QSort Start, j
  92.     IF i < Finish THEN QSort i, Finish
  93.  
  94. FUNCTION find (x)
  95.     IF nextKI = 1 THEN EXIT FUNCTION
  96.     low = 1: hi = nextKI - 1
  97.     WHILE low <= hi
  98.         test = (low + hi) \ 2
  99.         IF shownK(test) = x THEN
  100.             find = test: EXIT FUNCTION
  101.         ELSE
  102.             IF shownK(test) < x THEN low = test + 1 ELSE hi = test - 1
  103.         END IF
  104.     WEND
  105.  
  106. SUB thic2 (x1, y1, x2, y2, rThick, K AS _UNSIGNED LONG)
  107.     'x1, y1 is one endpoint of line
  108.     'x2, y2 is the other endpoint of the line
  109.     'rThick is the radius of the tiny circles that will be drawn
  110.     '   from one end point to the other to create the thick line
  111.     'Yes, the line will then extend beyond the endpoints with circular ends.
  112.     rThick = INT(rThick / 2): stepx = x2 - x1: stepy = y2 - y1
  113.     length = INT((stepx ^ 2 + stepy ^ 2) ^ .5)
  114.     IF length THEN
  115.         dx = stepx / length: dy = stepy / length
  116.         FOR i = 0 TO length
  117.             IF i = length THEN
  118.                 fcirc x1 + dx * i, y1 + dy * i, 2, K
  119.             ELSE
  120.                 fcirc x1 + dx * i, y1 + dy * i, rThick, _RGBA32(235, 0, 110, 18)
  121.             END IF
  122.         NEXT
  123.     ELSE
  124.         fcirc x1, y1, rThick, K
  125.     END IF
  126.  
  127. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  128.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  129.     DIM X AS INTEGER, Y AS INTEGER
  130.  
  131.     Radius = ABS(R)
  132.     RadiusError = -Radius
  133.     X = Radius
  134.     Y = 0
  135.  
  136.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  137.  
  138.     ' Draw the middle span here so we don't draw it twice in the main loop,
  139.     ' which would be a problem with blending turned on.
  140.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  141.  
  142.     WHILE X > Y
  143.         RadiusError = RadiusError + Y * 2 + 1
  144.         IF RadiusError >= 0 THEN
  145.             IF X <> Y + 1 THEN
  146.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  147.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  148.             END IF
  149.             X = X - 1
  150.             RadiusError = RadiusError - X * 2
  151.         END IF
  152.         Y = Y + 1
  153.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  154.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  155.     WEND
  156.  
  157.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rose Patterns
« Reply #4 on: April 20, 2019, 12:55:23 pm »
One more slight mod:
Code: QB64: [Select]
  1. _TITLE "Rose Patterns with Coloring 3" 'started 2019-04-20
  2. ' coding Challenge #55
  3. ' [youtube]https://www.youtube.com/watch?v=f5QBExMNB1I&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=72
  4.  
  5. ' OK now try this without showing a k value twice, eg 1/2 = 2/4 = 3/6 = 4/8... just show .5 once!
  6. '2019-04-20 with Coloring, by thic lines, well yuck so far trying to taper line back to xc,yc yuck 2
  7. ' try expanding / contracting  multiplier, hell no!
  8. '2019-04-20 with Coloring 2, OK alpha coloring is working well.
  9. '2019-04-20 with Coloring 3, how about some yellow in center?
  10.  
  11.  
  12. CONST xmax = 800
  13. CONST ymax = 600
  14. SCREEN _NEWIMAGE(xmax, ymax, 32)
  15.  
  16. ' don't show k values already shown, store k values shown in shownK() with nextKI for new K value
  17. REDIM SHARED shownK(1 TO 1000), nextKI
  18. nextKI = 1
  19.  
  20. 'review of equations
  21. n = 1
  22. d = 2
  23. k = n / d
  24. xc = xmax / 2
  25. yc = ymax / 2
  26. multiplier = 200
  27. WHILE d <= 25
  28.     WHILE n <= d
  29.         CLS
  30.         k = n / d
  31.         IF find(k) = 0 THEN
  32.             shownK(nextKI) = k
  33.             QSort 1, nextKI
  34.             nextKI = nextKI + 1
  35.             IF nextKI > UBOUND(shownK) THEN
  36.                 REDIM _PRESERVE shownK(1 TO UBOUND(shownK) + 1000)
  37.             END IF
  38.             cnt = 0: dir = 1
  39.             FOR theta = 0 TO _PI(2) * d STEP .01
  40.                 'main equations, r, x, y updated with every new theta
  41.                 cnt = cnt + dir
  42.                 IF cnt > 255 THEN cnt = 254: dir = -1
  43.                 IF cnt < 0 THEN cnt = 1: dir = 1
  44.                 r = COS(k * theta)
  45.                 x = xc + multiplier * r * COS(theta)
  46.                 y = yc + multiplier * r * SIN(theta)
  47.                 thic2 xc, yc, x, y, 2, _RGBA32(185, 0, 50, 80)
  48.             NEXT
  49.             PRINT "n ="; n; "  d ="; d; "  n/d = K ="; k
  50.             _DISPLAY
  51.             _LIMIT 1
  52.         END IF
  53.  
  54.         n = n + 1
  55.     WEND
  56.     n = 1
  57.     d = d + 1
  58.  
  59.     'check the values being stored, OK looks good!
  60.     'IF d = 9 THEN 'dump shownK to check all unique numbers
  61.     '    CLS
  62.     '    FOR i = 1 TO nextKI - 1
  63.     '        PRINT i, shownK(i)
  64.     '        IF i MOD 30 = 0 THEN
  65.     '            INPUT "Peeking at shownK array,  press enter to cont...", wate$
  66.     '            CLS
  67.     '        END IF
  68.     '    NEXT
  69.     '    INPUT "OK finished peek of shownK array, press enter to cont...", wate$
  70.     '    CLS
  71.     'END IF
  72.  
  73. SUB QSort (Start, Finish) 'shownK needs to be shared array
  74.     i = Start
  75.     j = Finish
  76.     m = shownK(INT((i + j) / 2))
  77.     WHILE i <= j
  78.         WHILE shownK(i) < m
  79.             i = i + 1
  80.         WEND
  81.         WHILE shownK(j) > m
  82.             j = j - 1
  83.         WEND
  84.         IF i <= j THEN
  85.             l = shownK(i)
  86.             shownK(i) = shownK(j)
  87.             shownK(j) = l
  88.             i = i + 1
  89.             j = j - 1
  90.         END IF
  91.     WEND
  92.     IF j > Start THEN QSort Start, j
  93.     IF i < Finish THEN QSort i, Finish
  94.  
  95. FUNCTION find (x)
  96.     IF nextKI = 1 THEN EXIT FUNCTION
  97.     low = 1: hi = nextKI - 1
  98.     WHILE low <= hi
  99.         test = (low + hi) \ 2
  100.         IF shownK(test) = x THEN
  101.             find = test: EXIT FUNCTION
  102.         ELSE
  103.             IF shownK(test) < x THEN low = test + 1 ELSE hi = test - 1
  104.         END IF
  105.     WEND
  106.  
  107. SUB thic2 (x1, y1, x2, y2, rThick, K AS _UNSIGNED LONG)
  108.     'x1, y1 is one endpoint of line
  109.     'x2, y2 is the other endpoint of the line
  110.     'rThick is the radius of the tiny circles that will be drawn
  111.     '   from one end point to the other to create the thick line
  112.     'Yes, the line will then extend beyond the endpoints with circular ends.
  113.     rThick = INT(rThick / 2): stepx = x2 - x1: stepy = y2 - y1
  114.     length = INT((stepx ^ 2 + stepy ^ 2) ^ .5)
  115.     IF length THEN
  116.         dx = stepx / length: dy = stepy / length
  117.         FOR i = 0 TO length
  118.             IF i = length THEN
  119.                 fcirc x1 + dx * i, y1 + dy * i, 2, K
  120.             ELSEIF i <= .4 * length THEN
  121.                 fcirc x1 + dx * i, y1 + dy * i, rThick, _RGBA32(255, 255, 0, 3)
  122.             ELSE
  123.                 fcirc x1 + dx * i, y1 + dy * i, rThick, _RGBA32(235, 0, 110, 18)
  124.             END IF
  125.         NEXT
  126.     ELSE
  127.         fcirc x1, y1, rThick, K
  128.     END IF
  129.  
  130. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  131.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  132.     DIM X AS INTEGER, Y AS INTEGER
  133.  
  134.     Radius = ABS(R)
  135.     RadiusError = -Radius
  136.     X = Radius
  137.     Y = 0
  138.  
  139.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  140.  
  141.     ' Draw the middle span here so we don't draw it twice in the main loop,
  142.     ' which would be a problem with blending turned on.
  143.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  144.  
  145.     WHILE X > Y
  146.         RadiusError = RadiusError + Y * 2 + 1
  147.         IF RadiusError >= 0 THEN
  148.             IF X <> Y + 1 THEN
  149.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  150.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  151.             END IF
  152.             X = X - 1
  153.             RadiusError = RadiusError - X * 2
  154.         END IF
  155.         Y = Y + 1
  156.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  157.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  158.     WEND
  159.  
  160.  

Sometimes it works:
 
Rose Patterns with Coloring #3.PNG

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Rose Patterns
« Reply #5 on: April 20, 2019, 05:52:06 pm »
Hi Bplus
Hi Ashish
yes math is beautiful!
Programming isn't difficult, only it's  consuming time and coffee

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Rose Patterns
« Reply #6 on: October 29, 2019, 12:37:58 pm »
Awesome flowers bplus! Sometimes I wonder what people have made for the years that I didn't know about QB64.