Author Topic: Voronoi Diagram (Rosetta Code Task)  (Read 4749 times)

0 Members and 1 Guest are viewing this topic.

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Voronoi Diagram (Rosetta Code Task)
« on: April 13, 2021, 10:36:41 pm »
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
  4.  
  5. '=====================================================================
  6. ' Changes number of points and screen size here
  7. '=====================================================================
  8. pnt = 100
  9. px = 512
  10. py = 512
  11. '=====================================================================
  12. Screen _NewImage(px, py, 32)
  13.  
  14. Dim Shared As Integer pax(pnt), pay(pnt), indx(px, py)
  15. Dim Shared As Long dSqr(px, py)
  16. Dim As Long col(pnt)
  17.  
  18. For i = 1 To pnt
  19.     pax(i) = Int(Rnd * px)
  20.     pay(i) = Int(Rnd * py)
  21.     col(i) = _RGB(Rnd * 256, Rnd * 256, Rnd * 256)
  22. st = Timer
  23. For x = 0 To px - 1
  24.     For y = 0 To py - 1
  25.         dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
  26.         indx(x, y) = 1
  27.     Next
  28.  
  29. For i = 2 To pnt
  30.     ly = py - 1
  31.     For x = pax(i) To 0 Step -1
  32.         If (scan(i, x, ly)) = 0 Then Exit For
  33.     Next x
  34.     For x = pax(i) + 1 To px - 1
  35.         If (scan(i, x, ly)) = 0 Then Exit For
  36.     Next
  37.  
  38. For x = 0 To px - 1
  39.     For y = 0 To py - 1
  40.         sy = y
  41.         adjct = indx(x, y)
  42.         For y = y + 1 To py
  43.             If indx(x, y) <> adjct Then y = y - 1: Exit For
  44.         Next
  45.         Line (x, sy)-(x, y + 1), col(adjct)
  46.     Next
  47.  
  48.  
  49. Function scan (site As Integer, x As Integer, ly As Integer)
  50.     Dim As Integer ty
  51.     Dim As Long delt2, dsq
  52.     delt2 = (pax(site) - x) * (pax(site) - x)
  53.     For ty = 0 To ly
  54.         dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
  55.         If dsq <= dSqr(x, ty) Then
  56.             dSqr(x, ty) = dsq
  57.             indx(x, ty) = site
  58.             scan = 1
  59.         End If
  60.     Next
« Last Edit: April 13, 2021, 10:41:10 pm by AndyA »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #1 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)
  15.  
  16. For xx = 0 To sq
  17.     For yy = 0 To sq
  18.         d = xmx * ymx + 1
  19.         For i = 1 To points
  20.             a = x(i) - xx: b = y(i) - yy
  21.             q = a * a + b * b
  22.             If q < d Then d = q: kkl = i
  23.         Next
  24.         PSet (xx, yy), kl(kkl)
  25.     Next
  26.     _Display
  27.  
  28.  
  29.  

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.
« Last Edit: April 14, 2021, 04:17:49 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #2 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)
  16. For xx = 0 To sq
  17.     For yy = 0 To sq
  18.         d = xmx * ymx + 1
  19.         For i = 1 To points
  20.             a = x(i) - xx: b = y(i) - yy
  21.             q = a * a + b * b
  22.             If q < d Then d = q: kkl = i
  23.         Next
  24.         Line (xx, yy)-Step(0, 0), kl(kkl)
  25.     Next
  26.     _Display
  27.  
  28.  
  29.  

@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.
« Last Edit: April 14, 2021, 02:22:11 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #3 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
  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)
  14.  
  15. Dim Shared As Integer pax(pnt), pay(pnt), indx(px, py)
  16. Dim Shared As Long dSqr(px, py)
  17. Dim As Long col(pnt)
  18.  
  19. For i = 1 To pnt
  20.     pax(i) = Int(Rnd * px)
  21.     pay(i) = Int(Rnd * py)
  22.     col(i) = _RGB(pax(i) / px * 255, pay(i) / py * 255, (px - pax(i)) / px * 256)
  23. st = Timer
  24. For x = 0 To px - 1
  25.     For y = 0 To py - 1
  26.         dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
  27.         indx(x, y) = 1
  28.     Next
  29.  
  30. For i = 2 To pnt
  31.     ly = py - 1
  32.     For x = pax(i) To 0 Step -1
  33.         If (scan(i, x, ly)) = 0 Then Exit For
  34.     Next x
  35.     For x = pax(i) + 1 To px - 1
  36.         If (scan(i, x, ly)) = 0 Then Exit For
  37.     Next
  38.  
  39. For x = 0 To px - 1
  40.     For y = 0 To py - 1
  41.         sy = y
  42.         adjct = indx(x, y)
  43.         For y = y + 1 To py
  44.             If indx(x, y) <> adjct Then y = y - 1: Exit For
  45.         Next
  46.         Line (x, sy)-(x, y + 1), col(adjct)
  47.     Next
  48.  
  49.  
  50. Function scan (site As Integer, x As Integer, ly As Integer)
  51.     Dim As Integer ty
  52.     Dim As Long delt2, dsq
  53.     delt2 = (pax(site) - x) * (pax(site) - x)
  54.     For ty = 0 To ly
  55.         dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
  56.         If dsq <= dSqr(x, ty) Then
  57.             dSqr(x, ty) = dsq
  58.             indx(x, ty) = site
  59.             scan = 1
  60.         End If
  61.     Next
  62.  
  63.  

 
Voronoi.PNG
« Last Edit: April 14, 2021, 02:53:59 pm by bplus »

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #4 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.

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #5 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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #6 on: April 19, 2021, 12:34:58 pm »
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.

Offline Aurel

  • Forum Regular
  • Posts: 167
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #7 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?
VoronoiAndy.png
* VoronoiAndy.png (Filesize: 138.17 KB, Dimensions: 1171x828, Views: 283)
//////////////////////////////////////////////////////////////////
https://aurelsoft.ucoz.com
https://www.facebook.com/groups/470369984111370
//////////////////////////////////////////////////////////////////

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagram (Rosetta Code Task)
« Reply #8 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.

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.