测试数据.txt

FCM与硬聚类算法

                    Index = j
                    Exit For
                Else
                    Temp = Temp + Fcm.Degree(j, i)   '取面积的一半处
                End If
            Next
            Fcm.Class(i) = Index
        Next
    End If
    Fcm.TimeUse = GetTickCount - Fcm.TimeUse
    Exit Function
ErrHandle:
    Fcm.ErrMsg = Err.Description
    Fcm.TimeUse = GetTickCount - Fcm.TimeUse
End Function


'*************************************************************************************
'*    作    者 ：    Ivan
'*    函 数 名 ：    Hcm
'*    参    数 ：    Data     -   待分类的样本，第一维的大小表示样本的个数，
'*                                第二维的大小表示样本的维数
'*                   Cluster  -   分类数
'*                   Maxiterations  - 最大的迭代次数
'                    MinImprovement - 最小的改进参数（两次迭代间聚类中心的距离）
'*    返回值 ：      HcmInfo结构，记录了相关的参数
'*    功能描述 ：    直接利用硬聚类方法把数据分类
'*    日    期 ：    2004-10-24 20.10.56
'*    修 改 人 ：    laviewpbt
'*    日    期 ：    2006-11-7 20.11.23
'*    版    本 ：    Version 2.3.1
'**************************************************************************************


Private Function Hcm(ByRef Data() As Double, ByVal Cluster As Byte, Optional Maxiterations As Long = 400, Optional MinImprovement As Double = 0.01) As HcmInfo
    If ArrayRange(Data) <> 2 Then
        Hcm.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, DX As Double, DY As Double, SumValue() As Double, SumNumber() As Long
    Dim OldCenter() As Double, Distance As Double, Dist As Double, Index As Long
    On Error GoTo ErrHandle:
    Hcm.TimeUse = GetTickCount
    DataNumber = UBound(Data, 1): DataSize = UBound(Data, 2)
    ReDim Hcm.Center(1 To Cluster, 1 To DataSize) As Double
    ReDim Hcm.Class(1 To DataNumber) As Byte
    ReDim OldCenter(1 To Cluster, 1 To DataSize) As Double
    For i = 1 To Cluster
        For j = 1 To DataSize
            OldCenter(i, j) = Data(i * DataNumber / Cluster, j) '产生初始中心点
        Next
    Next
    Do
        Hcm.Iterations = Hcm.Iterations + 1
        ReDim SumNumber(Cluster) As Long
        ReDim SumValue(Cluster, DataSize) As Double
        For i = 1 To DataNumber
            Distance = 40000000000#
            For j = 1 To Cluster
                Dist = 0
                For k = 1 To DataSize
                    Temp = Data(i, k) - OldCenter(j, k)
                    Dist = Dist + Temp * Temp             '计算第j点到第i个聚类中心的距离
                Next
                If Distance > Dist Then
                    Distance = Dist
                    Index = j                         '把i点归于距离该点最近的中心点所在的类
                End If
            Next
            Hcm.Class(i) = Index
            For j = 1 To DataSize
                SumValue(Index, j) = SumValue(Index, j) + Data(i, j)
            Next
            SumNumber(Index) = SumNumber(Index) + 1
        Next
        
        For i = 1 To Cluster
            For k = 1 To DataSize
                If SumNumber(i) = 0 Then
                    Hcm.Center(i, k) = Data(Rnd * DataNumber, k)
                Else
                    Hcm.Center(i, k) = SumValue(i, k) / SumNumber(i)         '求新的中心
                End If
            Next
        Next
        Temp = 0
        For i = 1 To Cluster
            For j = 1 To DataSize
                Temp = Temp + (OldCenter(i, j) - Hcm.Center(i, j)) ^ 2      ' 计算两次迭代之间的聚类中心的距离
                OldCenter(i, j) = Hcm.Center(i, j)                          ' 保留上一次的聚类中心
            Next
        Next
    Loop While Hcm.Iterations < Maxiterations And Temp > MinImprovement
    Hcm.TimeUse = GetTickCount - Hcm.TimeUse
    Exit Function
ErrHandle:
    Hcm.ErrMsg = Err.Description
    Hcm.TimeUse = GetTickCount - Hcm.TimeUse
    End Function

 

'*************************************************************************************
'*    作    者 ：    Ivan
'*    函 数 名 ：    ArrayRange
'*    参    数 ：    Data     -   待测试的数据
'*    返回值 ：      返回数组的维数
'*    日    期 ：    2006-7-10 13.20.40
'*    修 改 人 ：    laviewpbt
'*    日    期 ：    2006-11-7 10。10。45
'*    版    本 ：    Version 1.2.1
'**************************************************************************************
Public Function ArrayRange(Data() As Double) As Integer
    Dim i As Integer, ret As Integer
    Dim ErrF As Boolean
    ErrF = False
    On Error GoTo ErrHandle
    For i = 1 To 60               'VB中数组最大为60
        ret = UBound(mArray, i)   '用UBound函数判断某一维的上界，如果大数组的实际维数时产生超出范围错误，此时我们通过Resume Next 来捕捉错这个错误
        ret = ret + 1
        If ErrF Then Exit For
    Next
    ArrayRange = ret
    Exit Function
ErrHandle:
    ret = i
    ErrF = True
    Resume Next
End Function

 

 

 

 测试情况：

1、简单数据的聚类

原始数据为:
1    2    
2    3    
1.5    2.5    
1.5    2    
5.1    1    
4.1    1    
5    3    
6    2    
聚类中心为:
1.500    2.374    
5.062    1.750    
隶属矩阵为:
1.00 1.00 1.00 1.00 0.00 0.03 0.02 0.00 
0.00 0.00 0.00 0.00 1.00 0.97 0.98 1.00 
迭代次数为:2

以下是一组气候的统计数据，根据要求我们把气候分为三类：



原始数据为:
1    3.5    1    0    
2    2.5    2    2    
2    3.5    1    1    
3    3    3    1    
3    3    1    1    
5    .5    5    2    
6    1.5    4    0    
6    1.5    4    1    
5    3    2    2    
4    3    1    2    
聚类中心为:
4.434    2.992    1.600    1.948    
5.740    1.251    4.250    0.931    
1.902    3.280    1.204    0.845    
隶属矩阵为:
0.09 0.26 0.02 0.40 0.26 0.12 0.08 0.02 0.92 0.88 
0.04 0.08 0.00 0.16 0.04 0.82 0.89 0.97 0.04 0.03 
0.87 0.67 0.98 0.44 0.70 0.06 0.04 0.01 0.03 0.09 
迭代次数为:4
每个样本的类别为：
3 3 3 3 3 2 2 2 1 1 


这个分析的结果是可以接受的。

2 、二维数据的聚类

随机生成二维的数据，然后比较分类结果

 

 上图中第一排第二个式HCM的结果，其他的图是不同的参数相结合的FCM的结果，至于结果的好坏对于这些点群不好说。



  这副图选择的聚类类别为4，中间那4个点被聚集到左上角的一类，FCM和HCM的结果是一样的。



      上面这副图的聚类类别为4，但他显示出无论HCM还是FCM都没有给出合理的分类，产生这一现象的原因与其说是算法的问题，不如说是对距离的定义，在FCM/HCM中我们使用的是欧式距离，这使得中间那一部分到左侧的距离要近一些，因此被聚集到这个类中。通过适当改变对距离的定义，我们也可以得到合理的结果。