Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: AndyA on April 13, 2021, 10:36:41 pm

Title: Voronoi Diagram (Rosetta Code Task)
Post by: AndyA on April 13, 2021, 10:36:41 pm
https://rosettacode.org/wiki/Voronoi_diagram  (https://rosettacode.org/wiki/Voronoi_diagram)

'======================================
Rosetta Code Task:
Task
Demonstrate how to generate and display a Voronoi diagram.
'======================================

[begin edit] This is a very fast way to draw a Voronoi Diagram. For small diagrams
100 points on 400x400 pixel canvas take about 400 milliseconds. I scales well, for 2000 points on a 1024x1024 canvas its take about 1000 milliseconds. [end of edit]

Code: QB64: [Select]
  1. _Title "Voronoi Diagram"
  2.  
  3. Dim As Integer pnt, px, py, i, x, y, adjct, sy, ly
  5.  
  6. '=====================================================================
  7. ' Changes number of points and screen size here
  8. '=====================================================================
  9. pnt = 100
  10. px = 512
  11. py = 512
  12. '=====================================================================
  13. Screen _NewImage(px, py, 32)
  15.  
  16. Dim Shared As Integer pax(pnt), pay(pnt), indx(px, py)
  17. Dim Shared As Long dSqr(px, py)
  18. Dim As Long col(pnt)
  19.  
  20. For i = 1 To pnt
  21.     pax(i) = Int(Rnd * px)
  22.     pay(i) = Int(Rnd * py)
  23.     col(i) = _RGB(Rnd * 256, Rnd * 256, Rnd * 256)
  25. st = Timer
  26. For x = 0 To px - 1
  27.     For y = 0 To py - 1
  28.         dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
  29.         indx(x, y) = 1
  30.     Next
  32.  
  33. For i = 2 To pnt
  34.     ly = py - 1
  35.     For x = pax(i) To 0 Step -1
  36.         If (scan(i, x, ly)) = 0 Then Exit For
  37.     Next x
  38.     For x = pax(i) + 1 To px - 1
  39.         If (scan(i, x, ly)) = 0 Then Exit For
  40.     Next
  42.  
  43. For x = 0 To px - 1
  44.     For y = 0 To py - 1
  45.         sy = y
  46.         adjct = indx(x, y)
  47.         For y = y + 1 To py
  48.             If indx(x, y) <> adjct Then y = y - 1: Exit For
  49.         Next
  50.         Line (x, sy)-(x, y + 1), col(adjct)
  51.     Next
  53.  
  56.  
  57. Function scan (site As Integer, x As Integer, ly As Integer)
  58.     Dim As Integer ty
  59.     Dim As Long delt2, dsq
  60.     delt2 = (pax(site) - x) * (pax(site) - x)
  61.     For ty = 0 To ly
  62.         dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
  63.         If dsq <= dSqr(x, ty) Then
  64.             dSqr(x, ty) = dsq
  65.             indx(x, ty) = site
  66.             scan = 1
  67.         End If
  68.     Next
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: bplus on April 14, 2021, 01:27:58 pm
Well this one could be jazzed up a little nicer:
Code: QB64: [Select]
  1. _Title "Golden Angle Spiral Voronoi"
  2. 'Golden angle Vorornoi.bas for SmallBASIC 2015-10-16 MGA/B+
  3.  
  4. Const xmx = 640
  5. Const ymx = 640
  6.  
  7. Screen _NewImage(xmx, ymx, 32)
  8. sq = ymx: s2 = sq / 2: points = 1200: ga = 137.5: mx = Sqr((xmx - s2) ^ 2 + (mxy - s2) ^ 2) - 100
  9. Dim x(1 To points), y(1 To points), kl(1 To points) As _Unsigned Long
  10. scale = sq * 10 / 640
  11. For n = 1 To points
  12.     x(n) = s2 + scale * Sqr(n) * Cos(_D2R(n * ga))
  13.     y(n) = s2 + scale * Sqr(n) * Sin(_D2R(n * ga))
  14.     kl(n) = _RGB32(255 - 255 * Sqr((s2 - x(n)) ^ 2 + (s2 - y(n)) ^ 2) / mx, 255 - 255 * Sqr((s2 - x(n)) ^ 2 + (s2 - y(n)) ^ 2) / mx, 0)
  16.  
  17. For xx = 0 To sq
  18.     For yy = 0 To sq
  19.         d = xmx * ymx + 1
  20.         For i = 1 To points
  21.             a = x(i) - xx: b = y(i) - yy
  22.             q = a * a + b * b
  23.             If q < d Then d = q: kkl = i
  24.         Next
  25.         PSet (xx, yy), kl(kkl)
  26.     Next
  27.     _Display
  29.  
  30.  
  31.  

Might try a couple of tricks to speed up too, I could use Longs and Line, When comparing distances I know dont have to do SQR, if one > than another then SQR will be also.
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: bplus on April 14, 2021, 02:14:56 pm
Yeah switching to default Long made huge difference, Line? Not as much:
Code: QB64: [Select]
  1. _Title "Golden Angle Spiral Voronoi 2 Faster" 'b+ mod 2021-04-14    
  2. 'Golden angle Vorornoi.bas for SmallBASIC 2015-10-16 MGA/B+
  3. DefLng A-Z
  4. Const xmx = 640, ymx = 640, sq = ymx, s2 = 320, points = 1200, ga = 137.5
  5.  
  6. Screen _NewImage(xmx, ymx, 32)
  7. mx = Sqr((xmx - s2) ^ 2 + (mxy - s2) ^ 2) - 50
  8.  
  9. ' setup spiral points for Voronoi app
  10. Dim x(1 To points), y(1 To points), kl(1 To points) As _Unsigned Long
  11. scale = sq * 10 / 640
  12. For n = 1 To points
  13.     x(n) = s2 + scale * Sqr(n) * Cos(_D2R(n * ga))
  14.     y(n) = s2 + scale * Sqr(n) * Sin(_D2R(n * ga))
  15.     kl(n) = _RGB32(255 - 255 * Sqr((s2 - x(n)) ^ 2 + (s2 - y(n)) ^ 2) / mx, 255 - 255 * Sqr((s2 - x(n)) ^ 2 + (s2 - y(n)) ^ 2) / mx, 0)
  17. For xx = 0 To sq
  18.     For yy = 0 To sq
  19.         d = xmx * ymx + 1
  20.         For i = 1 To points
  21.             a = x(i) - xx: b = y(i) - yy
  22.             q = a * a + b * b
  23.             If q < d Then d = q: kkl = i
  24.         Next
  25.         Line (xx, yy)-Step(0, 0), kl(kkl)
  26.     Next
  27.     _Display
  29.  
  30.  
  31.  

@AndyA  OK something you are doing is faster, I made points same as yours and screen same as mine and your ugly thing is still faster LOL! I don't think difference is the setup but might be.
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: bplus on April 14, 2021, 02:33:59 pm
Well this at least fixes the ugliness of color choices:
Code: QB64: [Select]
  1. _Title "Voronoi Diagram" ' Andy's is faster than mine 2021-04-14 but I color better :)
  2. '  https://www.qb64.org/forum/index.php?topic=3813.msg131679#msg131679
  3.  
  4. Dim As Integer pnt, px, py, i, x, y, adjct, sy, ly
  6.  
  7. '=====================================================================
  8. ' Changes number of points and screen size here
  9. '=====================================================================
  10. pnt = 100
  11. px = 512
  12. py = 512
  13. '=====================================================================
  14. Screen _NewImage(px, py, 32)
  16.  
  17. Dim Shared As Integer pax(pnt), pay(pnt), indx(px, py)
  18. Dim Shared As Long dSqr(px, py)
  19. Dim As Long col(pnt)
  20.  
  21. For i = 1 To pnt
  22.     pax(i) = Int(Rnd * px)
  23.     pay(i) = Int(Rnd * py)
  24.     col(i) = _RGB(pax(i) / px * 255, pay(i) / py * 255, (px - pax(i)) / px * 256)
  26. st = Timer
  27. For x = 0 To px - 1
  28.     For y = 0 To py - 1
  29.         dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
  30.         indx(x, y) = 1
  31.     Next
  33.  
  34. For i = 2 To pnt
  35.     ly = py - 1
  36.     For x = pax(i) To 0 Step -1
  37.         If (scan(i, x, ly)) = 0 Then Exit For
  38.     Next x
  39.     For x = pax(i) + 1 To px - 1
  40.         If (scan(i, x, ly)) = 0 Then Exit For
  41.     Next
  43.  
  44. For x = 0 To px - 1
  45.     For y = 0 To py - 1
  46.         sy = y
  47.         adjct = indx(x, y)
  48.         For y = y + 1 To py
  49.             If indx(x, y) <> adjct Then y = y - 1: Exit For
  50.         Next
  51.         Line (x, sy)-(x, y + 1), col(adjct)
  52.     Next
  54.  
  57.  
  58. Function scan (site As Integer, x As Integer, ly As Integer)
  59.     Dim As Integer ty
  60.     Dim As Long delt2, dsq
  61.     delt2 = (pax(site) - x) * (pax(site) - x)
  62.     For ty = 0 To ly
  63.         dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
  64.         If dsq <= dSqr(x, ty) Then
  65.             dSqr(x, ty) = dsq
  66.             indx(x, ty) = site
  67.             scan = 1
  68.         End If
  69.     Next
  71.  
  72.  

 
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: AndyA on April 14, 2021, 05:44:38 pm
Nice colors, but I'm trying to keep the code as simple as possibe, yet finish the task as stated. Besides, there's no way to post a screen output. It seems that Rosetta has removed that option.
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: _vince on April 19, 2021, 09:57:09 am
Nice, I bet this is much harder to do if you were to draw the polygons with just LINEs, not filling in
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: bplus on April 19, 2021, 12:34:58 pm
Quote from: _vince on April 19, 2021, 09:57:09 am
Nice, I bet this is much harder to do if you were to draw the polygons with just LINEs, not filling in

Is nice and fast, still trying to figure out why?

You know this might be fun to figure out the polys after drawing the Voronoi as that is what creates them.
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: Aurel on April 19, 2021, 02:11:51 pm
Yes Mark your have little bit more smooth colors..!!
I finally update to 1.5v yeah it work fine 32bit version on my win7 machine !!
Huh..i become lazy to change syntax with old 1.3v ...
I am wondering is there a way to build it without array ?

PS..I never asked is anyone maybe interested to use editor ,work solid with multiple tabs?
Title: Re: Voronoi Diagram (Rosetta Code Task)
Post by: bplus on April 19, 2021, 02:19:53 pm
These Voronoi patterns remind me of the ancient stone blocks of walls or buildings that use no mortar and have no spaces in between that you could slip paper between one block and another, these constructions that puzzle engineers of today.

Quote from: Aurel on April 19, 2021, 02:11:51 pm
Yes Mark your have little bit more smooth colors..!!
I finally update to 1.5v yeah it work fine 32bit version on my win7 machine !!
Huh..i become lazy to change syntax with old 1.3v ...
I am wondering is there a way to build it without array ?

PS..I never asked is anyone maybe interested to use editor ,work solid with multiple tabs?

Without array for the points? Yeah you could list points individually but I am far too lazy for that! LOL

Tabs for IDE, yeah that would be great! Steve (SMcNeill) gave us a link for an app to do that but if you have something I am sure there will be interest.

RhoSigma working with Notepad++ for that feature and plenty of others (Spellchecker, folding...) Alas, I miss syntax checking that QB64 IDE offers.
Text Only | Text with Attachments