PreviousUpNext

15.4.764  src/lib/graph/floyd-warshalls-all-pairs-shortest-path-g.pkg

## floyd-warshalls-all-pairs-shortest-path-g.pkg

# This module implements the Floyd/Warshall algorithm for computing
# all pairs shortest paths.
#
# -- Allen Leung

# Compiled by:
#     src/lib/graph/graphs.lib

# See also:
#     src/lib/compiler/back/low/doc/latex/graphs.tex
#     src/lib/graph/test5.pkg


###           "Even the most subtle spider
###            may leave a weak thread."
###
###                        -- Gandalf



stipulate
   package odg =  oop_digraph;                                                          # oop_digraph           is from   src/lib/graph/oop-digraph.pkg
   package mat =  matrix;                                                               # matrix                        is from   src/lib/std/src/matrix.pkg
herein

    generic package floyd_warshals_all_pairs_shortest_path_g (
        #
        num:  Abelian_Group_With_Infinity                                               # Abelian_Group_With_Infinity   is from   src/lib/graph/group.api
    )
    : (weak) All_Pairs_Shortest_Paths                                                   # All_Pairs_Shortest_Paths      is from   src/lib/graph/shortest-paths.api
    {
        package num = num;                                                              # Export for client packages.

        fun all_pairs_shortest_paths  {  weight,  graph => odg::DIGRAPH ggg  }
            =
            {   nnn =  ggg.capacity ();
                #
                ddd =  mat::make_matrix (nnn, nnn, num::inf);
                ppp =  mat::make_matrix (nnn, nnn, -1);

                fun init ()
                    =
                    {   fun diag -1 => ();
                            diag i  => { mat::set (ddd, i, i, num::zero);   diag (i - 1); };
                        end;

                        diag (nnn - 1);

                        ggg.forall_edges
                            (fn e as (i, j, _)
                                =
                                { w   = weight e;

                                  if  (num::(<) (w, mat::get (ddd, i, j)))
                                       mat::set (ppp, i, j, i);
                                       mat::set (ddd, i, j, w);
                                  fi;
                                }
                            );
                    };

                fun  l1 k
                    =
                    if (k < nnn)
                        #
                        l2 (k, 0);
                        l1 (k+1);
                    fi

                also
                fun l2 (k, i)
                    =
                    if (i < nnn)
                        #
                        l3 (k, i, 0, mat::get (ddd, i, k));
                        l2 (k, i+1);
                    fi

                also
                fun l3 (k, i, j, d_ik)
                    =
                    if  (j < nnn)
                        #
                        d_ij = mat::get (ddd, i, j);
                        d_kj = mat::get (ddd, k, j);
                        #
                        x = num::(+) (d_ik, d_kj);
                        #
                        if (num::(<) (x, d_ij))
                            #
                            mat::set (ppp, i, j, mat::get (ppp, k, j));
                            mat::set (ddd, i, j, x);
                        fi;
                        #
                        l3 (k, i, j+1, d_ik);
                    fi;

                init();

                l1 0;

                { dist=>ddd, prior=>ppp };
            };
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext