Anonymous user
User:Klever: Difference between revisions
→VBA Examples: Floyd-Warshall
(→VBA Examples: Floyd-Warshall) |
|||
Line 15:
In MS Office program (Word, Excel, Access...): open the Visual Basic window. Paste the code in a module. Execute it by typing a suitable command in the Immediate Window. Output will be directed to the Immediate Window unless stated otherwise...
==[[Floyd-Warshall algorithm]]==
The [http://en.wikipedia.org/wiki/Floyd-Warshall_algorithm Floyd algorithm or Floyd-Warshall algorithm] finds the shortest path between all pairs of nodes in a weighted, directed graph. It is an example of dynamic programming.
Usage: fill in the number of nodes (n) and the non-zero edge distances or costs in sub Floyd or in sub FloydWithPaths.
Then run "Floyd" or "FloydWithPaths".
Floyd: this sub prints the lengths or costs of the shortest paths but not the paths themselves
FloydWithPaths: this sub prints the lengths and the nodes along the paths
<lang>
'Floyd globals
Const MaxGraph As Integer = 100 'max. number of vertices in graph
Const Infinity = 1E+308 'very large number
Dim E(1 To MaxGraph, 1 To MaxGraph) As Double
Dim A(1 To MaxGraph, 1 To MaxGraph) As Double
Dim Nxt(1 To MaxGraph, 1 To MaxGraph) As Integer
Public Sub SolveFloyd(n)
'Floyd's algorithm: all-pairs shortest-paths cost
'returns the cost (distance) of the least-cost (shortest) path
'between all pairs in a labeled directed graph
'note: this sub returns only the costs, not the paths!
'
'inputs:
' n : number of vertices (maximum value is maxGraph)
' E(i,j) : cost (length,...) of edge from i to j or <=0 if no edge between i and j
'output:
' A(i,j): minimal cost for path from i to j
'constant:
' Infinity : very large number (guaranteed to be larger than largest possible cost of any path)
For i = 1 To n
For j = 1 To n
If E(i, j) > 0 Then A(i, j) = E(i, j) Else A(i, j) = Infinity
Next j
A(i, i) = 0
Next i
For k = 1 To n
For i = 1 To n
For j = 1 To n
If A(i, k) + A(k, j) < A(i, j) Then A(i, j) = A(i, k) + A(k, j)
Next j
Next i
Next k
End Sub
Public Sub SolveFloydWithPaths(n)
'cf. SolveFloyd, but here we
'use matrix "Nxt" to store information about paths
For i = 1 To n
For j = 1 To n
If E(i, j) > 0 Then A(i, j) = E(i, j) Else A(i, j) = Infinity
Next j
A(i, i) = 0
Next i
For k = 1 To n
For i = 1 To n
For j = 1 To n
If A(i, k) + A(k, j) < A(i, j) Then
A(i, j) = A(i, k) + A(k, j)
Nxt(i, j) = k
End If
Next j
Next i
Next k
End Sub
Public Function GetPath(i, j) As String
'recursively reconstruct shortest path from i to j using A and Nxt
If A(i, j) = Infinity Then
GetPath = "No path!"
Else
tmp = Nxt(i, j)
If tmp = 0 Then
GetPath = " " 'there is an edge from i to j
Else
GetPath = GetPath(i, tmp) & Format$(tmp) & GetPath(tmp, j)
End If
End If
End Function
Public Sub Floyd()
'main function to apply Floyd's algorithm
'see description in wp:en:Floyd-Warshall algorithm
' define problem:
' number of vertices?
n = 5
' reset connection/cost per edge matrix
For i = 1 To n
For j = 1 To n
E(i, j) = 0
Next j
Next i
' fill in the edge costs
E(1, 2) = 10
E(1, 3) = 50
E(1, 4) = 65
E(2, 3) = 30
E(2, 5) = 4
E(3, 4) = 20
E(3, 5) = 44
E(4, 2) = 7
E(4, 5) = 13
'Solve it
SolveFloyd n
'Print solution
'note: for large graphs the output may be too large for the Immediate panel
'in that case you could send the output to a text file
Debug.Print "From", "To", "Cost"
For i = 1 To n
For j = 1 To n
If i <> j Then Debug.Print i, j, IIf(A(i, j) = Infinity, "No path!", A(i, j))
Next j
Next i
End Sub
Public Sub FloydWithPaths()
'main function to solve Floyd's algorithm and return shortest path between
'any two vertices
' define problem:
' number of vertices?
n = 5
' reset connection/cost per edge matrix
For i = 1 To n
For j = 1 To n
E(i, j) = 0
Nxt(i, j) = 0
Next j
Next i
' fill in the edge costs
E(1, 2) = 10
E(1, 3) = 50
E(1, 4) = 65
E(2, 3) = 30
E(2, 5) = 4
E(3, 4) = 20
E(3, 5) = 44
E(4, 2) = 7
E(4, 5) = 13
'Solve it
SolveFloydWithPaths n
'Print solution
'note: for large graphs the output may be too large for the Immediate panel
'in that case you could send the output to a text file
Debug.Print "From", "To", "Cost", "Via"
For i = 1 To n
For j = 1 To n
If i <> j Then Debug.Print i, j, IIf(A(i, j) = Infinity, "---", A(i, j)), GetPath(i, j)
Next j
Next i
End Sub
</lang>
Output:
<pre>
Floyd
From To Cost
1 2 10
1 3 40
1 4 60
1 5 14
2 1 No path!
2 3 30
2 4 50
2 5 4
3 1 No path!
3 2 27
3 4 20
3 5 31
4 1 No path!
4 2 7
4 3 37
4 5 11
5 1 No path!
5 2 No path!
5 3 No path!
5 4 No path!
FloydWithPaths
From To Cost Via
1 2 10
1 3 40 2
1 4 60 2 3
1 5 14 2
2 1 --- No path!
2 3 30
2 4 50 3
2 5 4
3 1 --- No path!
3 2 27 4
3 4 20
3 5 31 4 2
4 1 --- No path!
4 2 7
4 3 37 2
4 5 11 2
5 1 --- No path!
5 2 --- No path!
5 3 --- No path!
5 4 --- No path!
</pre>
==[[Sudoku]]==
| |||