(* 
 * bfs.sml - Breadth first search and visit algorithms.
 *   Ronald Garcia
 *   $Id: bfs.sml,v 1.2 2003/05/02 20:03:37 jewillco Exp $
 *)

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


use "graph.sml";
use "property_map.sml";
use "color_map.sml";

signature BufferSig =
sig
    type data_t
    type value_t
    val push : data_t -> value_t -> unit;
    val pop  : data_t -> value_t;
    val empty : data_t -> bool;
end


signature VisitorSig =
sig
    type data_t
    type graph_t
    type vertex_t
    type edge_t

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

    val initialize_vertex : vertex_fn
    val discover_vertex : vertex_fn
    val examine_vertex : vertex_fn
    val examine_edge : edge_fn
    val tree_edge : edge_fn
    val non_tree_edge : edge_fn
    val gray_target : edge_fn
    val black_target : edge_fn
    val finish_vertex : vertex_fn
end;




(* 
 * GS - Graph Search
 *)
signature GSPSig = 
sig
  structure IncidenceGraph : IncidenceGraphSig
  structure ColorMap : ColorMapSig
  structure Queue : BufferSig
  structure Visitor : VisitorSig

  sharing IncidenceGraph = Visitor

  sharing type ColorMap.key_t =
               IncidenceGraph.vertex_t =
               Queue.value_t
end

functor GSFunctor(Params : GSPSig) :
sig
    structure ColorT : ColorMapSig
    structure IGraphT : IncidenceGraphSig
    structure QueueT : BufferSig
    structure VisitorT : VisitorSig

    val graph_search :
        IGraphT.graph_t -> IGraphT.vertex_t ->
        QueueT.data_t -> VisitorT.data_t -> ColorT.data_t -> unit
end
 =
struct
  structure IGraphT : IncidenceGraphSig = Params.IncidenceGraph
  structure ColorT : ColorMapSig = Params.ColorMap
  structure QueueT : BufferSig = Params.Queue
  structure VisitorT : VisitorSig = Params.Visitor

fun graph_search (g:IGraphT.graph_t) (v:IGraphT.vertex_t)
                        (q:QueueT.data_t)
                        (vis:VisitorT.data_t) (map:ColorT.data_t) = (
    ColorT.put map v (ColorT.gray());
    QueueT.push q v;
    VisitorT.discover_vertex vis v g;
    while (not (QueueT.empty(q))) do 
      let
         val u = QueueT.pop(q);
      in (
          app (fn e =>(
                  VisitorT.examine_edge vis e g;
                  let
                      val v = (IGraphT.target g e)
                  in
                      if (ColorT.get map v) = (ColorT.white()) then
                          (VisitorT.tree_edge vis e g;
                           ColorT.put map v (ColorT.gray());
                           QueueT.push q v;
                           VisitorT.discover_vertex vis v g)
                           
                      else (
                          VisitorT.non_tree_edge vis e g;
                          if (ColorT.get map v) = ColorT.gray() then
                              VisitorT.gray_target vis e g
                          else (* Black *)
                              VisitorT.black_target vis e g)
                  end)) (IGraphT.out_edges g u);
          ColorT.put map u (ColorT.black());
          VisitorT.finish_vertex vis u g)
      end);
end;


(* 
 * breadth_first_search
 * BFS( graph, vertex, buffer, visitor, colormap ) 
 *   - This is the functor that instantiates a BFS algorithm
 *)

(* Parameter constraints 
 * Note this could have been done inline in the BFS functor definition,
 * limiting name usage at the expense of some ugliness
 *)
signature BFSPSig = 
sig
  structure IncidenceGraph : IncidenceGraphSig
  structure VertexListGraph : VertexListGraphSig
  structure ColorMap : ColorMapSig
  structure Queue : BufferSig
  structure Visitor : VisitorSig

  sharing IncidenceGraph = VertexListGraph = Visitor

  sharing type ColorMap.key_t =
               IncidenceGraph.vertex_t =
               Queue.value_t
end

functor MakeBFS(Params : BFSPSig) :
sig
    structure ColorT : ColorMapSig
    structure IGraphT : IncidenceGraphSig
    structure VGraphT : VertexListGraphSig
    structure QueueT : BufferSig
    structure VisitorT : VisitorSig

    val breadth_first_search :
        IGraphT.graph_t -> IGraphT.vertex_t -> QueueT.data_t ->
	VisitorT.data_t -> ColorT.data_t -> unit
end
 =
struct
  structure IGraphT : IncidenceGraphSig = Params.IncidenceGraph
  structure VGraphT : VertexListGraphSig = Params.VertexListGraph
  structure ColorT : ColorMapSig = Params.ColorMap
  structure QueueT : BufferSig = Params.Queue
  structure VisitorT : VisitorSig = Params.Visitor

  structure GS =
  GSFunctor(struct 
        structure IncidenceGraph = Params.IncidenceGraph
        structure ColorMap = Params.ColorMap
        structure Queue = Params.Queue
        structure Visitor = Params.Visitor
      end)

fun breadth_first_search (g:IGraphT.graph_t) (v:IGraphT.vertex_t)
                         (q:QueueT.data_t)
                         (vis:VisitorT.data_t) (map:ColorT.data_t) = (
    app  (fn n => (
             ColorT.put map n (ColorT.white());
             VisitorT.initialize_vertex vis n g))  (VGraphT.vertices(g));
    GS.graph_search g v q vis map)
end;