October 28, 2020, 11:17:23 PM

### Author Topic: [bmx] K-Means Clustering example by GW [ 1+ years ago ]  (Read 1164 times)

#### BlitzBot

• Jr. Member
• Posts: 1
##### [bmx] K-Means Clustering example by GW [ 1+ years ago ]
« on: June 29, 2017, 12:28:43 AM »
Title : K-Means Clustering example
Author : GW
Posted : 1+ years ago

Description : K-Means is a simple, unsupervised clustering algorithm. Useful for classifying and grouping any kind of data. It works for any-dimensional data. This example is 2D for visualization.

Code :
Code: BlitzMax
1. SuperStrict
2. Framework brl.retro
3. Import brl.glmax2d
4.
5. Rem
6.         K-Means Clustering algo for 2d by Aaron Woodard 2014 admin at kerneltrick.com
7.         Hold down the space bar to demo
8. Endrem
9.
10. SeedRnd MilliSecs()
11.
12.
13. Const NUMCLUSTERS:Int = 5
14. Const GW:Int = 800
15. Const GH:Int = 600
16.
17. Global pointslist:TList = CreateList()
18. Global Centers:tPoint[NUMCLUSTERS]
19. Global Colors:Int[NUMCLUSTERS]
20.
21.
22.
23. '---------------------------------------------------------------------------------------------------------------------------------
24. Type tPoint
25.         Field x:Int
26.         Field y:Int
27.         Field class:Int
28.
29.         Function Create:tPoint(x:Int, y:Int, class:Int = 0, add:Int = True)
30.                 Local p:tPoint = New tPoint
31.                 p.x = x
32.                 p.y = y
33.                 p.class = class
35.                 Return p
36.         End Function
37. End Type
38. '---------------------------------------------------------------------------------------------------------------------------------
39.
40.
41. '---------------------------------------------------------------------------------------------------------------------------------
42. Function Init()
43.         '// Create the cluster centers and give them a random color
44.                 For Local I:Int = 0 Until NUMCLUSTERS
45.                         Centers[I] = tPoint.Create(Rand(1, GW - 1) , Rand(1, GH - 1), 0, False)
46.                         Colors[I] = Rand(\$FF000000, \$FFFFFFFF)
47.                 Next
48. End Function
49. '---------------------------------------------------------------------------------------------------------------------------------
51.                 Rem
52.                         1) Find the closest cluster center for the new point
53.                         2) Add the new point to that group
54.                         3) update to chosen cluster center to be the average of all it's members
55.                 Endrem
56.
57.                 Local d:Float
58.                 Local bestd:Float = 9999999             '// Best distance
59.                 Local bestc:Float                               '// best cluster matched
60.
61.                 '// Find Closest center to this new point  //
62.                 For Local i:Int = 0 Until NUMCLUSTERS
63.                         d = dist(Centers[i].x, Centers[i].y, p.x, p.y)
64.                         If d < bestd Then
65.                                 bestd = d
66.                                 bestc = I
67.                         End If
68.                 Next
69.
70.                 p.class = bestc '// assign the new point to the closest cluster
71.
72.                 '// Adjust the center of this cluster to account for the new point //
73.                 Local totX:Int
74.                 Local totY:Int
75.                 Local count:Int
76.                 For Local tp:tPoint = EachIn pointslist
77.                         If tp.class <> bestc Then Continue
78.                         totX:+tp.x
79.                         totY:+tp.y
80.                         count:+1
81.                 Next
82.
83.                 If count < 1 Then Return
84.
85.                 Centers[bestc].x = totX / count
86.                 Centers[bestc].y = totY / count
87. End Function
88. '---------------------------------------------------------------------------------------------------------------------------------
89. Function DrawPoints()
90.         Local colr:Int
91.         For Local tp:tPoint = EachIn pointslist
92.                 colr = Colors[tp.class]
93.                 SetColor((colr Shr 16) & \$FF, (colr Shr 8) & \$FF, (colr) & \$FF)
94.                 DrawOval tp.x, tp.y, 5, 5
95.         Next
96. End Function
97. '---------------------------------------------------------------------------------------------------------------------------------
98. Function DrawCenters()
99.         For Local i:Int = 0 Until NUMCLUSTERS
100.                 SetColor((Colors[I] Shr 16) & \$FF, (Colors[I] Shr 8) & \$FF, (Colors[I]) & \$FF)
101.                 DrawRect(Centers[i].x, Centers[i].y, 10, 10)
102.         Next
103. End Function
104. '---------------------------------------------------------------------------------------------------------------------------------
105.
106.
107.
108. '//BEGIN
109. Graphics GW, GH
110. SetClsColor 32, 32, 32
111. Init
112.
113.
114.
115.
116. While Not KeyHit(KEY_ESCAPE)
117.         Cls
118.
119.                 If KeyDown(KEY_SPACE) Then
120.                         Local p:tPoint = tPoint.Create(Rand(GW - 2) + 1, Rand(GH - 2) + 1, 0, True)
121.
123.
124.                         '// Pull an old point off the list and re-apply it, clusters may have shifted and the old points might have changed class //
125.                         Local p2:tPoint = tPoint(pointslist.RemoveFirst())
128.
129.                         Print pointslist.Count()
130.                         'Delay 20
131.                 EndIf
132.
133.                 DrawCenters
134.                 DrawPoints
135.
136.         Flip
137. Wend
138.
139.
140.
141. '//Utility stuff
142. '---------------------------------------------------------------------------------------------------------------------------------
143. Function dist:Float(x1:Float, y1:Float, x2:Float, y2:Float)
144.         Local dx:Float = x2 - x1
145.         Local dy:Float = y2 - y1
146.         Return Sqr(dx * dx + dy * dy)
147. End Function
148. '---------------------------------------------------------------------------------------------------------------------------------