Code archives/Algorithms/K-Means Clustering example

SuperStrict
Framework brl.retro
Import brl.glmax2d

Rem
	K-Means Clustering algo for 2d by Aaron Woodard 2014 admin at kerneltrick.com
	Hold down the space bar to demo
Endrem

SeedRnd MilliSecs()


Const NUMCLUSTERS:Int = 5
Const GW:Int = 800
Const GH:Int = 600

Global pointslist:TList = CreateList()
Global Centers:tPoint[NUMCLUSTERS]
Global Colors:Int[NUMCLUSTERS]



'---------------------------------------------------------------------------------------------------------------------------------
Type tPoint
	Field x:Int
	Field y:Int
	Field class:Int
	
	Function Create:tPoint(x:Int, y:Int, class:Int = 0, add:Int = True)
		Local p:tPoint = New tPoint
		p.x = x
		p.y = y
		p.class = class
		If add Then pointslist.AddLast p
		Return p
	End Function
End Type
'---------------------------------------------------------------------------------------------------------------------------------


'---------------------------------------------------------------------------------------------------------------------------------
Function Init()
	'// Create the cluster centers and give them a random color
		For Local I:Int = 0 Until NUMCLUSTERS
			Centers[I] = tPoint.Create(Rand(1, GW - 1) , Rand(1, GH - 1), 0, False)
			Colors[I] = Rand($FF000000, $FFFFFFFF)
		Next
End Function
'---------------------------------------------------------------------------------------------------------------------------------
Function AddPoint(p:tPoint)
		Rem
			1) Find the closest cluster center for the new point
			2) Add the new point to that group
			3) update to chosen cluster center to be the average of all it's members 
		Endrem
		
		Local d:Float
		Local bestd:Float = 9999999		'// Best distance 
		Local bestc:Float				'// best cluster matched
		
		'// Find Closest center to this new point  //
		For Local i:Int = 0 Until NUMCLUSTERS
			d = dist(Centers[i].x, Centers[i].y, p.x, p.y)
			If d < bestd Then
				bestd = d
				bestc = I
			End If
		Next
		
		p.class = bestc	'// assign the new point to the closest cluster
		
		'// Adjust the center of this cluster to account for the new point //
		Local totX:Int
		Local totY:Int
		Local count:Int
		For Local tp:tPoint = EachIn pointslist
			If tp.class <> bestc Then Continue
			totX:+tp.x
			totY:+tp.y
			count:+1
		Next
		
		If count < 1 Then Return
		
		Centers[bestc].x = totX / count
		Centers[bestc].y = totY / count
End Function
'---------------------------------------------------------------------------------------------------------------------------------
Function DrawPoints()
	Local colr:Int
	For Local tp:tPoint = EachIn pointslist
		colr = Colors[tp.class]
		SetColor((colr Shr 16) & $FF, (colr Shr 8) & $FF, (colr) & $FF)
		DrawOval tp.x, tp.y, 5, 5
	Next
End Function
'---------------------------------------------------------------------------------------------------------------------------------
Function DrawCenters()
	For Local i:Int = 0 Until NUMCLUSTERS
		SetColor((Colors[I] Shr 16) & $FF, (Colors[I] Shr 8) & $FF, (Colors[I]) & $FF)
		DrawRect(Centers[i].x, Centers[i].y, 10, 10)
	Next
End Function
'---------------------------------------------------------------------------------------------------------------------------------



'//BEGIN 
Graphics GW, GH
SetClsColor 32, 32, 32
Init




While Not KeyHit(KEY_ESCAPE)
	Cls
	
		If KeyDown(KEY_SPACE) Then
			Local p:tPoint = tPoint.Create(Rand(GW - 2) + 1, Rand(GH - 2) + 1, 0, True)
			
			AddPoint p
			
			'// Pull an old point off the list and re-apply it, clusters may have shifted and the old points might have changed class //
			Local p2:tPoint = tPoint(pointslist.RemoveFirst())
			AddPoint p2
			pointslist.AddLast p2
			
			Print pointslist.Count()
			'Delay 20
		EndIf
		
		DrawCenters
		DrawPoints
	
	Flip
Wend



'//Utility stuff
'---------------------------------------------------------------------------------------------------------------------------------
Function dist:Float(x1:Float, y1:Float, x2:Float, y2:Float)
	Local dx:Float = x2 - x1
	Local dy:Float = y2 - y1
	Return Sqr(dx * dx + dy * dy)
End Function
'---------------------------------------------------------------------------------------------------------------------------------