(*
 * bellman_ford.sml - implementation of the generic Bellman-Ford shortest paths
 * algorithm.
 *   Ronald Garcia
 *   $Id: bellman_ford.sml,v 1.2 2003/05/02 20:03:36 jewillco Exp $
 *)

(* Copyright 2003, Trustees of Indiana University
 * Please see the license in the file ../LICENSE
 *)

use "concepts.sml";
use "graph.sml";
use "property_map.sml";
use "relax.sml";
use "priority_queue.sml";

signature BellmanFPSig =
sig
 structure EdgeListGraph : EdgeListGraphSig
 structure PredecessorMap : ReadWritePropertyMapSig
 structure DistanceMap : ReadWritePropertyMapSig
 structure WeightMap : ReadablePropertyMapSig
 structure VertexIndexMap : ReadablePropertyMapSig
 structure Compare : StrictWeakOrderingSig
 structure Combine : BinaryFunctionSig

 sharing type EdgeListGraph.edge_t = WeightMap.key_t
 sharing type WeightMap.value_t =
              Compare.arg_t =
              Combine.first_t =
              Combine.result_t =
              DistanceMap.value_t

 sharing type EdgeListGraph.vertex_t =
              PredecessorMap.key_t =
              PredecessorMap.value_t =
              DistanceMap.key_t =
              VertexIndexMap.key_t

 sharing type Combine.second_t = WeightMap.value_t

end

functor MakeBellmanF (Params : BellmanFPSig) :
sig
    structure GraphT : EdgeListGraphSig
    structure PMapT : ReadWritePropertyMapSig
    structure DMapT : ReadWritePropertyMapSig
    structure WMapT : ReadablePropertyMapSig
    structure VIMapT : ReadablePropertyMapSig
    structure CmpT : StrictWeakOrderingSig
    structure CmbT : BinaryFunctionSig

    val bellman_ford_shortest_paths :
        GraphT.graph_t -> int -> PMapT.data_t ->
        DMapT.data_t -> WMapT.data_t -> VIMapT.data_t ->
        CmpT.data_t -> CmbT.data_t -> bool

end
=
struct
    structure GraphT = Params.EdgeListGraph
    structure PMapT = Params.PredecessorMap
    structure DMapT = Params.DistanceMap
    structure WMapT = Params.WeightMap
    structure VIMapT = Params.VertexIndexMap
    structure CmpT = Params.Compare
    structure CmbT = Params.Combine


    structure Relax =
    MakeRelax(struct
                structure Graph = GraphT
                structure WMap = WMapT
                structure DMap = DMapT
                structure PMap = PMapT
                structure Cmp = CmpT
                structure Cmb = CmbT
              end);
              

fun bellman_ford_shortest_paths 
    graph num_vertices pmap dmap wmap imap cmp cmb = (
        let
          val N = ref 0
          val one_relax = ref false
        in
          while (!N) < num_vertices-1 do (
              app
                  (fn edge =>
                      if Relax.go dmap wmap pmap cmp cmb graph edge then
                          (one_relax := true) (* currently unused *)
                      else
                          ())
                  (GraphT.edges graph);
              N := (!N) + 1)
        end;
        if List.exists
               (fn e =>
                   let
                       val u = GraphT.source graph e 
                       val v = GraphT.target graph e 
                       val du = DMapT.get dmap u
                       val dv = DMapT.get dmap v
                       val wuv = WMapT.get wmap e
                   in
                       if CmpT.go cmp (CmbT.go cmb du wuv) dv then
                           true (* results are flipped to use exists *)
                       else
                           false
                   end) (GraphT.edges graph) then
            false
        else
            true)
           
(*
    for (Size k = 0; k < N; ++k) {
      bool at_least_one_edge_relaxed = false;
      for (tie(i, end) = edges(g); i != end; ++i) {
        v.examine_edge( *i, g);
        if (relax( *i, g, weight, pred, distance, combine, compare)) {
          at_least_one_edge_relaxed = true;
          v.edge_relaxed( *i, g);
        } else
          v.edge_not_relaxed( *i, g);
      }
      if (!at_least_one_edge_relaxed)
        break;
    }

    for (tie(i, end) = edges(g); i != end; ++i)
      if (compare(combine(get(distance, source( *i, g)), 
                          get(weight, *i)),
                  get(distance, target( *i,g))))
      {
        v.edge_not_minimized( *i, g);
        return false;
      } else
        v.edge_minimized( *i, g);

    return true;
*)   
end