测试数据.txt

FCM与硬聚类算法

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
         For i = 1 To DataNumber
             Temp = 0
             For j = 1 To Cluster
                Temp = Temp + Fcm.Degree(j, i) * j   '去隶书乘以对应的类别数之和
             Next
             Fcm.Class(i) = CInt(Temp)
      Next
    ElseIf AntiFuzzy = Middle Then
        For i = 1 To DataNumber
            Temp = 0
            For j = 1 To Cluster
                If Temp <= 0.5 And Temp + Fcm.Degree(j, i) >= 0.5 Then