代码如下: Const k = 2 Const total = 50 Dim t As Integer Dim s As Integer Dim q As Integer Public s1 As Integer Dim id(total) As Single Dim px(total) As Single Dim py(total) As Single Dim zx(2) As Double Dim zy(2) As Double Dim z0x(2) As Double Dim z0y(2) As Double Dim dx(total) As Single Dim dy(total) As Single Dim d(total) As Single Dim dx1() As Single Dim dy1() As Single Dim tp() As Integer Private Sub Form_Load() Dim i As Integer Dim msgtext As String Dim strSQL As String Dim RecordDate As Recordset '保存SQL语句搜索结果的记录集 Set g_Conn = New Connection '连接到数据库 With g_Conn .CursorLocation = adUseClient .CommandTimeout = 10 ' 连接到ACCESS数据库 .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';" & _ "Data Source=" & App.Path & "\" & "db2.mdb" .Open End With Adoana.ConnectionString = g_Conn.ConnectionString
strSQL = "select id,sco1 ,sco2 from score" Set RecordDate = g_Conn.Execute(strSQL)
While Not RecordDate.EOF If (RecordDate("sco1").Value <> 0) And (RecordDate("sco2").Value <> 0) Then id(i) = RecordDate("id").Value px(i) = RecordDate("sco1").Value py(i) = RecordDate("sco2").Value i = i + 1 s1 = s1 + 1 RecordDate.MoveNext End If WendReDim tp(s1 - 1)'选k个初始聚类中心 z[i] For i = 0 To 2 z0x(i) = px(i) z0y(i) = py(i) ' MsgBox "随机选取的第{" & i & "}类中心为" & z0x(i) & "," & z0y(i) & "" Next i For i = 0 To s1 - 1 tp(i) = 0 Next i t = 0 '记录point[i]暂时在哪个类中 For i = 0 To s1 - 1 For j = 0 To k dx(i) = px(i) - z0x(j) dy(i) = py(i) - z0y(j) dx(t) = px(i) - z0x(t) dy(t) = py(i) - z0y(t)Dim r Dim fr = distance(dx(t), dy(t)) r = q f = distance(dx(i), dy(i)) f = qIf (r > f) Then t = j End If Next j tp(i) = t 'MsgBox "经比较后,点(" & px(i) & " ," & py(i) & ")属于 " & t & " 类"Next iFor i = 0 To k '计算新的聚类中心Call newcentre(i) ' MsgBox "初始时第{" & i & "}类中心为" & zx(i) & "," & zy(i) & ""If ((zx(i) = z0x(i)) And (zy(i) = z0y(i))) Then '对前后两次的聚类中心进行比较 test = test + 1 Else z0x(i) = zx(i) z0y(i) = zy(i) End If Next i While (test < 3) '进行迭代,对total个样本根据聚类中心进行分类
For i = 0 To s1 - 1 For j = 0 To k dx(i) = px(i) - z0x(j) dy(i) = py(i) - z0y(j) dx(t) = px(i) - z0x(t) dy(t) = py(i) - z0y(t) Dim s Dim m Dim nr = distance(dx(t), dy(t)) r = q f = distance(dx(i), dy(i)) f = qIf r > f Then t = j End If Next j tp(i) = t 'MsgBox "经比较后,点(" & px(i) & " ," & py(i) & ")属于 " & t & " 类"Next itest = 0For i = 0 To k Call newcentre(i) 'MsgBox "第{" & i & "}类中心为" & zx(i) & "," & zy(i) & "" If (zx(i) = z0x(i) And zy(i) = z0y(i)) Then test = test + 1 Else z0x(i) = zx(i) z0y(i) = zy(i) End IfNext i s = s + 1 Wend For i = 0 To s1 - 1 If id(i) = i + 1 Then msgtext = "insert into score( sort) values ('" & tp(i) & " ')" g_Conn.Execute msgtext End If
Next i ←(我就是这样用这个sql语句插入的,可以插入但是插入后的情况 是:sort id sco1 sco2 1类 2类 1 58 76 2 89 70 .......... 后面的三行整个就下移了) 数据库中的格式如下:sort id sco1 sco2 1 58 76 2 89 70 .......... sort是每行数据所属的类,在数据库中初始是空的,就是想把聚类得出的结果放到这个字段中,
msgtext = "update score set sort ='" & tp(i) & " ' where id = " & id(i) & " and sco1 = " & px(i) & " and sco2 = " & py(i) 如果sort是数值型,应该这么写: msgtext = "update score set sort =" & tp(i) & " where id = " & id(i) & " and sco1 = " & px(i) & " and sco2 = " & py(i)
Const k = 2
Const total = 50
Dim t As Integer
Dim s As Integer
Dim q As Integer
Public s1 As Integer
Dim id(total) As Single
Dim px(total) As Single
Dim py(total) As Single
Dim zx(2) As Double
Dim zy(2) As Double
Dim z0x(2) As Double
Dim z0y(2) As Double
Dim dx(total) As Single
Dim dy(total) As Single
Dim d(total) As Single
Dim dx1() As Single
Dim dy1() As Single
Dim tp() As Integer
Private Sub Form_Load() Dim i As Integer
Dim msgtext As String
Dim strSQL As String
Dim RecordDate As Recordset '保存SQL语句搜索结果的记录集
Set g_Conn = New Connection
'连接到数据库
With g_Conn
.CursorLocation = adUseClient
.CommandTimeout = 10
' 连接到ACCESS数据库
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';" & _
"Data Source=" & App.Path & "\" & "db2.mdb"
.Open
End With
Adoana.ConnectionString = g_Conn.ConnectionString
strSQL = "select id,sco1 ,sco2 from score"
Set RecordDate = g_Conn.Execute(strSQL)
While Not RecordDate.EOF
If (RecordDate("sco1").Value <> 0) And (RecordDate("sco2").Value <> 0) Then
id(i) = RecordDate("id").Value
px(i) = RecordDate("sco1").Value
py(i) = RecordDate("sco2").Value
i = i + 1
s1 = s1 + 1
RecordDate.MoveNext
End If
WendReDim tp(s1 - 1)'选k个初始聚类中心 z[i]
For i = 0 To 2
z0x(i) = px(i)
z0y(i) = py(i)
' MsgBox "随机选取的第{" & i & "}类中心为" & z0x(i) & "," & z0y(i) & ""
Next i
For i = 0 To s1 - 1
tp(i) = 0
Next i
t = 0 '记录point[i]暂时在哪个类中
For i = 0 To s1 - 1
For j = 0 To k
dx(i) = px(i) - z0x(j)
dy(i) = py(i) - z0y(j)
dx(t) = px(i) - z0x(t)
dy(t) = py(i) - z0y(t)Dim r
Dim fr = distance(dx(t), dy(t))
r = q
f = distance(dx(i), dy(i))
f = qIf (r > f) Then
t = j
End If
Next j
tp(i) = t
'MsgBox "经比较后,点(" & px(i) & " ," & py(i) & ")属于 " & t & " 类"Next iFor i = 0 To k '计算新的聚类中心Call newcentre(i)
' MsgBox "初始时第{" & i & "}类中心为" & zx(i) & "," & zy(i) & ""If ((zx(i) = z0x(i)) And (zy(i) = z0y(i))) Then '对前后两次的聚类中心进行比较
test = test + 1
Else
z0x(i) = zx(i)
z0y(i) = zy(i)
End If
Next i
While (test < 3) '进行迭代,对total个样本根据聚类中心进行分类
For i = 0 To s1 - 1
For j = 0 To k
dx(i) = px(i) - z0x(j)
dy(i) = py(i) - z0y(j)
dx(t) = px(i) - z0x(t)
dy(t) = py(i) - z0y(t)
Dim s
Dim m
Dim nr = distance(dx(t), dy(t))
r = q
f = distance(dx(i), dy(i))
f = qIf r > f Then
t = j
End If
Next j
tp(i) = t
'MsgBox "经比较后,点(" & px(i) & " ," & py(i) & ")属于 " & t & " 类"Next itest = 0For i = 0 To k
Call newcentre(i)
'MsgBox "第{" & i & "}类中心为" & zx(i) & "," & zy(i) & ""
If (zx(i) = z0x(i) And zy(i) = z0y(i)) Then test = test + 1
Else
z0x(i) = zx(i)
z0y(i) = zy(i)
End IfNext i
s = s + 1
Wend
For i = 0 To s1 - 1
If id(i) = i + 1 Then
msgtext = "insert into score( sort) values ('" & tp(i) & " ')"
g_Conn.Execute msgtext
End If
Next i ←(我就是这样用这个sql语句插入的,可以插入但是插入后的情况 是:sort id sco1 sco2
1类
2类
1 58 76
2 89 70
..........
后面的三行整个就下移了)
数据库中的格式如下:sort id sco1 sco2
1 58 76
2 89 70
..........
sort是每行数据所属的类,在数据库中初始是空的,就是想把聚类得出的结果放到这个字段中,
如果sort是数值型,应该这么写:
msgtext = "update score set sort =" & tp(i) & " where id = " & id(i) & " and sco1 = " & px(i) & " and sco2 = " & py(i)