Voronoi Diagrams with points and region outlines

[AndyA]

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. Do: Loop Until _ScreenExists
16. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
17.  
18. '_FullScreen _SquarePixels
19. Randomize Timer
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)
31. Next
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
41. 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
54. 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
69. 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
82. 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
92. End If
93.  
94.  
95. Color &HFFFFFFFF
96. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
97. Sleep
98. System
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
110. End Function
111.  
112. Function Rand% (lo%, hi%)
113.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
114. End Function
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
144. End Sub
145.  
146.  

[bplus]

Wow, you're doing this with edges, missed that trying to figure the other code. It is faster alright!

[AndyA]

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.

[bplus]

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. Do: Loop Until _ScreenExists
17. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
18.  
19. '_FullScreen _SquarePixels
20. Randomize Timer
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)
33. Next
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
43. 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.  
62. Next
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
78. 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
91. 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
101. End If
102.  
103.  
104. Color &HFFFFFFFF
105. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
106. Sleep
107. System
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
121. End Function
122.  
123. Function Rand% (lo%, hi%)
124.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
125. End Function
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
155. End Sub
156.  
157.  
158.  
159.  

[AndyA]

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.

[bplus]

Here is a Picasso painted by Voronoi:
 

[AndyA]

Here's a well known Van Gogh