main.frm

用vb实现的C均值聚类分析

            groupIdArr(i + iterCount * cArrSize) = groupIndentifyArr(i)
        Next i
        
        'cal clusterNum
        For i = 1 To cArrSize Step 1
                eachClusterNum(groupIndentifyArr(i)) = eachClusterNum(groupIndentifyArr(i)) + 1
        Next i
        
        'cal each ele's set's num of elements
        For i = 1 To cArrSize Step 1
                groupEleNum(i + iterCount * cArrSize) = eachClusterNum(groupIndentifyArr(i))
        Next i
        
        '---start of sort the sequence for the set for that no interleave in drawing clustering pic
               
        If (groupNum >= 2) Then 'if only one group ,no need to use sort,as it is a sorted arr
            
            'After update ,use bucket ,which is a ds to help enhance the efficiency to O(n)
            For i = 1 To cArrSize Step 1
                checkArr(i) = False
            Next i
            
            i = 1   'pre seqArr Index
            j = 1   'cur seqArr Index
            m = 1   'group Index
            'while(preGroupNum<groupNum) as group num will be reduced ,so ,use the pan bie below
            While (i <= cArrSize And j <= cArrSize)
                'order by set sequence
                'get pre set's first element
                tempInt = seqArr(i + (iterCount - 1) * cArrSize)
                
                'pre round check
                'if in the pre iteration ,they are in the same set.
                'so ,compare in the pre round
                'using pregroup id to check
                'actually ,it is a copy operation
                k = 1
                While (k <= groupEleNum(tempInt + (iterCount - 1) * cArrSize))
                    If checkArr(seqArr(i + (iterCount - 1) * cArrSize)) = False Then
                        seqSet(j) = seqArr(i + (iterCount - 1) * cArrSize)
                        checkArr(seqArr(i + (iterCount - 1) * cArrSize)) = True
                    
                        j = j + 1
                        i = i + 1
                    End If
                        
                    'skip the current new include element
                 If (i < cArrSize) Then
                     While (i < cArrSize And checkArr(seqArr(i + (iterCount - 1) * cArrSize)) = True)
                        i = i + 1
                        If (i >= cArrSize) Then GoTo out1
                     Wend
                End If
out1:
                                      
                    k = k + 1
                Wend
                
                'current round check
                'set has changed
                'get comparation in the current round
                'use there group id to compare
                For k = 1 To cArrSize
                    If (groupIndentifyArr(tempInt) = groupIndentifyArr(k) And checkArr(k) = False) Then
                            seqSet(j) = k
                            j = j + 1
                                                           
                            checkArr(k) = True
                    End If
                Next k
                
                'data update
                'update pre seqSet index
                'i = i + groupEleNum(tempInt + (iterCount - 1) * cArrSize)
                 'skip the current new include element
                If (i < cArrSize) Then
                     While (i < cArrSize And checkArr(seqArr(i + (iterCount - 1) * cArrSize)) = True)
                        i = i + 1
                        If (i >= cArrSize) Then GoTo out2
                     Wend
                End If
out2:
                
                'update the groupnum index
                m = m + 1
            Wend
            
            Debug.Print i; j
            Debug.Print i = cArrSize + 1 And j = cArrSize + 1
            
            For i = 1 To cArrSize
                seqArr(i + iterCount * cArrSize) = seqSet(i)
            Next i
              
        Else
            For i = 1 To cArrSize
                seqArr(i + iterCount * cArrSize) = seqSet(i)
            Next i
        End If
        '---end of sort draw sequence---
          
       
          
        '---for debug check---
'        Debug.Print groupNum ' groupIndengifyArr
'        Debug.Print "$" & Chr(13) & Chr(10)
'
'        For i = 1 To cArrSize Step 1
'            Debug.Print groupIndentifyArr(i);
'        Next i
     
        
        'data update
        limitLine = limitLine - limitStep
        For i = 1 To cArrSize
            preGroupIndentifyArr(i) = groupIndentifyArr(i)
        Next i
        'preGroupNum = groupNum
Wend
        
'-----------equip queueArr-------------------
queueIndex = 1
limitLine = 1
iterCount = 1
While (limitLine >= expectedLimit)
        i = 1 'point to the last seqSet
        While (i <= cArrSize)
            tempInt = groupEleNum(seqSet(i) + iterCount * cArrSize)
            
            queueArr(queueIndex) = tempInt
            queueIndex = queueIndex + 1
            
            i = i + tempInt
        Wend
               
        queueArr(queueIndex) = -1
        queueIndex = queueIndex + 1
         
        'data update
        limitLine = limitLine - limitStep
        iterCount = iterCount + 1
Wend
        queueArr(queueIndex) = END_QUEUE
 '---------end of equip queueArr------------
        
 '----------drawing the cluster pics---------
        '----initialize the core data----
        ReDim setPointArr(cArrSize)
        ReDim setPointArr2(cArrSize)
        For i = 1 To cArrSize
            setPointArr(i).x = -1000
            setPointArr(i).y = -1000
            setPointArr(i).elementNum = -1
            setPointArr2(i).x = -1000
            setPointArr2(i).y = -1000
            setPointArr2(i).elementNum = -1
        Next i
          
        '--canvas setting--
        pic.ScaleMode = 0   'user definitation
        pic.ScaleHeight = 100
        pic.ScaleWidth = 100
        pic.Height = pic.Width
        
        stepX = Int(pic.ScaleWidth / (cArrSize + 5))
        stepY = Int(pic.ScaleHeight / 80)
        
        
'        For i = 0 To 9 Step 1
'            Line1(i).X1 = -pic.ScaleWidth
'            Line1(i).X2 = pic.ScaleWidth
'            Line1(i).Y1 = i * stepY
'            Line1(i).Y2 = i * stepY
'
'        Next i
        
        For i = 0 To 9 Step 1
            Line1(i).Visible = False
        Next i
        
       For i = 0 To 99 Step 1
         pic.Line (-pic.ScaleWidth, i * stepY)-(pic.ScaleWidth, i * stepY)
       Next i
        
       'Print stepX
        
        For i = 0 To cArrSize Step 1
            Label2(i).Caption = ""
            Label2(i).Top = 480
            Label2(i).Left = 1400 + i * stepX * 60
        Next i
        
        '----end of pic initialize--
          
        '---main part of drawing--
        For i = 1 To cArrSize
            setPointArr(i).x = 5 + stepX * (i - 1)
            setPointArr(i).y = 0
            setPointArr(i).elementNum = 1
        Next i
          
        queueIndex = 1
        tempInt = queueArr(queueIndex)
        queueIndex = queueIndex + 1
        'countSetNum 'just free the first iter group nums
        iterCount = 1

While (iterCount <= totalClusterTime)
    preI = 1
    descI = 1
    
    While ((Not tempInt = -1) And (Not tempInt = END_QUEUE))
       If (setPointArr(preI).elementNum < tempInt) Then
            
            tmpSum = setPointArr(preI).elementNum
            
            m = preI
            
            While (tmpSum < tempInt)
                preI = preI + 1
                tmpSum = tmpSum + setPointArr(preI).elementNum
            Wend
            
            'Debug.Print tmpSum = tempInt
              
            'draw a line in horizontal
            pic.Line (setPointArr(m).x, setPointArr(m).y)-(setPointArr(preI).x, setPointArr(preI).y), RGB(0, 0, 255)
                    
            'draw a line in vertical
            pic.Line (Int((setPointArr(m).x + setPointArr(preI).x) / 2), Int(setPointArr(preI).y))-(Int((setPointArr(m).x + setPointArr(preI).x) / 2), Int(setPointArr(preI).y + stepY)), RGB(0, 0, 255)
                    
                           
            'merge ,update x,y
            setPointArr2(descI).x = Int((setPointArr(m).x + setPointArr(preI).x) / 2)
            setPointArr2(descI).y = Int(setPointArr(preI).y + stepY)
            setPointArr2(descI).elementNum = tmpSum
            
            'pre index forwarding
            preI = preI + 1
        Else
            'Debug.Print tempInt = setPointArr(preI).elementNum
            
            pic.Line (setPointArr(preI).x, setPointArr(preI).y)-(setPointArr(preI).x, Int(setPointArr(preI).y + stepY)), RGB(0, 0, 255)
                    
            'update x,y
            setPointArr2(descI).x = setPointArr(preI).x
            setPointArr2(descI).y = Int(setPointArr(preI).y + stepY)
            setPointArr2(descI).elementNum = setPointArr(preI).elementNum
                
            'pre index forwarding
            preI = preI + 1
        End If
        'desc index forwarding,get next element
        tempInt = queueArr(queueIndex)
        queueIndex = queueIndex + 1
        descI = descI + 1
    Wend

        'copy back setPoint2-->setPoint
         For i = 1 To descI - 1
            setPointArr(i).x = setPointArr2(i).x
            setPointArr(i).y = setPointArr2(i).y
            setPointArr(i).elementNum = setPointArr2(i).elementNum
         Next i
    
    'eleminate -1,get next proper word.
    tempInt = queueArr(queueIndex)
    queueIndex = queueIndex + 1
    
    'iter increase
    iterCount = iterCount + 1
Wend
        
        For i = 0 To cArrSize - 1 Step 1
            Label2(i).Caption = seqSet(i + 1)
        Next i
 '---end of drawing clustering pics---
 
End Sub

Private Sub Combo1_Change()
    cmdCluster.SetFocus
End Sub

Private Sub Combo1_Click()
    cmdCluster.SetFocus
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Me.Show
    Combo1.ListIndex = 0
    cmdCluster.SetFocus
    reset_form
End Sub


'IO
Function readInOriginalData(fileName As String)
    
    Dim rowCount As Integer, colCount As Integer
    
    Open App.Path + ".\" + fileName For Input As #1
    
    Input #1, dataArrRow, dataArrCol
    
    Debug.Print "==start of readInOriginalData==" & Chr(13) & Chr(10)
    
    rowCount = 1
    
    ReDim dataArr(dataArrRow, dataArrCol)
    
    While Not EOF(1)
      
      For colCount = 1 To dataArrCol
        Input #1, dataArr(rowCount, colCount)
      Next colCount
      
      rowCount = rowCount + 1
      'Debug.Print windCount(i, 1), windCount(i, 2), windCount(i, 3), windCount(i, 4) & Chr(13) & Chr(10)
    Wend
    Debug.Print "==end of readInOriginalData==" & Chr(13) & Chr(10)
    
    Close #1
End Function

Sub countSetNum()
    tempInt = queueArr(queueIndex)
    queueIndex = queueIndex + 1

    innerIterCount = 0
    While (Not ((tempInt = -1) Or (tempInt = END_QUEUE)))
        tempInt = queueArr(queueIndex)
        queueIndex = queueIndex + 1
        innerIterCount = innerIterCount + 1 'control by the next iterator group nums
    Wend
   
End Sub


Sub reset_form()
    Dim i As Integer
    
    For i = 0 To 20 Step 1
        Label2(i).Caption = ""
        Label2(i).BackStyle = 0 'transparent
    Next i

End Sub