[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
 #     from      The name of the node to start with
 #     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
 #     from      The node to start with
 #     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]

----
[[
[Category Mathematics]
]]