modgap.bas

匈牙利法指派

Attribute VB_Name = "modGAP"
Option Explicit

Type matrix
     cost() As Single
     zeroelem() As Integer
     costforout() As Single
     matrixsize As Long
     personnumber As Long
     jobnumber As Long
End Type

'Dim sb As matrix

'Dim result(501, 2) As Long

'void twozero(matrix &sb);
'void judge(matrix &sb,int result(501,2));
'void refresh(matrix &sb);
'void circlezero(matrix &sb);
'matrix inputData();
'void output(int result(501,2),matrix sb);
'void zeroout(matrix &sb);

Function inputData(ByRef iMatrix() As Integer, ByVal iPeople As Integer, ByVal iWork As Integer, ByVal iMode As Byte, ByRef sb As matrix)

    'Dim sb As matrix

    Dim pnumber As Long, jnumber As Long
    Dim I As Long, J As Long
    Dim k As Double
    Dim w As Byte
    
        sb.matrixsize = pnumber
    If (iPeople > iWork) Then
        sb.matrixsize = iPeople
    Else
        sb.matrixsize = iWork
        
    End If
    
    sb.personnumber = iPeople
    sb.jobnumber = iWork
    
    ReDim sb.cost(sb.matrixsize, sb.matrixsize)
    ReDim sb.zeroelem(sb.matrixsize, sb.matrixsize)
    ReDim sb.costforout(sb.matrixsize, sb.matrixsize)
    
    
    For I = 1 To iPeople
        For J = 1 To iWork
            sb.cost(I, J) = iMatrix(I, J)
            sb.costforout(I, J) = sb.cost(I, J)
        Next J
    Next I
    
    If (iMode = 1) Then '求最大效益值
    
        k = 0
        For I = 1 To sb.matrixsize
            For J = 1 To sb.matrixsize
                If sb.cost(I, J) > k Then k = sb.cost(I, J)
            Next J
        Next I
        For I = 1 To sb.matrixsize
            For J = 1 To sb.matrixsize
                sb.cost(I, J) = k - sb.cost(I, J)
            Next J
        Next I
    End If

End Function

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

    Dim I As Integer, J  As Integer
    Dim k As Single
    Dim P As Integer
    'VB 默认是0  ，C需要初始化
    'For I = 0 To sb.matrixsize
    '    sb.cost(I, 0) = 0
    'Next
    'For J = 1 To sb.matrixsize
    '    sb.cost(0, J) = 0
    'Next J
    For I = 1 To sb.matrixsize
        For J = 1 To sb.matrixsize
            If (sb.cost(I, J) = 0) Then
                sb.cost(I, 0) = sb.cost(I, 0) + 1 '行 0的数量+1
                sb.cost(0, J) = sb.cost(0, J) + 1 '列 0的数量+1
                sb.cost(0, 0) = sb.cost(0, 0) + 1 ' 矩阵0 的总数+1
            End If
        Next J
    Next I
    'VB 默认是0  ，C需要初始化
    'For I = 0 To sb.matrixsize
    '    For J = 0 To sb.matrixsize
    '        sb.zeroelem(I, J) = 0
    '    Next J
    'Next I
    k = sb.cost(0, 0) + 1
    While (sb.cost(0, 0) < k)
    
        k = sb.cost(0, 0)
        For I = 1 To sb.matrixsize
       
            If (sb.cost(I, 0) = 1) Then
           
                For J = 1 To sb.matrixsize
                    If (sb.cost(I, J) = 0 And sb.zeroelem(I, J) = 0) Then Exit For
                Next J
                sb.zeroelem(I, J) = 1
                sb.cost(I, 0) = sb.cost(I, 0) - 1
                sb.cost(0, J) = sb.cost(0, J) - 1
                sb.cost(0, 0) = sb.cost(0, 0) - 1
                If (sb.cost(0, J) > 0) Then
                    For P = 1 To sb.matrixsize
                        If (sb.cost(P, J) = 0 And sb.zeroelem(P, J) = 0) Then
                        
                            sb.zeroelem(P, J) = 2
                            sb.cost(P, 0) = sb.cost(P, 0) - 1
                            sb.cost(0, J) = sb.cost(0, J) - 1
                            sb.cost(0, 0) = sb.cost(0, 0) - 1
                        End If
                    Next P
                End If
            End If
        Next I
        For J = 1 To sb.matrixsize
        
            If (sb.cost(0, J) = 1) Then
            
                For I = 1 To sb.matrixsize
                    If sb.cost(I, J) = 0 And sb.zeroelem(I, J) = 0 Then Exit For
                Next I
                sb.zeroelem(I, J) = 1
                sb.cost(I, 0) = sb.cost(I, 0) - 1
                sb.cost(0, J) = sb.cost(0, J) - 1
                sb.cost(0, 0) = sb.cost(0, 0) - 1
                If (sb.cost(I, 0) > 0) Then
                    For P = 1 To sb.matrixsize
                        If (sb.cost(I, P) = 0 And sb.zeroelem(I, P) = 0) Then
                        
                            sb.zeroelem(I, P) = 2
                            sb.cost(I, 0) = sb.cost(I, 0) - 1
                            sb.cost(0, P) = sb.cost(0, P) - 1
                            sb.cost(0, 0) = sb.cost(0, 0) - 1
                        End If
                    Next P
                End If
            End If
        Next J
    Wend
    If (sb.cost(0, 0) > 0) Then
        twozero sb, iResult
    Else
        judge sb, iResult
    End If
        
'//circlezero
End Sub


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

    Dim I As Integer, J As Integer
    Dim P As Integer, q As Integer
    Dim m As Integer, n As Integer
    Dim k As Single
    Dim st As matrix
    For I = 1 To sb.matrixsize
        If (sb.cost(I, 0) > 0) Then Exit For
    Next I
    If (I <= sb.matrixsize) Then
  
        For J = 1 To sb.matrixsize
       
            st = sb ';//pay attention
            If (sb.cost(I, J) = 0 And sb.zeroelem(I, J) = 0) Then
           
                sb.zeroelem(I, J) = 1
                sb.cost(I, 0) = sb.cost(I, 0) - 1
                sb.cost(0, J) = sb.cost(0, J) - 1
                sb.cost(0, 0) = sb.cost(0, 0) - 1
                For q = 1 To sb.matrixsize
                    If (sb.cost(I, q) = 0 And sb.zeroelem(I, q) = 0) Then
                    
                        sb.zeroelem(I, q) = 2
                        sb.cost(I, 0) = sb.cost(I, 0) - 1
                        sb.cost(0, q) = sb.cost(0, q) - 1
                        sb.cost(0, 0) = sb.cost(0, 0) - 1
                    End If
                Next q
                For P = 1 To sb.matrixsize
                    If sb.cost(P, J) = 0 And sb.zeroelem(P, J) = 0 Then
                    
                        sb.zeroelem(P, J) = 2
                        sb.cost(P, 0) = sb.cost(P, 0) - 1
                        sb.cost(0, J) = sb.cost(0, J) - 1
                        sb.cost(0, 0) = sb.cost(0, 0) - 1
                    End If
                Next P

                k = sb.cost(0, 0) + 1
                While (sb.cost(0, 0) < k)
                
                    k = sb.cost(0, 0)
                    For P = I + 1 To sb.matrixsize
                    
                        If (sb.cost(P, 0) = 1) Then
                        
                            For q = 1 To sb.matrixsize
                                If (sb.cost(P, q) = 0 And sb.zeroelem(P, q) = 0) Then Exit For
                                    
                            Next q
                            sb.zeroelem(P, q) = 1
                            sb.cost(P, 0) = sb.cost(P, 0) - 1
                            sb.cost(0, q) = sb.cost(0, q) - 1
                            sb.cost(0, 0) = sb.cost(0, 0) - 1
                            For m = 1 To sb.matrixsize
                                If (sb.cost(m, q) = 0 And sb.zeroelem(m, q) = 0) Then
                                
                                    sb.zeroelem(m, q) = 2
                                    sb.cost(m, 0) = sb.cost(m, 0) - 1
                                    sb.cost(0, q) = sb.cost(0, q) - 1
                                    sb.cost(0, 0) = sb.cost(0, 0) - 1
                                End If
                            Next m
                        End If
                    Next P
                    For q = 1 To sb.matrixsize
                    
                        If (sb.cost(0, q) = 1) Then
                        
                            For P = 1 To sb.matrixsize
                                If (sb.cost(P, q) = 0 And sb.zeroelem(P, q) = 0) Then Exit For
                            Next P
                            sb.zeroelem(P, q) = 1
                            sb.cost(P, q) = sb.cost(P, q) - 1
                            sb.cost(0, q) = sb.cost(0, q) - 1
                            sb.cost(0, 0) = sb.cost(0, 0) - 1
                            For n = 1 To sb.matrixsize
                                If (sb.cost(P, n) = 0 And sb.zeroelem(P, n) = 0) Then
                                
                                    sb.zeroelem(P, n) = 2
                                    sb.cost(P, 0) = sb.cost(P, 0) - 1
                                    sb.cost(0, n) = sb.cost(0, n) - 1
                                    sb.cost(0, 0) = sb.cost(0, 0) - 1
                                End If
                            Next n
                        End If
                    Next q