Updated 2012-05-24 12:09:54 by RLE

Arjen Markus (15 august 2005) Here is a very simple algorithm to find the shortest paths in a graph from any node to any other node. The computation is done using "Floyd's algorithm" and it consists of two steps:

• Compute a matrix of indices (encodings of the shortest paths)
• Use that to construct the path from one node to the next

It uses Tcllib's struct::graph module to store the graph in a convenient way.

Of course there are more efficient algorithms, but this one is delightfully simple.
``` # shortest_path.tcl --
#     Find the shortest path in a graph, using
#     Floyd's algorithm
#
package require struct

# mkMatrix --
#     Make a square matrix with uniform entries
# Arguments:
#     size      Size (number of columns/rows) of the matrix
#     value     Default value to use
# Result:
#     A list of lists that represents the matrix
#
proc mkMatrix {size value} {
set row {}
for { set i 0 } { \$i < \$size } { incr i } {
lappend row \$value
}
set matrix {}
for { set i 0 } { \$i < \$size } { incr i } {
lappend matrix \$row
}
return \$matrix
}

# mkPath --
#     Use the resulting matrix to print the shortest path
# Arguments:
#     indices   Matrix of indices
#     names     Names of the nodes
#     to        The name of the node to go to
# Result:
#     A list of intermediate nodes along the path
#
proc mkPath {indices names from to} {
set f [lsearch \$names \$from]
set t [lsearch \$names \$to]

set ipath [IntermediatePath \$indices \$f \$t]
set path  [list \$from]

foreach node \$ipath {
lappend path [lindex \$names \$node]
}

lappend path \$to
return \$path
}

# IntermediatekPath --
#     Construct the intermediate path
# Arguments:
#     indices   Matrix of indices
#     to        The node to go to
# Result:
#     A list of intermediate nodes along the path
#
proc IntermediatePath {indices from to} {

set path {}
set next [lindex \$indices \$from \$to]
if { \$next >= 0 } {
set path [concat \$path [IntermediatePath \$indices \$from \$next]]
lappend path \$next
set path [concat \$path [IntermediatePath \$indices \$next \$to]]
}
return \$path
}

# floydPaths --
#     Construct the matrix that encodes the shortest paths,
#     via Floyd's algorithm
# Arguments:
#     distances  Matrix of distances
#     lmatrix    (Optional) the name of a variable to hold the
#                shortest path lengths as a matrix
# Result:
#     A matrix encoding the shortest paths
#
proc floydPaths {distances {lmatrix {}}} {
if { \$lmatrix != {} } {
upvar 1 \$lmatrix lengths
}

set size [llength \$distances]

set indices [mkMatrix \$size -1]
set lengths \$distances

for { set k 0 } { \$k < \$size } { incr k } {
for { set i 0 } { \$i < \$size } { incr i } {
for { set j 0 } { \$j < \$size } { incr j } {
set dik [lindex \$lengths \$i \$k]
set dij [lindex \$lengths \$i \$j]
set dkj [lindex \$lengths \$k \$j]

if { \$dik == {} || \$dkj == {} } {
continue ;# No connection - distance infinite
}

if { \$dij == {} || \$dik+\$dkj < \$dij } {
lset indices \$i \$j \$k
lset lengths \$i \$j [expr {\$dik+\$dkj}]
}
}
}
}

return \$indices
}

# determinePaths --
#     Construct the matrix that encodes the shortest paths from
#     the given graph
# Arguments:
#     graph      Graph to be examined
#     key        Name of the (non-negative) attribute) holding the
#                length of the arcs (defaults to "distance")
#     lmatrix    (Optional) the name of a variable to hold the
#                shortest path lengths as a matrix
# Result:
#     A matrix encoding the shortest paths
#
proc determinePaths {graph {key distance} {lmatrix {}} } {
if { \$lmatrix != {} } {
upvar 1 \$lmatrix lengths
}

set names     [\$graph nodes]
set distances [mkMatrix [llength \$names] {}]
for { set i 0 } { \$i < [llength \$names] } { incr i } {
lset distances \$i \$i 0 ;# Distance of a node to itself is 0
}

foreach arc [\$graph arcs \$key] {
set from [lsearch \$names [\$graph arc source \$arc]]
set to   [lsearch \$names [\$graph arc target \$arc]]
set d    [\$graph arc get \$arc \$key]
if { \$from != \$to } {
lset distances \$from \$to \$d
}
}
puts \$distances

return [floydPaths \$distances lengths]
}

# Small test --
#    Construct a graph, make a matrix of distances out of it
#    and query a few shortest paths. Note: the graph is undirected,
#    so the arrows are doubled.
#
set names     {A B C D E F G}
set distances {
{ 0  7  3 {} {} {} {}}
{ 7  0 {}  8 {} {} 40}
{ 3 {}  0 12  4 {} {}}
{{}  8 12  0 {} {} {}}
{{} {}  4 {}  0 10  7}
{{} {} {} {} 10  0  8}
{{} 40 {} {}  7  8  0}}

# Construct the graph:
#
set graph [::struct::graph]

set names     {A B C D E F G}
set arcs  {
A B 7
A C 3
B D 8
B G 40
C D 12
C E 4
E F 10
E G 7
F G 8
}

#
#
foreach n \$names {
\$graph node insert \$n
}
foreach {from to distance} \$arcs {
set arc [\$graph arc insert \$from \$to]
\$graph arc append \$arc distance \$distance

set arc [\$graph arc insert \$to \$from]
\$graph arc append \$arc distance \$distance
}

#
# Now that we have our graph, examine some shortest paths
#
# Note: the ordering of the nodes in the graph is not the
# same as the order in which they were created! Hence the
# call to [\$graph nodes].

set indices [determinePaths \$graph "distance" lengths]
puts \$indices
puts [mkPath \$indices [\$graph nodes] A B]
puts [mkPath \$indices [\$graph nodes] B G]```