HCM.rar_fcm_hcm_vb6_硬聚类

Private Declare Function GetTickCount Lib "kernel32" () As Long Private Enum IniCenterMethod '初始中心的方法 CreateRandom '随机的中心点 CreateByHcm '由HCM创建的中心点 CreateByRandomZadeh '先随机创建隶属矩阵，然后计算得到的中心点 CreateByHand '手工确定初始中心点 End Enum Private Enum AntiFuzzyMethod '反模糊的方法 Max '最大隶属度法 Middle '中位数法 Mean '加权均值法 End Enum Private Type FcmInfo Center() As Double '聚类中心 Degree() As Double '隶属度，为Double类型 Class() As Byte '记录数据属于那一类 TimeUse As Long '所用时间 Iterations As Long '迭带次数 ErrMsg As String '错误信息 End Type Private Type HcmInfo Center() As Double '聚类中心 Class() As Byte '记录数据属于那一类 TimeUse As Long '所用时间 Iterations As Long '迭带次数 ErrMsg As String '错误信息 End Type '************************************************************************************* '* 作 者 ： Ivan '* 函 数 名 ： Fcm '* 参 数 ： Data - 待分类的样本，第一维的大小表示样本的个数， '* 第二维的大小表示样本的维数 '* Cluster - 分类数 '* CreateIniCenter - 初始聚类中心的创建方法 '* AntiFuzzy - 反模糊化的方法 '* Exponent - 一个控制聚类效果的参数，一般取2 '* Maxiterations - 最大的迭代次数 '* MinImprovement - 最小的改进参数（两次迭代间聚类中心的距离） '* 返回值 ： FcmInfo结构，记录了相关的参数 '* 功能描述 ： 利用模糊理论的聚类方法把数据分类 '* 日 期 ： 2004-10-27 10.25.32 '* 修 改 人 ： laviewpbt '* 日 期 ： 2006-11-7 19.25.31 '* 版 本 ： Version 2.3.1 '************************************************************************************** Private Function Fcm(ByRef Data() As Double, ByVal Cluster As Long, Optional ByVal CreateIniCenter As IniCenterMethod = IniCenterMethod.CreateByHcm, Optional AntiFuzzy As AntiFuzzyMethod = Max, Optional Exponent As Byte = 2, Optional Maxiterations As Long = 400, Optional MinImprovement As Double = 0.01, Optional ByRef CenterByHandle As Variant) As FcmInfo If ArrayRange(Data) <> 2 Then Fcm.ErrMsg = "数据只能为二维数组" Exit Function End If Dim i As Long, j As Long, k As Long, l As Long, m As Long Dim DataNumber As Long, DataSize As Long Dim Temp As Double, Sum1 As Double, Sum2 As Double, Sum3 As Double, Index As Integer Dim OldCenter() As Double Fcm.TimeUse = GetTickCount DataNumber = UBound(Data, 1): DataSize = UBound(Data, 2) ReDim Fcm.center(1 To Cluster, 1 To DataSize) As Double ReDim Fcm.Degree(1 To Cluster, 1 To DataNumber) As Double ReDim Fcm.Class(1 To DataNumber) As Byte ReDim OldCenter(1 To Cluster, 1 To DataSize) As Double On Error GoTo ErrHandle: Randomize If CreateIniCenter = CreateRandom Then For i = 1 To Cluster For j = 1 To DataSize OldCenter(i, j) = Data(Rnd * DataNumber, j) '产生随机初始中心点 Next Next ElseIf CreateIniCenter = CreateByHcm Then Dim HcmCenter As HcmInfo HcmCenter = Hcm(Data, Cluster) For i = 1 To Cluster For j = 1 To DataSize OldCenter(i, j) = HcmCenter.center(i, j) '产生HCM初始中心点 Next Next ElseIf CreateIniCenter = CreateByRandomZadeh Then ReDim RndDegree(1 To Cluster, 1 To DataNumber) As Double Dim RndSum As Double For i = 1 To Cluster For j = 1 To DataNumber RndDegree(i, j) = Rnd '创建随机的隶属度 Next Next For j = 1 To DataNumber RndSum = 0 For i = 1 To Cluster RndSum = RndSum + RndDegree(i, j) Next For i = 1 To Cluster RndDegree(i, j) = RndDegree(i, j) / RndSum '隶属度矩阵每列之后必须为1 Next Next For i = 1 To Cluster For j = 1 To DataSize Sum1 = 0: Sum2 = 0 For k = 1 To DataNumber Temp = Exp(Log(RndDegree(i, k)) * Exponent) '其实就是RndDegree(i, k)^Exponent Sum1 = Sum1 + Temp * Data(k, j) '隶属度的平方乘以数值 Sum2 = Sum2 + Temp '隶属度的和 Next OldCenter(i, j) = Sum1 / Sum2 '得到聚类中心 Next Next ElseIf CreateIniCenter = CreateByHand Then If IsMissing(CenterByHandle) Then Fcm.ErrMsg = "请提供初始聚类中心。." Exit Function ElseIf UBound(CenterByHandle, 1) <> Cluster Or UBound(CenterByHandle, 2) <> DataSize Then Fcm.ErrMsg = "手工提供的初始聚类中心维数有错误." Exit Function End If For i = 1 To Cluster For j = 1 To DataSize OldCenter(i, j) = CenterByHandle(i, j) Next Next End If Do Fcm.Iterations = Fcm.Iterations + 1 For i = 1 To Cluster For j = 1 To DataNumber Sum1 = 0: Sum3 = 1 For k = 1 To DataSize Temp = Data(j, k) - OldCenter(i, k) Sum1 = Sum1 + Temp * Temp '计算第j点到第i个聚类中心的距离 Next If Sum1 = 0 Then Fcm.Degree(i, j) = 1 '如果j点与第i个聚类中心重合，则完全属于该类 Else For k = 1 To Cluster Sum2 = 0 If k <> i Then For l = 1 To DataSize Temp = Data(j, l) - OldCenter(k, l) Sum2 = Sum2 + Temp * Temp '计算第j点到其他聚类中心的距离 Next Sum3 = Sum3 + Exp(Log(Sum1 / Sum2) * (2 / (Exponent - 1))) '计算累加值, End If Next Fcm.Degree(i, j) = 1 / Sum3 '计算新的隶属度 End If Next Next For i = 1 To Cluster For j = 1 To DataSize Sum1 = 0: Sum2 = 0 For k = 1 To DataNumber Temp = Exp(Log(Fcm.Degree(i, k)) * Exponent) Sum1 = Sum1 + Temp * Data(k, j) '隶属度的平方乘以数值 Sum2 = Sum2 + Temp '隶属度的和 Next Fcm.Center(i, j) = Sum1 / Sum2 '得到新的聚类中心 Next Next Temp = 0 For i = 1 To Cluster For j = 1 To DataSize Temp = Temp + (OldCenter(i, j) - Fcm.Center(i, j)) ^ 2 ' 计算两次迭代之间的聚类中心的距离 OldCenter(i, j) = Fcm.Center(i, j) ' 保留上一次的聚类中心 Next Next Loop While Fcm.Iterations < Maxiterations And Temp > MinImprovement If AntiFuzzy = Max Then For i = 1 To DataNumber Temp = -1 For k = 1 To Cluster If Temp < Fcm.Degree(k, i) Then '得到列方向的最大值 Temp = Fcm.Degree(k, i) Index = k End If Next Fcm.Class(i) = Index 'Index记录了列方向最大隶属度的类 Next ElseIf AntiFuzzy = Mean Then Fo