关于利用k均值算法解决分类的问题!
不知道那位大侠曾经编过这个程序,希望能够共同探讨一下.这几天我编了一个正在调试,我也可以共享我的,希望能得到大家的帮助.thank you1 问题点数：50、回复次数：8Top
1 楼laviewpbt（人一定要靠自己）回复于 2005-04-03 12:58:45 得分 40
以前写过模糊K均值，FCM，HCM以及降维对分法对图象进行分割，可以研究研究。Top
2 楼cathyli（）回复于 2005-04-03 14:46:48 得分 0
谢谢这位朋友的回复,目前还有一点问题,那我就把自己编的代码传上去,麻烦你给我看看.可能还有一些功能不够完善,我希望把分类的结果用直方图或者饼图显示出来,我会继续做改进的,thank you!
Dim tp(1000) As Integer
Const k = 3
Dim t As Integer
Dim s As Integer
Dim test As Integer
Private Sub Form_Load()
Dim i As Integer
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 & "\" & "ana\db2.mdb"
.Open
End With
Adoana.ConnectionString = g_Conn.ConnectionString
strSQL = "select id ,SCO from score"
Set RecordDate = g_Conn.Execute(strSQL)
Dim px(1000) As Integer
Dim py(1000) As Single
Dim zx(3) As Integer
Dim zy(3) As Single
Dim z0x(3) As Integer
Dim z0y(3) As Single
Dim dx(1000) As Integer
Dim dy(1000) As Single
Dim d(1000) As Single
px(i) = RecordDate("id").Value
py(i) = RecordDate("sco").Value
'选k个初始聚类中心 z[i]
For i = 0 To 2
z0x(i) = px(i)
z0y(i) = py(i)
Next i
For i = 1 To total
tp(i) = 0
Next i
'进行迭代，对total个样本根据聚类中心进行分类
Dim t As Integer
t = 0 '记录point[i]暂时在哪个类中
For i = 1 To total
For j = 1 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)
If (distance(dx(t), dy(t))) > (distance(dx(i), dy(i))) Then
t = j
End If
Next j
tp(i) = t
Print "经比较后，点（px(i)，py(i)）属于 t 类"
Next i
For i = 1 To k '计算新的聚类中心
Call newcentre(i)
Print "初始时第{i}类中心为 zx(i),zy(i)"
If (zx(i) Eqv z0x(i) And zy(i) Eqv z0y(i)) Then '对前后两次的聚类中心进行比较
test = test + 1
Else: z0x(i) = zx(i)
z0y(i) = zy(i)
Next i
While (test <> k) '进行迭代
For i = 1 To total
For j = 1 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)
Call distance(dx(i), dy(t))
If (distance(dx(t), dy(t))) > (distance(dx(i), dy(i))) Then
t = j
End If
Next j
tp(i) = t
Print "经比较后，点（px(i)，py(i)）属于 t 类"
Next i
For i = 1 To k
Call newcentre(i)
Print "第{i}类中心为 zx(i),zy(i)"
If (zx(i) Eqv z0x(i) And zy(i) Eqv z0y(i)) Then
test = test + 1
Else: z0x(i) = zx(i)
z0y(i) = zy(i)
Next i
Wend
s = s + 1
Print "第s次迭代后，点（px(i)，py(i)）属于 t 类"
End Sub
Sub distance(dx(), dy())
d(i) = dx() * dx() + dy() * dy()
End Sub
'计算新的聚类中心
Sub newcentre(i)
Dim m As Integer
Dim sumx As Single
Dim sumy As Single
Const n = 0
For i = 1 To total
If tp(i) = i Then
sumx = px(i) + sumx
sumy = py(i) + sumy
n = n + 1
Next i
zx(i) = sumx / n
zy(i) = sumy / n
Print "zx(i) is:"; zx(i)
Print "zy(i) is:"; zy(i)
End Sub
此外数据库我只设置了两个字段,一个是客户的"id",还有一个是客户的评分值"sco".再此谢过了Top
3 楼laviewpbt（人一定要靠自己）回复于 2005-04-03 18:18:48 得分 0
呵呵
对象不一样啊，我的是图象，不过算法也差不多，可惜现在忙的要死，有空帮你看看
我用模糊K均值只是把图象分成2部分的，好象这是模式识别的内容。
Top
4 楼cathyli（）回复于 2005-04-03 18:45:53 得分 0
关于图象方面我也看到过一些,好象思想精髓都差不多,把相似的归到一起.不过还是谢谢你!,希望你尽快有空,好交流一下.Top
5 楼nbamjzhldm（）回复于 2005-04-03 19:50:57 得分 10
upTop
6 楼cathyli（）回复于 2005-04-04 09:30:43 得分 0
自己顶一下,希望更多的人参与进来Top
7 楼cathyli（）回复于 2005-04-04 15:55:23 得分 0
不要沉了呀Top
8 楼cathyli（）回复于 2005-04-04 16:00:07 得分 0
昨晚又调试了一下,但是就是运行不出来,还请个位大侠帮帮看看
Dim tp(1000) As Integer
Const k = 3
Dim t As Integer
Dim s As Integer
Dim test As Integer
Dim px(1000) As Single
Dim py(1000) As Single
Dim zx(3) As Double
Dim zy(3) As Double
Dim z0x(3) As Double
Dim z0y(3) As Double
Dim dx(1000) As Single
Dim dy(1000) As Single
Dim d(1000) As Single
Private Sub Form_Load()
Dim i As Integer
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 ,SCO from score"
Set RecordDate = g_Conn.Execute(strSQL)
px(i) = RecordDate("id").Value
py(i) = RecordDate("sco").Value
'选k个初始聚类中心 z[i]
For i = 0 To 2
z0x(i) = px(i)
z0y(i) = py(i)
Next i
For i = 1 To total
tp(i) = 0
Next i
'进行迭代，对total个样本根据聚类中心进行分类
Dim dx(1000) As Integer
t = 0 '记录point[i]暂时在哪个类中
For i = 1 To total
For j = 1 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 f
r = distance(dx(t), dy(t))
f = distance(dx(i), dy(i))
If (r > f) Then
t = j
End If
Next j
tp(i) = t
Print "经比较后，点（px(i) ，py(i)）属于 t 类"
Next i
For i = 1 To k '计算新的聚类中心
Call newcentre(i)
Print "初始时第{i}类中心为 zx(i),zy(i)"
If (zx(i) Eqv z0x(i) And zy(i) Eqv z0y(i)) Then '对前后两次的聚类中心进行比较
test = test + 1
Else: z0x(i) = zx(i)
z0y(i) = zy(i)
End If
Next i
While (test <> k) '进行迭代
For i = 1 To total
For j = 1 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 n
r = distance(dx(t), dy(t))
f = distance(dx(i), dy(i))
If r > f Then
t = j
End If
Next j
tp(i) = t
Print "经比较后，点（px(i)，py(i)）属于 t 类"
Next i
For i = 1 To k
Call newcentre(i)
Print "第{i}类中心为 zx(i),zy(i)"
If (zx(i) Eqv z0x(i) And zy(i) Eqv z0y(i)) Then
test = test + 1
Else: z0x(i) = zx(i)
z0y(i) = zy(i)
End If
Next i
Wend
s = s + 1
Print "第s次迭代后，点（px(i)，py(i)）属于 t 类"
End Sub
Function distance(m, n)
s = m * m + n * n
End Function
'计算新的聚类中心
Function newcentre(i)
Dim m As Integer
Dim sumx As Double
Dim sumy As Double
v = 1 (本来这里应该初始值应该是0的,但是一改为0,下面的除法就会报错)
For j = 1 To total
If tp(j) = i Then
sumx = px(j) + sumx
sumy = py(j) + sumy
v = v + 1
End If
Next j
zx(i) = sumx \ v
zy(i) = sumy \ v
Print "zx(i) is:"; zx(i)
Print "zy(i) is:"; zy(i)
End FunctionTop
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
