modgap.bas

匈牙利法指派

                Wend
                If (sb.cost(0, 0) > 0) Then
                    twozero sb, iResult
                Else
                    judge sb, iResult
                End If
            End If
            sb = st
        Next J
    End If
'}//twozero
End Sub


Sub judge(ByRef sb As matrix, ByRef iResult() As Integer)

    Dim I As Integer, J As Integer
    Dim m  As Integer
    Dim n As Integer
    Dim k As Integer
    m = 0
    For I = 1 To sb.matrixsize
        For J = 1 To sb.matrixsize
            If (sb.zeroelem(I, J) = 1) Then m = m + 1
        Next J
    Next I
    If (m = sb.matrixsize) Then
   
        k = 1
        For n = 1 To iResult(0, 0)
        
            For I = 1 To sb.matrixsize
            
                For J = 1 To sb.matrixsize
                    If (sb.zeroelem(I, J) = 1) Then Exit For
                      
                Next J
                If (I <= sb.personnumber And J <= sb.jobnumber) Then
                    If (J <> iResult(k, 1)) Then Exit For
                End If
                k = k + 1
            
            Next I
            If (I = sb.matrixsize + 1) Then
                Exit For
            Else
                k = n * sb.matrixsize + 1
            End If
        Next n
        If (n > iResult(0, 0)) Then
        
            k = iResult(0, 0) * sb.matrixsize + 1
            For I = 1 To sb.matrixsize
                For J = 1 To sb.matrixsize
                    If (sb.zeroelem(I, J) = 1) Then
                    
                        iResult(k, 0) = I
                        iResult(k, 1) = J ' result(k++,1) C语言的特点？？？
                        k = k + 1 '
                    End If
                Next J
            Next I
            iResult(0, 0) = iResult(0, 0) + 1
        End If
    
    Else
    
        Refresh sb, iResult
    
    End If
'}//judge

End Sub

Sub Refresh(ByRef sb As matrix, ByRef iResult() As Integer)


    Dim I As Integer, J As Integer
    Dim k As Double
    Dim P As Integer
    k = 0

    For I = 1 To sb.matrixsize
    
        For J = 1 To sb.matrixsize
            If (sb.zeroelem(I, J) = 1) Then
            
                sb.zeroelem(I, 0) = 1     ' //有独立零元素
                Exit For
            End If
        Next J
    Next I
    While (k = 0)
    
        k = 1
        For I = 1 To sb.matrixsize
            If (sb.zeroelem(I, 0) = 0) Then
            
                sb.zeroelem(I, 0) = 2
                For J = 1 To sb.matrixsize
                    If (sb.zeroelem(I, J) = 2) Then
                        sb.zeroelem(0, J) = 1
                    End If
                Next J
            End If
        Next I
        For J = 1 To sb.matrixsize
        
            If (sb.zeroelem(0, J) = 1) Then
            
                sb.zeroelem(0, J) = 2
                For I = 1 To sb.matrixsize
                    If (sb.zeroelem(I, J) = 1) Then
                    
                        sb.zeroelem(I, 0) = 0
                        k = 0
                    End If
                Next I
            End If
        Next J
    Wend '                    //为2的行或者列是打"√"的
    P = 0
    k = 0
    For I = 1 To sb.matrixsize
    
        If (sb.zeroelem(I, 0) = 2) Then
        
            For J = 1 To sb.matrixsize
            
                If (sb.zeroelem(0, J) <> 2) Then
                    If (P = 0) Then
                    
                        k = sb.cost(I, J)
                        P = 1
                    
                    Else
                    
                        If (sb.cost(I, J) < k) Then k = sb.cost(I, J)
                    End If
                    
                End If
            Next J
        End If
    Next I
    For I = 1 To sb.matrixsize
    
        If (sb.zeroelem(I, 0) = 2) Then
            For J = 1 To sb.matrixsize
                sb.cost(I, J) = sb.cost(I, J) - k
            Next J
        End If
    Next I

    For J = 1 To sb.matrixsize
    
        If (sb.zeroelem(0, J) = 2) Then
            For I = 1 To sb.matrixsize
                sb.cost(I, J) = sb.cost(I, J) + k
            Next I
                                   '  //化简矩阵
        End If
    Next J
    For I = 0 To sb.matrixsize
        For J = 0 To sb.matrixsize
            sb.zeroelem(I, J) = 0 '              //清0
        Next J
    Next I
    circlezero sb, iResult
'}//refresh
End Sub


Sub zeroout(ByRef sb As matrix) '行减去最小值出0，然后 列减去最小值出0

    Dim I As Integer, J As Integer
    Dim k As Single
    
    For I = 1 To sb.matrixsize
    
        k = sb.cost(I, 1)
        For J = 2 To sb.matrixsize
            If sb.cost(I, J) < k Then k = sb.cost(I, J)
        Next J
        For J = 1 To sb.matrixsize
            sb.cost(I, J) = sb.cost(I, J) - k
        Next J
    Next I
    For J = 1 To sb.matrixsize
        k = sb.cost(1, J)
        For I = 2 To sb.matrixsize
            If sb.cost(I, J) < k Then k = sb.cost(I, J)
        Next I
        For I = 1 To sb.matrixsize
            sb.cost(I, J) = sb.cost(I, J) - k
        Next I
    Next J
'//zeroout
End Sub


Sub output(ByRef iResult() As Integer, ByRef sb As matrix)


    Dim k  As Integer
    Dim I  As Integer
    Dim J As Integer
    Dim P As Integer
    Dim w As Integer
    Dim v As Single

    v = 0
    For I = 1 To sb.matrixsize
    
        v = v + sb.costforout(I, iResult(I, 1))
    Next I
    
    Debug.Print "最优解的目标函数值为" & v

    k = iResult(0, 0)
    If (k > 5) Then
    
        Debug.Print "解的个数超过了限制"
        k = 5
    End If
    For I = 1 To k
    
        Debug.Print "输出解编号：" & I
        
        P = (I - 1) * sb.matrixsize + 1
        For J = P To P + sb.matrixsize - 1
            If (iResult(J, 0) <= sb.personnumber And iResult(J, 1) <= sb.jobnumber) Then
                Debug.Print "第" & iResult(J, 0) & "个人做第" & iResult(J, 1) & "件工作"
            End If
        Next J
        
    Next I
'}//output
End Sub


Sub funCalAP(ByRef iResult() As Integer, ByRef iMatrix() As Integer, ByVal iPeople As Integer, ByVal iWork As Integer, ByVal iMode As Byte)
    Dim sb As matrix
    iResult(0, 0) = 0
    inputData iMatrix, iPeople, iWork, iMode, sb
    zeroout sb
    circlezero sb, iResult
    output iResult, sb
'}//main
End Sub