15.4.756  src/lib/graph/bellman-fords-single-source-shortest-paths-g.pkg

## bellman-fords-single-source-shortest-paths-g.pkg
#
# This module implements the Bellman Ford algorithm for single source
# shortest paths.
#
# -- Allen Leung

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

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



###                "There are three principal ways to lose money: 
###                 wine, women, and engineers.  While the first two are
###                 more pleasant, the third is by far the more certain."
###
###                                -- Baron Rothschild, ca. 1800 



stipulate
   package odg =  oop_digraph;                                                                  # oop_digraph           is from   src/lib/graph/oop-digraph.pkg
   package vec =  rw_vector;                                                                    # rw_vector                     is from   src/lib/std/src/rw-vector.pkg
herein

    generic package bellman_fords_single_source_shortest_paths_g (
        #
        num:  Abelian_Group_With_Infinity                                                       # Abelian_Group_With_Infinity   is from   src/lib/graph/group.api
    )
    : (weak) api {   include api Single_Source_Shortest_Paths;                                  # Single_Source_Shortest_Paths  is from   src/lib/graph/shortest-paths.api
                     exception NEGATIVE_CYCLE;
                 }
    {
        package num = num;

        exception NEGATIVE_CYCLE;

        fun single_source_shortest_paths { graph => odg::DIGRAPH graph,   s,   weight }
            =
            { dist, prior }
            where
                nnn    = graph.capacity ();

                dist   = vec::make_rw_vector (nnn, num::inf);
                prior  = vec::make_rw_vector (nnn, -1);
                count  = vec::make_rw_vector (nnn, 0);

                fun driver ([],[])  => ();
                    driver([], b)   => driver (reverse b,[]);
                    driver (u ! a, b) => driver (iterate (u, a, b));
                end 

                also
                fun iterate (u, a, b)
                    =
                    {   n = int::(+) (vec::get (count, u), 1);
                        vec::set (count, u, n);

                        if (n >= nnn)   raise exception NEGATIVE_CYCLE;   fi;

                        du = vec::get (dist, u);

                        fun relax ([], a, b)
                                =>
                                (a, b);
                            #
                            relax((e as (_, v, _)) ! es, a, b)
                                =>
                                {   c = num::(+) (du, weight e);

                                    if (num::(<) (c, vec::get (dist, v)))
                                        #
                                        vec::set (dist, v, c); vec::set (prior, v, u);
                                        relax (es, a, v ! b);
                                    else
                                        relax (es, a, b);
                                    fi;
                                };
                        end;

                        relax (graph.out_edges u, a, b);
                   };

                vec::set (dist, s, num::zero);

                driver([s],[]);
            end;
    };
end;