graph.cls

关于图的算法

Next i

For i = 0 To Row
    For j = 0 To Row
        For k = 0 To Row
            If (A(j, i) <> 0 And A(i, k) <> 0) Then
                If (A(j, i) + A(i, k)) < A(j, k) Then
                    A(j, k) = A(j, i) + A(i, k)
                    sPath(j, k) = V(j) + "、" + V(i) + "、" + V(k)
            End If
            End If
        Next k
    Next j
Next i
    
For i = 0 To Row
    For j = 0 To Row
        Res(i, j) = A(i, j)
        sP(i, j) = sPath(i, j)
    Next j
Next i
End Sub
'**************************************************************************
'判断入度为0的顶点，就是找邻接矩阵行方向累计和为0的那一列                     *
'**************************************************************************
Private Function Indeger(ByVal n As Integer) As Integer
Dim sPoint As Integer
Dim i As Integer
    sPoint = 0
    For i = 0 To Row
        If A(i, n) Then sPoint = sPoint + A(i, n)
    Next i
Indeger = sPoint
End Function
'**************************************************************************
'拓扑排序，基本算法就是找入度为零的顶点，然后放入一个栈中，再以此顶点找邻接矩阵 *
'的所在行，将该行上的顶点连结值改为零（相当与擦去与这个顶点连接的弧），再在该行 *
'上找入度为零的顶点进入栈。循环，出栈一个顶点，重复上述步骤，直到栈空          *
'**************************************************************************
Public Sub TopoSort(ByRef Res() As String)
Dim i As Integer
Dim j As Integer
Dim m As Integer

    '找到开始的顶点，开始的顶点全部进栈
    For i = 0 To Row
        If Indeger(i) = 0 Then
            MyStack.Push i
        End If
    Next i
    j = 0
    While Not MyStack.IsStackEmpty()
        m = MyStack.Pop()
        Res(j) = V(m)
        j = j + 1
        For i = 0 To Row
            If A(m, i) <> 0 Then
                A(m, i) = 0
                If Indeger(i) = 0 Then MyStack.Push i
            End If
        Next i
    Wend
End Sub
'**************************************************************************
'判断出度为0的顶点，就是找邻接矩阵行方向累计和为0的那一列                     *
'**************************************************************************
Private Function Outdeger(ByVal n As Integer) As Integer
Dim sPoint As Integer
Dim i As Integer
    sPoint = 0
    For i = 0 To Row
        If A(n, i) <> 0 Then sPoint = sPoint + A(n, i)
    Next i
Outdeger = sPoint
End Function
Private Function GetArc(ByVal n As Integer, ByVal m As Integer) As Integer
Dim i As Integer
    If m > Row Then GetArc = -1: Exit Function
    For i = m To Row
        If A(n, i) <> 0 Then GetArc = i: Exit Function
    Next i
GetArc = -1
End Function
'关键路径。
Private Function TopologicalOrder() As Boolean
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim Count As Integer
Dim AX() As Integer

    ReDim AX(Row + 1, Row + 1) As Integer
    For i = 0 To Row
        For j = 0 To Row
            AX(i, j) = A(i, j)
        Next j
    Next i
    
    Count = 0
    For i = 0 To Row
        If Indeger(i) = 0 Then
            SG.Push i
        End If
    Next i

    While Not SG.IsStackEmpty()
        m = SG.Pop()
        TG.Push m
        Count = Count + 1

        For i = 0 To Row
            If A(m, i) <> 0 Then
                If (VE(m) + AX(m, i)) > VE(i) Then VE(i) = VE(m) + AX(m, i)
                A(m, i) = 0
                If Indeger(i) = 0 Then SG.Push i
            End If
        Next i
    Wend
    
    For i = 0 To Row
        For j = 0 To Row
            A(i, j) = AX(i, j)
        Next j
    Next i
    
    
    If Count < Row Then
        TopologicalOrder = False
    Else
        TopologicalOrder = True
    End If
End Function
Public Function AOE() As Boolean
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim Vi As Integer
Dim NotC As Boolean

Dim AX() As Integer

    ReDim AX(Row + 1, Row + 1) As Integer
    For i = 0 To Row
        For j = 0 To Row
            AX(i, j) = A(i, j)
        Next j
    Next i
'检查是否满足AOE网络的条件，首先是AOE只能有一个源点、一个汇点
'其次是检查AOE网络是否有回路，有回路也退出
'本程序没检查回路问题，回路检查实际是拓扑排序，因为有回路，则
'肯定有构成回路的顶点循环入栈，入栈次数超过一次。
'先检查出度为0的顶点
NotC = TopologicalOrder()
If NotC = False Then AOE = NotC: Exit Function
For i = 0 To Row
    VL(i) = VE(i)
Next i
While (Not TG.IsStackEmpty)
    j = TG.Pop
    k = 0
    While (k >= 0)
        m = GetArc(j, k)
        If m >= 0 Then
            dut = A(j, m)
            If (VL(m) - dut < VL(j)) Then VL(j) = VL(m) - dut
            A(j, m) = 0
        End If
        k = m
    Wend
Wend
        
        
For i = 0 To Row
    For j = 0 To Row
        A(i, j) = AX(i, j)
    Next j
Next i
       
        
Form1.List1.Clear
For j = 0 To Row
    m = 0
    k = 0
    While (m >= 0)
        k = GetArc(j, m)
        If k >= 0 Then
            dut = A(j, k)
            ee = VE(j)
            el = VL(k) - dut
            If ee = el Then
                Tag = "是"
            Else
                Tag = "否"
            End If
        A(j, k) = 0
        Form1.List1.AddItem V(j) + " " + V(k) + " " + Str(dut) + " " + Str(ee) + " " + Str(el) + " " + Tag
        End If
    m = k
    Wend
Next j
End Function
Public Sub Dijkstra(ByVal V0 As Integer, ByRef Distance() As Integer, ByRef iPath() As Integer, ByRef sPath() As String)
Dim s() As Integer
Dim tmp() As String
Dim MinDis As Integer

ReDim s(Row + 1) As Integer
ReDim tmp(Row + 1) As String

For i = 0 To Row
    For j = 0 To Row
        If i <> j And A(i, j) = 0 Then A(i, j) = MaxWeight
    Next j
Next i

For i = 0 To Row
    tmp(i) = ""
    sPath(i) = V(V0) + "->"
Next i

For i = 0 To Row
    Distance(i) = A(V0, i)
    s(i) = 0
    If i <> V0 And Distance(i) < MaxWeight Then
        iPath(i) = V0
    Else
        iPath(i) = -1
    End If
Next i
s(V0) = 1

For i = 1 To Row
        MinDis = MaxWeight
        For j = 0 To Row
            If (s(j) = 0 And Distance(j) < MinDis) Then
                u = j
                MinDis = Distance(j)
            End If
        Next j
        If MinDis = MaxWeight Then Exit Sub
        s(u) = 1

        For j = 0 To Row
            If (A(u, j) < MaxWeight And u <> j) Then
                If (s(j) = 0 And Distance(u) + A(u, j) <= Distance(j)) Then
                    Distance(j) = Distance(u) + A(u, j)
                    iPath(j) = u
                    If (Visited(u) = 0) Then
                        sPath(j) = sPath(j) + V(u) + "->" + V(j)
                    Else
                        sPath(j) = sPath(u) + "->" + V(j)
                    End If
                    Visited(j) = 1
                End If
            Else
                If Visited(j) = 0 Then
                    sPath(j) = sPath(j) + V(j)
                    Visited(j) = 1
                End If
            End If
        Next j
Next i
End Sub
'析构过程，删除全部使用过的数组
Private Sub Class_Terminate()
    Erase A
    Erase E
    Erase V
    Erase Visited
    Erase Result
    Set ResultTree = Nothing
End Sub