15.4.761  src/lib/graph/dijkstras-single-source-shortest-paths-g.pkg

## dijkstras-single-source-shortest-paths-g.pkg
#
# This module implements the Dijkstra algorithm for computing
# the single source 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/test4.pkg


###         "What science strives for is an utmost acuteness and clarity of concepts
###          as regards their mutual relation and their correspondence to sensory data."
###
###                                                       -- Albert Einstein


stipulate
   package pq  = node_priority_queue_g( rw_vector );                                            # node_priority_queue_g         is from   src/lib/graph/node-priority-queue-g.pkg
   package odg = oop_digraph;                                                                   # oop_digraph           is from   src/lib/graph/oop-digraph.pkg
   package wv  = rw_vector;                                                                     # rw_vector                     is from   src/lib/std/src/rw-vector.pkg
herein

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

       fun single_source_shortest_paths { graph=>ggg' as odg::DIGRAPH ggg, weight, s }
           =
           {   nnn   = ggg.capacity ();
               dist  = wv::make_rw_vector (nnn, num::inf);
               prior = wv::make_rw_vector (nnn, -1);
               qqq   = pq::from_graph (\\ (i, j) => num::(<) (wv::get (dist, i), wv::get (dist, j)); end ) ggg';

               fun relax (e as (u, v, _))
                   =
                   {   d_v = wv::get (dist, v);
                       d_x = num::(+) (wv::get (dist, u), weight e);

                       if  (num::(<) (d_x, d_v))

                            wv::set (dist, v, d_x);
                            wv::set (prior, v, u);
                            pq::decrease_weight (qqq, v);
                       fi;
                   };

               wv::set (dist, s, num::zero);
               pq::decrease_weight (qqq, s);

               (for (TRUE)
                  apply relax (ggg.out_edges (pq::delete_min qqq))
               )
               except
                   pq::EMPTY_PRIORITY_QUEUE = ();

               { dist,
                 prior
               };
           };

    };
end;