Author Topic: Voronoi Diagrams with points and region outlines  (Read 4463 times)

0 Members and 1 Guest are viewing this topic.

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Voronoi Diagrams with points and region outlines
« on: April 19, 2021, 03:42:14 pm »
Here's the code I should have posted. It shows the point locations and region outlines.


Code: QB64: [Select]
  1. _Title "Voronoi Diagram [RC]"
  2.  
  3. Dim As Integer sites, xEdge, yEdge, i, x, y, nearest, startX, startY, endY
  4. Dim As Double startTime
  5.  
  6. '=====================================================================
  7. ' Changes number of sites and screen size here
  8. '=====================================================================
  9. sites = 100
  10. xEdge = 700
  11. yEdge = 700
  12. '=====================================================================
  13.  
  14. Screen _NewImage(xEdge, yEdge, 32)
  15. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
  16.  
  17. '_FullScreen _SquarePixels
  18. 'Randomize 0.14159
  19.  
  20. Dim Shared As Integer townX(sites), townY(sites), nearestIndex(xEdge, yEdge)
  21. Dim Shared As Long dist(xEdge, yEdge)
  22. Dim As Long col(sites)
  23.  
  24. For i = 1 To sites
  25.     townX(i) = Int(Rnd * xEdge)
  26.     townY(i) = Int(Rnd * yEdge)
  27.     col(i) = _RGB(Rand(0, 255), Rand(0, 255), Rand(0, 255))
  28.     'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  29.  
  30. startTime = Timer(.001)
  31. 'fill distance table with squared distances from the first site
  32. For x = 0 To xEdge - 1
  33.     For y = 0 To yEdge - 1
  34.         'store the distance squared between sites in dist() array to avoid SQR()
  35.         dist(x, y) = (townX(1) - x) * (townX(1) - x) + (townY(1) - y) * (townY(1) - y)
  36.         nearestIndex(x, y) = 1
  37.     Next
  38.  
  39. 'for all the other sites
  40. For i = 2 To sites
  41.     endY = yEdge - 1
  42.     'check left side
  43.     For x = townX(i) To 0 Step -1
  44.         If (checkRow(i, x, endY)) = 0 Then Exit For
  45.     Next x
  46.     'check right side
  47.     For x = townX(i) + 1 To xEdge - 1
  48.         If (checkRow(i, x, endY)) = 0 Then Exit For
  49.     Next
  50.  
  51. 'fill in region colors and draw region outlines
  52. For y = 0 To yEdge - 1
  53.     For x = 0 To xEdge - 1
  54.         startX = x
  55.         nearest = nearestIndex(x, y)
  56.         For x = x + 1 To xEdge
  57.             If nearestIndex(x, y) <> nearest Then x = x - 1: Exit For
  58.         Next
  59.         Line (startX, y)-(x + 1, y), col(nearest)
  60.         'draw region outline x locations
  61.         PSet (startX, y), &HFF000000
  62.         PSet (x + 1, y), &HFF000000
  63.     Next
  64.  
  65. For x = 0 To xEdge - 1
  66.     For y = 0 To yEdge - 1
  67.         startY = y
  68.         nearest = nearestIndex(x, y)
  69.         For y = y + 1 To yEdge
  70.             If nearestIndex(x, y) <> nearest Then y = y - 1: Exit For
  71.         Next
  72.         'draw region outline y locations
  73.         PSet (x, startY), &HFF000000
  74.         PSet (x, y + 1), &HFF000000
  75.     Next
  76.  
  77. showSites = 1
  78. If showSites = 1 Then
  79.     'show the original random sites after regions are filled
  80.     'Draw a 4 pixel circle at each of the random points in px(), py() arrays
  81.     For i = 1 To sites
  82.         Call CircleFill(townX(i), townY(i), 2, &HFF000000)
  83.     Next
  84.     Line (0, 0)-(xEdge - 1, yEdge - 1), &HFF000000, B
  85.  
  86.  
  87. Color &HFFFFFFFF
  88. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
  89.  
  90. Function checkRow (site%, x, endY)
  91.     dxSquared& = (townX(site%) - x) * (townX(site%) - x)
  92.     For yt% = 0 To endY
  93.         dSquared& = (townY(site%) - yt%) * (townY(site%) - yt%) + dxSquared&
  94.         If dSquared& <= dist(x, yt%) Then
  95.             dist(x, yt%) = dSquared&
  96.             nearestIndex(x, yt%) = site%
  97.             checkRow = 1
  98.         End If
  99.     Next
  100.  
  101. Function Rand% (lo%, hi%)
  102.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
  103.  
  104. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  105.     '=============================
  106.     '  CX = center x coordinate
  107.     '  CY = center y coordinate
  108.     '   R = radius
  109.     '   C = fill color
  110.     '=============================
  111.     Dim As Integer Radius, RadiusError, X, Y
  112.     Radius = Abs(R)
  113.     RadiusError = -Radius
  114.     X = Radius
  115.     Y = 0
  116.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  117.     Line (CX - X, CY)-(CX + X, CY), C, BF
  118.     While X > Y
  119.         RadiusError = RadiusError + Y * 2 + 1
  120.         If RadiusError >= 0 Then
  121.             If X <> Y + 1 Then
  122.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  123.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  124.             End If
  125.             X = X - 1
  126.             RadiusError = RadiusError - X * 2
  127.         End If
  128.         Y = Y + 1
  129.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  130.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  131.     Wend
  132.  
  133.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagrams with points and region outlines
« Reply #1 on: April 19, 2021, 04:50:08 pm »
Wow, you're doing this with edges, missed that trying to figure the other code. It is faster alright!

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Re: Voronoi Diagrams with points and region outlines
« Reply #2 on: April 19, 2021, 04:56:21 pm »
It's the same as the code posted on Rosetta. It just has the points and the outlines tacked on, which is more code, but time difference is negligible.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagrams with points and region outlines
« Reply #3 on: April 21, 2021, 01:47:15 pm »
Aha! This gives me inkling why this is faster, I am showing what CheckRow is doing
Code: QB64: [Select]
  1. _Title "Voronoi Diagram [RC]" ' AndyA https://www.qb64.org/forum/index.php?topic=3831.msg131791#msg131791
  2. ' 2021-04-20 b+ mod in attempt to make things clearer, showing how check row is working
  3.  
  4. Dim As Integer sites, xEdge, yEdge, i, x, y, nearest, startX, startY, endY
  5. Dim As Double startTime
  6.  
  7. '=====================================================================
  8. ' Changes number of sites and screen size here
  9. '=====================================================================
  10. sites = 100
  11. xEdge = 700
  12. yEdge = 700
  13. '=====================================================================
  14.  
  15. Screen _NewImage(xEdge, yEdge, 32)
  16. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
  17.  
  18. '_FullScreen _SquarePixels
  19. 'Randomize 0.14159
  20.  
  21. Dim Shared As Integer townX(sites), townY(sites), nearestIndex(xEdge, yEdge)
  22. Dim Shared As Long dist(xEdge, yEdge)
  23. Dim Shared As Long col(sites)
  24.  
  25. For i = 1 To sites
  26.     townX(i) = Int(Rnd * xEdge)
  27.     townY(i) = Int(Rnd * yEdge)
  28.     col(i) = _RGB(Rand(0, 255), Rand(0, 255), Rand(0, 255))
  29.     CircleFill townX(i), townY(i), 2, col(i)
  30.     'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  31.  
  32. startTime = Timer(.001)
  33. 'fill distance table with squared distances from the first site
  34. For x = 0 To xEdge - 1
  35.     For y = 0 To yEdge - 1
  36.         'store the distance squared between sites in dist() array to avoid SQR()
  37.         dist(x, y) = (townX(1) - x) * (townX(1) - x) + (townY(1) - y) * (townY(1) - y)
  38.         nearestIndex(x, y) = 1
  39.     Next
  40.  
  41. 'for all the other sites
  42. For i = 2 To sites
  43.     endY = yEdge - 1
  44.     'check left side
  45.     For x = townX(i) To 0 Step -1
  46.         If (checkRow(i, x, endY)) = 0 Then Exit For
  47.     Next x
  48.     'check right side
  49.     For x = townX(i) + 1 To xEdge - 1
  50.         If (checkRow(i, x, endY)) = 0 Then Exit For
  51.     Next
  52.     For j = 1 To sites
  53.         CircleFill townX(j), townY(j), 2, col(j)
  54.         'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  55.     Next
  56.  
  57.  
  58.  
  59. 'fill in region colors and draw region outlines
  60. For y = 0 To yEdge - 1
  61.     For x = 0 To xEdge - 1
  62.         startX = x
  63.         nearest = nearestIndex(x, y)
  64.         For x = x + 1 To xEdge
  65.             If nearestIndex(x, y) <> nearest Then x = x - 1: Exit For
  66.         Next
  67.         Line (startX, y)-(x + 1, y), col(nearest)
  68.         'draw region outline x locations
  69.         PSet (startX, y), &HFF000000
  70.         PSet (x + 1, y), &HFF000000
  71.         '_Limit 10
  72.     Next
  73.  
  74. For x = 0 To xEdge - 1
  75.     For y = 0 To yEdge - 1
  76.         startY = y
  77.         nearest = nearestIndex(x, y)
  78.         For y = y + 1 To yEdge
  79.             If nearestIndex(x, y) <> nearest Then y = y - 1: Exit For
  80.         Next
  81.         'draw region outline y locations
  82.         PSet (x, startY), &HFF000000
  83.         PSet (x, y + 1), &HFF000000
  84.     Next
  85.  
  86. showSites = 1
  87. If showSites = 1 Then
  88.     'show the original random sites after regions are filled
  89.     'Draw a 4 pixel circle at each of the random points in px(), py() arrays
  90.     For i = 1 To sites
  91.         Call CircleFill(townX(i), townY(i), 2, &HFF000000)
  92.     Next
  93.     Line (0, 0)-(xEdge - 1, yEdge - 1), &HFF000000, B
  94.  
  95.  
  96. Color &HFFFFFFFF
  97. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
  98.  
  99. Function checkRow (site%, x, endY)
  100.     dxSquared& = (townX(site%) - x) * (townX(site%) - x)
  101.     For yt% = 0 To endY
  102.         dSquared& = (townY(site%) - yt%) * (townY(site%) - yt%) + dxSquared&
  103.         If dSquared& <= dist(x, yt%) Then
  104.             dist(x, yt%) = dSquared&
  105.             nearestIndex(x, yt%) = site%
  106.             PSet (x, yt%), col(site%)
  107.             checkRow = 1
  108.             _Limit 15000
  109.         End If
  110.     Next
  111.  
  112. Function Rand% (lo%, hi%)
  113.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
  114.  
  115. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  116.     '=============================
  117.     '  CX = center x coordinate
  118.     '  CY = center y coordinate
  119.     '   R = radius
  120.     '   C = fill color
  121.     '=============================
  122.     Dim As Integer Radius, RadiusError, X, Y
  123.     Radius = Abs(R)
  124.     RadiusError = -Radius
  125.     X = Radius
  126.     Y = 0
  127.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  128.     Line (CX - X, CY)-(CX + X, CY), C, BF
  129.     While X > Y
  130.         RadiusError = RadiusError + Y * 2 + 1
  131.         If RadiusError >= 0 Then
  132.             If X <> Y + 1 Then
  133.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  134.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  135.             End If
  136.             X = X - 1
  137.             RadiusError = RadiusError - X * 2
  138.         End If
  139.         Y = Y + 1
  140.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  141.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  142.     Wend
  143.  
  144.  
  145.  
  146.  

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Re: Voronoi Diagrams with points and region outlines
« Reply #4 on: April 22, 2021, 01:48:35 am »
That's a good start, but the real speed up is storing the distances in dist(x,y) array. Without that you have the same Voronoi code as any other solution. Which is why the the time taken to calc the diagram scales up nearly linearly using the dist(x,y) array, as the distances are calculated one time only.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Voronoi Diagrams with points and region outlines
« Reply #5 on: April 23, 2021, 02:18:30 pm »
Here is a Picasso painted by Voronoi:
 
Picasso painted by Voronoi.PNG

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Re: Voronoi Diagrams with points and region outlines
« Reply #6 on: April 24, 2021, 07:16:39 pm »
Here's a well known Van Gogh



Starry Night Voronoi (1280x720).png
* Starry Night Voronoi (1280x720).png (Filesize: 560.42 KB, Dimensions: 1280x720, Views: 294)