@ Mó nguồn của chương trỡnh được viết cụ thể như sau:
Option Explicit
'#################################################################' Chương trình mơ phỏng thuật tốn K-MEANS
' Khi người sử dụng nhập số lượng cụm và kích chuột để khởi tạo các cụm ban đầu ' Sau đó người sử dụng kích chuột để nhập các điểm dữ liệu thông qua tọa độ (X,Y).
' Chương trình sẽ tự động xác nhận điểm dữ liệu đó thuộc về cụm nào
' bằng cách so sánh khoảng cách của điểm vừa nhập với trọng tâm của cụm ' và các cụm mới được thành lập thông qua việc di chuyển trọng tâm của cụm ' Giải thuật sử dụng thuộc loại học không giám sát của mạng nơron
'################################################################# Private Data()
Private Centroid() As Single Private totalData As Integer Private numCluster As Integer Private Sub Form_Load() Dim i As Integer
Picture1.BackColor = &HFFFFFF Picture1.DrawWidth = 10
Picture1.ScaleMode = 3
lblExplanation.Caption = "Các cụm được phân biệt bởi màu sắc và trọng tâm của cụm!"
numCluster = Int(txtNumCluster)
ReDim Centroid(1 To 2, 1 To numCluster) For i = 0 To numCluster - 1
If i > 0 Then Load lblCentroid(i) lblCentroid(i).Caption = i + 1 lblCentroid(i).Visible = False
Next i End Sub
Private Sub cmdReset_Click() Dim i As Integer Picture1.Cls Erase Data totalData = 0 For i = 0 To numCluster - 1 lblCentroid(i).Visible = False Next i txtNumCluster.Enabled = True End Sub
Private Sub txtNumCluster_Change() Dim i As Integer
For i = 1 To numCluster - 1 Unload lblCentroid(i) Next i
numCluster = Int(txtNumCluster)
ReDim Centroid(1 To 2, 1 To numCluster) For i = 0 To numCluster - 1
If i > 0 Then Load lblCentroid(i) lblCentroid(i).Caption = i + 1 lblCentroid(i).Visible = False Next i
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim colorCluster As Integer Dim i As Integer
txtNumCluster.Enabled = False totalData = totalData + 1
ReDim Preserve Data(0 To 2, 1 To totalData) Data(1, totalData) = X
Data(2, totalData) = Y
Call kMeanCluster(Data, numCluster)
Picture1.Cls
For i = 1 To totalData
colorCluster = Data(0, i) - 1
If colorCluster = 7 Then colorCluster = 12 X = Data(1, i)
Y = Data(2, i)
Picture1.PSet (X, Y), QBColor(colorCluster) Next i
For i = 1 To min2(numCluster, totalData) lblCentroid(i - 1).Left = Centroid(1, i) lblCentroid(i - 1).Top = Centroid(2, i) lblCentroid(i - 1).Visible = True Next i
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblXYValue.Caption = X & "," & Y End Sub
'#################################################################' FUNCTIONS
' + kMeanCluster:
' + dist: Tính tốn khoảng cách
' + min2: Trả lại giá trị nhỏ nhất giữa hai số
'################################################################# Sub kMeanCluster(Data() As Variant, numCluster As Integer)
Dim i As Integer Dim j As Integer Dim X As Single Dim Y As Single Dim min As Single Dim cluster As Integer Dim d As Single Dim sumXY()
Dim isStillMoving As Boolean isStillMoving = True
If totalData <= numCluster Then Data(0, totalData) = totalData
Centroid(1, totalData) = Data(1, totalData) Centroid(2, totalData) = Data(2, totalData) Else
min = 10 ^ 10
X = Data(1, totalData) Y = Data(2, totalData) For i = 1 To numCluster
d = dist(X, Y, Centroid(1, i), Centroid(2, i)) If d < min Then
cluster = i End If
Next i
Data(0, totalData) = cluster
Do While isStillMoving
'Tính centroids mới
ReDim sumXY(1 To 3, 1 To numCluster) For i = 1 To totalData
sumXY(1, Data(0, i)) = Data(1, i) + sumXY(1, Data(0, i)) sumXY(2, Data(0, i)) = Data(2, i) + sumXY(2, Data(0, i)) sumXY(3, Data(0, i)) = 1 + sumXY(3, Data(0, i))
Next i
For i = 1 To numCluster
Centroid(1, i) = sumXY(1, i) / sumXY(3, i) Centroid(2, i) = sumXY(2, i) / sumXY(3, i) Next i
'Xác định tất cả dữ liệu theo centroids mới isStillMoving = False For i = 1 To totalData min = 10 ^ 10 X = Data(1, i) Y = Data(2, i) For j = 1 To numCluster
d = dist(X, Y, Centroid(1, j), Centroid(2, j)) If d < min Then
min = d cluster = j End If
Next j
If Data(0, i) <> cluster Then Data(0, i) = cluster isStillMoving = True End If Next i Loop End If End Sub
Function dist(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Single ' Tính tốn khoảng cách Euclidean
dist = Sqr((Y2 - Y1) ^ 2 + (X2 - X1) ^ 2) End Function
Private Function min2(num1, num2) ' Trả lại giá trị nhỏ nhất giữa 2 số If num1 < num2 Then
min2 = num1 Else
min2 = num2 End If