form1.frm

vb环境下 匈牙利算法的解决 自己编的 仅供参考

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7515
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7905
   LinkTopic       =   "Form1"
   ScaleHeight     =   7515
   ScaleWidth      =   7905
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   6360
      TabIndex        =   2
      Top             =   600
      Width           =   855
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   6360
      TabIndex        =   1
      Top             =   120
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "ok"
      Height          =   375
      Left            =   6360
      TabIndex        =   0
      Top             =   1080
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const DM = 20
Dim A(1 To DM, 1 To DM) As Integer '原始矩阵
Dim c(1 To DM, 1 To DM) As Integer '效能矩阵
Dim a1(1 To DM, 1 To DM) As Integer '4,5,6步后符号矩阵
Dim d(1 To DM, 1 To DM) As Integer '8步三角号矩阵
Dim g(1 To DM, 1 To DM) As Integer '画线矩阵
Dim N, N1 As Integer 'n人分配
Private Function BH00(N As Integer)
Dim i, j  As Integer
For i = 1 To N
For j = 1 To N
 A(i, j) = Int(N * Rnd + 1)
   Next j: Next i
For i = 1 To N: For j = 1 To N
Print A(i, j);
  Next j
  Print
Next i
End Function
Private Function BH0(N As Integer) '初始化矩阵
Dim i, j, k As Integer
For i = 1 To N
For j = i + 1 To N
A(i, j) = i + j - 1
If A(i, j) > N Then
   A(i, j) = A(i, j) - N1
End If
 Next j: Next i
For i = 1 To N
For j = 1 To i
A(i, j) = i + j - 1
If A(i, j) > N Then
   A(i, j) = A(i, j) - N1
End If
  Next j: Next i
For i = 1 To N: For j = 1 To N
Print A(i, j);
  Next j
  Print
Next i
End Function

Private Sub Command1_Click()
N = Val(Text1.Text)

BH00 (N)
BH1 (N)
For i = 1 To N: For j = 1 To N
   a1(i, j) = 0
Next j: Next i
BX2 (N)
'For i = 1 To N
   ' For j = 1 To N
    ' If a1(i, j) = 1 Then
   '   k = k + 1
   '  End If
    ' Next j
   '  If k > 1 Then GoTo d
   '  Next i
  
'BX3 (N)
'd: PD2 (N)

End Sub

Private Function BH1(N As Integer) '求效能矩阵
Dim ARM(1 To 20) As Integer
Dim ACM(1 To 20) As Integer
Dim b(1 To 20, 1 To 20) As Integer
Dim i, j, k As Integer
For i = 1 To N: k = i
  ARM(k) = A(k, 1)
  For j = 1 To N
   If ARM(k) > A(k, j) Then
    ARM(k) = A(k, j)
   End If
    Next j:  Next i
'Print:  Print
 For i = 1 To N: For j = 1 To N
  b(i, j) = A(i, j) - ARM(i)
 ' Print b(i, j);
   Next j: Next i

 For j = 1 To N: k = j
 ACM(k) = b(1, k)
  For i = 1 To N
  If ACM(k) > b(i, k) Then
   ACM(k) = b(i, k)
    End If
    Next i:  Next j
   Print: Print
   For i = 1 To N: For j = 1 To N
  c(i, j) = b(i, j) - ACM(j)
 ' Print c(i, j);
    Next j: Next i
End Function
Private Function BX2(N As Integer) '4,5,6步
'Dim b(1 To 20) As Integer
Dim i, j, k, p, g As Integer
k1 = 1

For i = 1 To N: k = 0
    For j = 1 To N
    If c(i, j) = 0 Then
    If a1(i, j) = 0 Then
       k = k + 1: p = j
      End If
      End If
    Next j
       If k = 1 Then
       a1(i, p) = 1: q = i
For h = 1 To N
    If c(h, p) = 0 Then
    a1(h, p) = 2
    End If
    Next h
    a1(q, p) = 1
  End If
Next i

For i = 1 To N: k = 0
    For j = 1 To N
    If c(j, i) = 0 Then
    If a1(j, i) = 0 Then
       k = k + 1: p = j
      End If
      End If
    Next j
       If k = 1 Then
       a1(p, i) = 1: q = i
For h = 1 To N
    If c(p, h) = 0 Then
    a1(p, h) = 2
    End If
    Next h
    a1(p, q) = 1
  End If
Next i


For i = 1 To N
  k = 0
    For j = 1 To N
     If a1(i, j) = 1 Then
      k = k + 1
     End If
     Next j
     If k <> 1 Then
      For h = 1 To N
     If c(i, h) = 0 Then
     If a1(i, j) = 1 Or a1(i, j) = 2 Then
       k1 = 2
       Else: k1 = 3
     End If: End If
     Next h
    End If
         Next i
         
  Select Case k1
 Case 1
      BX3 (N)
  Case 2
      PD2 (N)
  Case 3
      BX2 (N)
End Select
End Function
Private Function BX3(N As Integer) '判断第一种情况
For i = 1 To N
 k = 0: p = 0: q = 0
    For j = 1 To N
     If a1(i, j) = 1 Then
      k = k + 1
      q = i: p = j
    End If
      Next j
     If k = 1 Then
     Print A(q, p);
     Else
    End
       End If
   Print
      Next i
   End Function
Private Function PD2(N As Integer) '判断第二种情况
Dim k As Integer
For i = 1 To N: For j = 1 To N
  g(i, j) = 0
  Next j: Next i
For i = 1 To N: For j = 1 To N
 If (c(i, j) = 0) Then
    If a1(i, j) = 0 Then
      Exit Function
    End If
 End If
 Next j: Next i
  
For i = 1 To N: For j = 1 To N           'd矩阵赋符号
If a1(i, j) = 0 Or a1(i, j) = 2 Then
   d(i, j) = 1
   Else: d(i, j) = 0
     End If
Next j: Next i
For i = 1 To N: k = 0
For j = 1 To N
If d(i, j) = 1 Then
 k = k + 1
 End If
 Next j
    If k < N Then
      For h = 1 To N
     d(i, h) = 0
       Next h
    End If
  Next i

  
For i = 1 To N: For j = 1 To N
    If d(i, j) = 1 And c(i, j) = 0 Then
     For h = 1 To N
          d(h, j) = 1
         Next h
    End If
Next j: Next i
        
'For i = 1 To N: For j = 1 To N
'  Print d(i, j);Next j:Print
'  Next i
For j = 1 To N: For i = 1 To N
    If d(i, j) = 1 And a1(i, j) = 1 Then
    For h = 1 To N
        d(j, h) = 1
        Next h
    End If
Next i: Next j
        
For i = 1 To N: k = 0     'g矩阵赋值
For j = 1 To N
    If d(i, j) = 1 Then
       k = k + 1
    End If
      Next j
       If k < N Then
       For h = 1 To N
            g(i, h) = 1
           Next h
       End If
Next i
For j = 1 To N: k = 0
  For i = 1 To N
If d(i, j) = 1 Then
    k = k + 1: End If
Next i
If k = N Then
For h = 1 To N
    g(h, j) = 1
Next h
End If: Next j
For i = 1 To N: For j = 1 To N
If g(i, j) = 0 Then
m = c(i, j): End If
Next j: Next i
For i = 1 To N: For j = 1 To N
If g(i, j) = 0 Then
    If m > c(i, j) Then
    m = c(i, j)
End If: End If
 Next j: Next i
'Print m
For i = 1 To N: k = 0
For j = 1 To N
If g(i, j) = 1 Then
    k = k + 1: End If
Next j
  If k < N Then
For h = 1 To N: c(i, h) = c(i, h) - m
Next h: End If: Next i
For i = 1 To N: k = 0
For j = 1 To N
 If g(j, i) = 1 Then
       k = k + 1
End If: Next j
If k = N Then
For h = 1 To N: c(h, i) = c(h, i) + m
Next h: End If: Next i

For i = 1 To N: For j = 1 To N
   a1(i, j) = 0
Next j: Next i
Call BX2(N)
End Function