Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: AndyA on April 19, 2021, 03:42:14 pm

Title: Voronoi Diagrams with points and region outlines
Post by: AndyA 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)
  16. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
  17.  
  18. '_FullScreen _SquarePixels
  20. 'Randomize 0.14159
  21.  
  22. Dim Shared As Integer townX(sites), townY(sites), nearestIndex(xEdge, yEdge)
  23. Dim Shared As Long dist(xEdge, yEdge)
  24. Dim As Long col(sites)
  25.  
  26. For i = 1 To sites
  27.     townX(i) = Int(Rnd * xEdge)
  28.     townY(i) = Int(Rnd * yEdge)
  29.     col(i) = _RGB(Rand(0, 255), Rand(0, 255), Rand(0, 255))
  30.     'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  32.  
  33. startTime = Timer(.001)
  34. 'fill distance table with squared distances from the first site
  35. For x = 0 To xEdge - 1
  36.     For y = 0 To yEdge - 1
  37.         'store the distance squared between sites in dist() array to avoid SQR()
  38.         dist(x, y) = (townX(1) - x) * (townX(1) - x) + (townY(1) - y) * (townY(1) - y)
  39.         nearestIndex(x, y) = 1
  40.     Next
  42.  
  43. 'for all the other sites
  44. For i = 2 To sites
  45.     endY = yEdge - 1
  46.     'check left side
  47.     For x = townX(i) To 0 Step -1
  48.         If (checkRow(i, x, endY)) = 0 Then Exit For
  49.     Next x
  50.     'check right side
  51.     For x = townX(i) + 1 To xEdge - 1
  52.         If (checkRow(i, x, endY)) = 0 Then Exit For
  53.     Next
  55.  
  56. 'fill in region colors and draw region outlines
  57. For y = 0 To yEdge - 1
  58.     For x = 0 To xEdge - 1
  59.         startX = x
  60.         nearest = nearestIndex(x, y)
  61.         For x = x + 1 To xEdge
  62.             If nearestIndex(x, y) <> nearest Then x = x - 1: Exit For
  63.         Next
  64.         Line (startX, y)-(x + 1, y), col(nearest)
  65.         'draw region outline x locations
  66.         PSet (startX, y), &HFF000000
  67.         PSet (x + 1, y), &HFF000000
  68.     Next
  70.  
  71. For x = 0 To xEdge - 1
  72.     For y = 0 To yEdge - 1
  73.         startY = y
  74.         nearest = nearestIndex(x, y)
  75.         For y = y + 1 To yEdge
  76.             If nearestIndex(x, y) <> nearest Then y = y - 1: Exit For
  77.         Next
  78.         'draw region outline y locations
  79.         PSet (x, startY), &HFF000000
  80.         PSet (x, y + 1), &HFF000000
  81.     Next
  83.  
  84. showSites = 1
  85. If showSites = 1 Then
  86.     'show the original random sites after regions are filled
  87.     'Draw a 4 pixel circle at each of the random points in px(), py() arrays
  88.     For i = 1 To sites
  89.         Call CircleFill(townX(i), townY(i), 2, &HFF000000)
  90.     Next
  91.     Line (0, 0)-(xEdge - 1, yEdge - 1), &HFF000000, B
  93.  
  94.  
  95. Color &HFFFFFFFF
  96. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
  99.  
  100. Function checkRow (site%, x, endY)
  101.     dxSquared& = (townX(site%) - x) * (townX(site%) - x)
  102.     For yt% = 0 To endY
  103.         dSquared& = (townY(site%) - yt%) * (townY(site%) - yt%) + dxSquared&
  104.         If dSquared& <= dist(x, yt%) Then
  105.             dist(x, yt%) = dSquared&
  106.             nearestIndex(x, yt%) = site%
  107.             checkRow = 1
  108.         End If
  109.     Next
  111.  
  112. Function Rand% (lo%, hi%)
  113.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
  115.  
  116. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  117.     '=============================
  118.     '  CX = center x coordinate
  119.     '  CY = center y coordinate
  120.     '   R = radius
  121.     '   C = fill color
  122.     '=============================
  123.     Dim As Integer Radius, RadiusError, X, Y
  124.     Radius = Abs(R)
  125.     RadiusError = -Radius
  126.     X = Radius
  127.     Y = 0
  128.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  129.     Line (CX - X, CY)-(CX + X, CY), C, BF
  130.     While X > Y
  131.         RadiusError = RadiusError + Y * 2 + 1
  132.         If RadiusError >= 0 Then
  133.             If X <> Y + 1 Then
  134.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  135.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  136.             End If
  137.             X = X - 1
  138.             RadiusError = RadiusError - X * 2
  139.         End If
  140.         Y = Y + 1
  141.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  142.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  143.     Wend
  145.  
  146.  
Title: Re: Voronoi Diagrams with points and region outlines
Post by: bplus 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!
Title: Re: Voronoi Diagrams with points and region outlines
Post by: AndyA 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.
Title: Re: Voronoi Diagrams with points and region outlines
Post by: bplus 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)
  17. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
  18.  
  19. '_FullScreen _SquarePixels
  21. 'Randomize 0.14159
  22.  
  23. Dim Shared As Integer townX(sites), townY(sites), nearestIndex(xEdge, yEdge)
  24. Dim Shared As Long dist(xEdge, yEdge)
  25. Dim Shared As Long col(sites)
  26.  
  27. For i = 1 To sites
  28.     townX(i) = Int(Rnd * xEdge)
  29.     townY(i) = Int(Rnd * yEdge)
  30.     col(i) = _RGB(Rand(0, 255), Rand(0, 255), Rand(0, 255))
  31.     CircleFill townX(i), townY(i), 2, col(i)
  32.     'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  34.  
  35. startTime = Timer(.001)
  36. 'fill distance table with squared distances from the first site
  37. For x = 0 To xEdge - 1
  38.     For y = 0 To yEdge - 1
  39.         'store the distance squared between sites in dist() array to avoid SQR()
  40.         dist(x, y) = (townX(1) - x) * (townX(1) - x) + (townY(1) - y) * (townY(1) - y)
  41.         nearestIndex(x, y) = 1
  42.     Next
  44.  
  45. 'for all the other sites
  46. For i = 2 To sites
  47.     endY = yEdge - 1
  48.     'check left side
  49.     For x = townX(i) To 0 Step -1
  50.         If (checkRow(i, x, endY)) = 0 Then Exit For
  51.     Next x
  52.     'check right side
  53.     For x = townX(i) + 1 To xEdge - 1
  54.         If (checkRow(i, x, endY)) = 0 Then Exit For
  55.     Next
  56.     For j = 1 To sites
  57.         CircleFill townX(j), townY(j), 2, col(j)
  58.         'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  59.     Next
  60.  
  61.  
  63.  
  64. 'fill in region colors and draw region outlines
  65. For y = 0 To yEdge - 1
  66.     For x = 0 To xEdge - 1
  67.         startX = x
  68.         nearest = nearestIndex(x, y)
  69.         For x = x + 1 To xEdge
  70.             If nearestIndex(x, y) <> nearest Then x = x - 1: Exit For
  71.         Next
  72.         Line (startX, y)-(x + 1, y), col(nearest)
  73.         'draw region outline x locations
  74.         PSet (startX, y), &HFF000000
  75.         PSet (x + 1, y), &HFF000000
  76.         '_Limit 10
  77.     Next
  79.  
  80. For x = 0 To xEdge - 1
  81.     For y = 0 To yEdge - 1
  82.         startY = y
  83.         nearest = nearestIndex(x, y)
  84.         For y = y + 1 To yEdge
  85.             If nearestIndex(x, y) <> nearest Then y = y - 1: Exit For
  86.         Next
  87.         'draw region outline y locations
  88.         PSet (x, startY), &HFF000000
  89.         PSet (x, y + 1), &HFF000000
  90.     Next
  92.  
  93. showSites = 1
  94. If showSites = 1 Then
  95.     'show the original random sites after regions are filled
  96.     'Draw a 4 pixel circle at each of the random points in px(), py() arrays
  97.     For i = 1 To sites
  98.         Call CircleFill(townX(i), townY(i), 2, &HFF000000)
  99.     Next
  100.     Line (0, 0)-(xEdge - 1, yEdge - 1), &HFF000000, B
  102.  
  103.  
  104. Color &HFFFFFFFF
  105. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
  108.  
  109. Function checkRow (site%, x, endY)
  110.     dxSquared& = (townX(site%) - x) * (townX(site%) - x)
  111.     For yt% = 0 To endY
  112.         dSquared& = (townY(site%) - yt%) * (townY(site%) - yt%) + dxSquared&
  113.         If dSquared& <= dist(x, yt%) Then
  114.             dist(x, yt%) = dSquared&
  115.             nearestIndex(x, yt%) = site%
  116.             PSet (x, yt%), col(site%)
  117.             checkRow = 1
  118.             _Limit 15000
  119.         End If
  120.     Next
  122.  
  123. Function Rand% (lo%, hi%)
  124.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
  126.  
  127. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  128.     '=============================
  129.     '  CX = center x coordinate
  130.     '  CY = center y coordinate
  131.     '   R = radius
  132.     '   C = fill color
  133.     '=============================
  134.     Dim As Integer Radius, RadiusError, X, Y
  135.     Radius = Abs(R)
  136.     RadiusError = -Radius
  137.     X = Radius
  138.     Y = 0
  139.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  140.     Line (CX - X, CY)-(CX + X, CY), C, BF
  141.     While X > Y
  142.         RadiusError = RadiusError + Y * 2 + 1
  143.         If RadiusError >= 0 Then
  144.             If X <> Y + 1 Then
  145.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  146.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  147.             End If
  148.             X = X - 1
  149.             RadiusError = RadiusError - X * 2
  150.         End If
  151.         Y = Y + 1
  152.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  153.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  154.     Wend
  156.  
  157.  
  158.  
  159.  
Title: Re: Voronoi Diagrams with points and region outlines
Post by: AndyA 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.
Title: Re: Voronoi Diagrams with points and region outlines
Post by: bplus on April 23, 2021, 02:18:30 pm
Here is a Picasso painted by Voronoi:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Voronoi Diagrams with points and region outlines
Post by: AndyA on April 24, 2021, 07:16:39 pm
Here's a well known Van Gogh



Text Only | Text with Attachments