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 =  rw_matrix;                                                            # rw_matrix                     is from   src/lib/std/src/rw-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_rw_matrix ((nnn, nnn), num::inf);
                ppp =  mat::make_rw_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
                            (\\ 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;