141 lines
3.5 KiB
Plaintext
141 lines
3.5 KiB
Plaintext
Const INFINITY As Integer = &h7FFFFFFF
|
|
|
|
Type Edge
|
|
src As String * 1
|
|
dst As String * 1
|
|
cost As Integer
|
|
End Type
|
|
|
|
Type Vertex
|
|
nom As String * 1
|
|
dist As Integer
|
|
prev As String * 1
|
|
End Type
|
|
|
|
Type Graph
|
|
edges(100) As Edge
|
|
edgeCount As Integer
|
|
verts(100) As Vertex
|
|
vertCount As Integer
|
|
End Type
|
|
|
|
Function createGraph(edges() As Edge, cnt As Integer) As Graph
|
|
Dim As Graph g
|
|
Dim As String names(100)
|
|
Dim As Integer i, j, nCount = 0
|
|
|
|
g.edgeCount = cnt
|
|
|
|
' Copy edges and collect unique vertices
|
|
For i = 0 To cnt - 1
|
|
g.edges(i) = edges(i)
|
|
|
|
' Check source vertex
|
|
Dim As Boolean found = False
|
|
For j = 0 To nCount - 1
|
|
If names(j) = edges(i).src Then
|
|
found = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
If Not found Then
|
|
names(nCount) = edges(i).src
|
|
nCount += 1
|
|
End If
|
|
|
|
' Check destination vertex
|
|
found = False
|
|
For j = 0 To nCount - 1
|
|
If names(j) = edges(i).dst Then
|
|
found = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
If Not found Then
|
|
names(nCount) = edges(i).dst
|
|
nCount += 1
|
|
End If
|
|
Next
|
|
|
|
' Initialize vertices
|
|
g.vertCount = nCount
|
|
For i = 0 To nCount - 1
|
|
With g.verts(i)
|
|
.nom = names(i)
|
|
.dist = INFINITY
|
|
.prev = names(i)
|
|
End With
|
|
Next
|
|
|
|
Return g
|
|
End Function
|
|
|
|
Function findVertex(g As Graph, nombre As String) As Integer
|
|
For i As Integer = 0 To g.vertCount - 1
|
|
If g.verts(i).nom = nombre Then Return i
|
|
Next
|
|
Return -1
|
|
End Function
|
|
|
|
Function dijkstraPath(g As Graph, source As String, dest As String) As Integer
|
|
Dim As Integer changed, i, srcIdx, dstIdx, newDist, destIdx
|
|
srcIdx = findVertex(g, source)
|
|
If srcIdx >= 0 Then g.verts(srcIdx).dist = 0
|
|
|
|
Do
|
|
changed = 0
|
|
For i = 0 To g.edgeCount - 1
|
|
With g.edges(i)
|
|
srcIdx = findVertex(g, .src)
|
|
dstIdx = findVertex(g, .dst)
|
|
|
|
If srcIdx >= 0 Andalso g.verts(srcIdx).dist <> INFINITY Then
|
|
newDist = g.verts(srcIdx).dist + .cost
|
|
If newDist < g.verts(dstIdx).dist Then
|
|
g.verts(dstIdx).dist = newDist
|
|
g.verts(dstIdx).prev = .src
|
|
changed = 1
|
|
End If
|
|
End If
|
|
End With
|
|
Next
|
|
Loop While changed
|
|
|
|
destIdx = findVertex(g, dest)
|
|
Return Iif(destIdx >= 0, g.verts(destIdx).dist, INFINITY)
|
|
End Function
|
|
|
|
Function getPath(g As Graph, source As String, dest As String) As String
|
|
Dim As String path = "", current = dest
|
|
Dim As Integer idx, destIdx, cost
|
|
|
|
' Build path backwards
|
|
While current <> source
|
|
idx = findVertex(g, current)
|
|
If idx >= 0 Then
|
|
path = " -> " & current & path
|
|
current = g.verts(idx).prev
|
|
End If
|
|
Wend
|
|
|
|
' Get final cost
|
|
destIdx = findVertex(g, dest)
|
|
cost = Iif(destIdx >= 0, g.verts(destIdx).dist, INFINITY)
|
|
|
|
Return source & " " & dest & " : " & source & path & " cost : " & cost
|
|
End Function
|
|
|
|
' Test program
|
|
Dim As Edge testGraph(8) => {_
|
|
("a", "b", 7), ("a", "c", 9), ("a", "f", 14), _
|
|
("b", "c", 10), ("b", "d", 15), ("c", "d", 11), _
|
|
("c", "f", 2), ("d", "e", 6), ("e", "f", 9)}
|
|
|
|
Dim As Graph g = createGraph(testGraph(), 9)
|
|
Dim As String source = "a", dest = "e"
|
|
|
|
dijkstraPath(g, source, dest)
|
|
Print getPath(g, source, dest)
|
|
|
|
Sleep
|