kruscal.cls

本程序是一个用prim算法寻找最小生成树的小程序。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "kruscal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim nofvc As Integer: Public nofpa As Integer
Dim vc() As Integer
Dim nopt() As arctype
Dim min As arctype
Sub initkruscal()
nofvc = 0
ReDim vc(nv, na)
ReDim oparc(0)
nofpa = 0
sort
End Sub
Private Function getnc(ByVal n As Integer) As Integer
getnc = -1
For i = 1 To nofvc
  For j = 2 To vc(i, 1) + 1
    If n = vc(i, j) Then getnc = i: Exit Function
  Next j
Next i
End Function
Private Sub addopa(ByVal id As Integer)
nofpa = nofpa + 1
ReDim Preserve koparc(nofpa)
With koparc(nofpa)
.id = arc(id).id
.eid = arc(id).eid
.sid = arc(id).sid
.ilink = arc(id).ilink
End With
Debug.Print koparc(nofpa).id, koparc(nofpa).eid, koparc(nofpa).sid, koparc(nofpa).ilink
addvc (id)
End Sub
Private Sub addvc(ByVal id As Integer)
f1 = getnc(arc(id).sid)
f2 = getnc(arc(id).eid)
If f1 = -1 And f2 = -1 Then
nofvc = nofvc + 1
vc(nofvc, 2) = arc(id).sid: vc(nofvc, 3) = arc(id).eid: vc(nofvc, 1) = 2
Exit Sub
End If
If f1 <> -1 And f2 <> -1 And f1 <> f2 Then
   For i = vc(f1, 1) To vc(f1, 1) + vc(f2, 1)
     vc(f1, i + 2) = vc(f2, i - vc(f1, 1) + 2)
   Next i
  vc(f1, 1) = vc(f1, 1) + vc(f2, 1)
  vc(f2, 1) = 0
 Exit Sub
End If
If f1 = -1 And f2 <> -1 Then
vc(f2, 1) = vc(f2, 1) + 1
vc(f2, vc(f2, 1) + 1) = arc(id).sid
End If
If f1 <> -1 And f2 = -1 Then
vc(f1, 1) = vc(f1, 1) + 1
vc(f1, vc(f1, 1) + 1) = arc(id).eid
End If
End Sub
Sub findopt()
For i = 1 To na
  If getnc(nopt(i).sid) = -1 Or getnc(nopt(i).eid) = -1 Or (getnc(nopt(i).sid) <> getnc(nopt(i).eid)) Then
  addopa nopt(i).id
  End If
Next i
End Sub
Private Sub sort()
ReDim nopt(na)
For i = 1 To na
With nopt(i)
.id = arc(i).id
.eid = arc(i).eid
.sid = arc(i).sid
.ilink = arc(i).ilink
End With
Next i
For i = 1 To na - 1
   For j = i To na
   If nopt(i).ilink > nopt(j).ilink Then
   With min
   .id = nopt(i).id
   .eid = nopt(i).eid
   .sid = nopt(i).sid
   .ilink = nopt(i).ilink
   End With
   With nopt(i)
   .id = nopt(j).id
   .eid = nopt(j).eid
   .sid = nopt(j).sid
   .ilink = nopt(j).ilink
   End With
   With nopt(j)
   .id = min.id
   .eid = min.eid
   .sid = min.sid
   .ilink = min.ilink
   End With
   End If
   Next j
Next i
End Sub