(*
 * dijkstra.sml - SML implementation of dijkstra in terms of BFS
 *   Ronald Garcia
 * $Id: dijkstra.sml,v 1.3 2003/08/08 22:15:34 garcia Exp $
 *)

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

(* 
Dijkstra is implemented in terms of BFS.  A special Visitor is built 
to handle the necessary calls for Dijkstra.  A priority_queue that uses a
property map for its priorities is passed to BFS as its Buffer. *)


signature DijkstraPSig =
sig
 structure VertexListGraph : VertexListGraphSig
 structure IncidenceGraph : IncidenceGraphSig
 structure PredecessorMap : ReadWritePropertyMapSig
 structure DistanceMap : ReadWritePropertyMapSig
 structure WeightMap : ReadablePropertyMapSig
 structure VertexIndexMap : ReadablePropertyMapSig where type value_t = int
 structure Compare : StrictWeakOrderingSig
 structure Combine : BinaryFunctionSig

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

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

 sharing type Combine.second_t = WeightMap.value_t

end

functor MakeDijkstra (Params : DijkstraPSig) :
sig
    structure VLGraphT : VertexListGraphSig
    structure VIMapT : ReadablePropertyMapSig where type value_t = int
    structure PMapT : ReadWritePropertyMapSig
    structure DMapT : ReadWritePropertyMapSig
    structure WMapT : ReadablePropertyMapSig
    structure CmpT : StrictWeakOrderingSig
    structure CmbT : BinaryFunctionSig
    structure CMapT : ColorMapSig

    val dijkstra_shortest_paths :
        VLGraphT.graph_t -> VLGraphT.vertex_t -> PMapT.data_t ->
        DMapT.data_t -> WMapT.data_t -> VIMapT.data_t ->
        CmpT.data_t -> CmbT.data_t -> 
        DMapT.value_t -> DMapT.value_t -> unit

end
=
struct
    structure VLGraphT = Params.VertexListGraph
    structure IGraphT = Params.IncidenceGraph
    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 CMapT = MakeColorMap(structure Graph = VLGraphT;
                                   structure VIMap = VIMapT)

         
    (* make dm go away! *)

    structure PCmp (*: StrictWeakOrderingSig *) =
    struct
      type data_t = DMapT.data_t * CmpT.data_t
      type arg_t = VLGraphT.vertex_t
      fun create dmap cmp = (dmap,cmp)
      fun go (dmap,cmp) lhs rhs =
          CmpT.go cmp (DMapT.get dmap lhs) (DMapT.get dmap rhs)
    end


    structure PriQ = MakePQ(PCmp)

    structure DijkstraV (*: VisitorSig *) =
    struct

	type data_t = PriQ.queue_t * WMapT.data_t * PMapT.data_t *
                      DMapT.data_t * CmpT.data_t * CmbT.data_t * DMapT.value_t

	type graph_t = IGraphT.graph_t
	type vertex_t = IGraphT.vertex_t
	type edge_t = IGraphT.edge_t

	type vertex_fn = data_t -> vertex_t -> graph_t -> unit;
	type edge_fn = data_t -> edge_t -> graph_t -> unit;

        exception NegativeWeight

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

	fun create (tp as (queue,wmap,pmap,dmap,cmp,cmb,zero)) =

            tp

	fun initialize_vertex data v g = ()
	fun discover_vertex data v g = ()
	fun examine_vertex data v g = ()
	fun non_tree_edge data e g = ()
	fun black_target data e g = ()
	fun finish_vertex data v g = ()

	fun examine_edge (queue,wmap,pmap,dmap,cmp,cmb,zero) e g = 
            if CmpT.go cmp (WMapT.get wmap e) zero then
                raise NegativeWeight
            else
                ()

            (* Verify that the vertex weight is nonnegative *)

	fun tree_edge (queue,wmap,pmap,dmap,cmp,cmb,zero) e g = 
            (Relax.go dmap wmap pmap cmp cmb g e; ())
            (* do a relax in here *)

	fun gray_target (queue,wmap,pmap,dmap,cmp,cmb,zero) e g =
            (Relax.go dmap wmap pmap cmp cmb g e; ())
            (* do a relax in here too. *)
    end;

  structure GS =
  GSFunctor(struct 
        structure IncidenceGraph = IGraphT
        structure ColorMap = CMapT
        structure Queue = PriQ
        structure Visitor = DijkstraV
      end)

fun dijkstra_shortest_paths 
    graph vertex pmap dmap wmap imap cmp cmb inf zero = 
        let val cmap = CMapT.create(imap,graph)
        in (
        app (fn n => (
               PMapT.put pmap n n;
               DMapT.put dmap n inf)) (VLGraphT.vertices(graph));
        DMapT.put dmap vertex zero;              
        let 
            val icmp = PCmp.create dmap cmp
            val queue = PriQ.create icmp
            val vis = DijkstraV.create (queue,wmap,pmap,dmap,cmp,cmb,zero)
        in
            GS.graph_search graph vertex queue vis cmap
        end;
	())
        end
end