dijstra.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 = "dijstra"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim m() As Integer
Dim starid As Integer
Dim ma() As Integer
Public Sub initd(ByVal nv As Integer)
ReDim m(nv, nv)
ReDim path(nv + 1, nv + 1)
ReDim pa(nv)
End Sub
Public Sub loadmat(ByVal nv As Integer, ByVal na As Integer)
Dim i, j As Integer
For i = 1 To nv
   For j = 1 To nv
   m(i, j) = 8000
   Next j
Next i
For i = 1 To na
m(arc(i).sid, arc(i).eid) = arc(i).ilink
m(arc(i).eid, arc(i).sid) = arc(i).ilink
Next i
End Sub
Public Sub rpath(ByVal stid As Integer)
Dim mi, i As Integer, j As Integer
starid = stid
For i = 1 To nv
pa(i).fid = stid
pa(i).value = 8000
pa(i).sid = i
pa(i).f = -1
Next i
pa(stid).value = 0  '起始点到起始点的距离
For i = 1 To nv
  mi = min(nv)
 pa(mi).f = i
  For j = 1 To nv
    If pa(j).f = -1 Then pa(j).value = minmum(m(mi, pa(j).sid) + pa(mi).value, pa(j).value) ': Debug.Print pa(j).value, pa(j).f, pa(j).fid, pa(j).sid
  Next j
Next i
End Sub
Function minmum(ByVal n1 As Integer, ByVal n2 As Integer) As Integer
minmum = n1
If n1 > n2 Then minmum = n2
End Function
Function min(ByVal nv As Integer) As Integer
Dim i As Integer
Dim m As Integer
m = 8000: min = stid
For i = 1 To nv
If m > pa(i).value And pa(i).f = -1 Then
m = pa(i).value
min = pa(i).sid
End If
Next i
End Function
Public Sub huishuo()
Dim i As Integer
For i = 1 To nv
hs i, nv
Debug.Print i
Next i
End Sub
Sub hs(ByVal id As Integer, ByVal nv As Integer)
Dim i As Integer, j As Integer, n As Integer
ReDim ma(nv)
Dim t As Integer
Dim ind As Integer
t = id
path(id, 1) = 0
While t <> starid
ind = 1
ma(1) = 0
For j = 1 To nv
If m(t, j) <> 8000 And t <> j Then
ma(1) = ma(1) + 1  'ma中存放的是与第相邻接的接点号
ind = ind + 1
ma(ind) = j
Debug.Print t, j, m(t, j)
End If
Next j
ma(1) = getvid(ma())
ind = getarcid(t, ma(1))
t = ma(1)
path(id, 1) = path(id, 1) + 1
path(id, path(id, 1) + 1) = ind
Wend
End Sub
Function getarcid(ByVal fi As Integer, ByVal si As Integer) As Integer
Dim i As Integer
For i = 1 To na
If (arc(i).sid = fi And arc(i).eid = si) Or (arc(i).eid = fi And arc(i).sid = si) Then getarcid = i: Exit Function
Next i
End Function
Function getvid(ByRef ma() As Integer) As Integer
Dim i As Integer, minv As Integer
If ma(1) = 0 Then getvid = starid: Exit Function
minv = pa(ma(2)).f
getvid = pa(ma(2)).sid
For i = 1 To ma(1)
If minv > pa(ma(i + 1)).f Then minv = pa(ma(i + 1)).f: getvid = pa(ma(i + 1)).sid
Next i
End Function