------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- Author: Benedict A. Gomes <gomes@tiramisu.ICSI.Berkeley.EDU>

partial class UGRAPH_INCL{NTP} < $UGRAPH{NTP} is
   -- Partial class used to define useful routines in  undirected
   -- graphs that are based on a core set of (undefined) routines
   -- The core routines must be defined by a particular implementation
   -- upon inclusion
   private include COMPARE{NTP};
   
   -- ------------------- Stubs: Must redefine ------------
   stub has_node(n: NTP): BOOL;
   stub has_edge(first,second: NTP): BOOL;
   stub add_node: NTP;
   stub add_node(n: NTP);
   stub add_node(n: NTP):NTP;
   stub connect(n1,n2: NTP); 
   stub delete_node(n: NTP); 
   stub disconnect(n1,n2: NTP); 
   stub node!: NTP;
   stub adjacent!(once n: NTP): NTP; 
   stub copy: SAME;
   stub create: SAME;
   -- Some of the routines need to create a "fresh" graph.
   
   -- ------------------- Insertion -----------------------
   connect(e: UEDGE{NTP}) is connect(e.first,e.second) end;

   disconnect(e: UEDGE{NTP}) is disconnect(e.first,e.second) end;

   -- ------------------- Access --------------------------
   nodes: SET{NTP} is
      res: SET{NTP};  loop res.insert(node!) end;  return res;
   end;
      
   edges: SET{UEDGE{NTP}} is
      res: SET{UEDGE{NTP}} := #;  loop res.insert(edge!) end;  return res;
   end;
   
   adjacent(n: NTP): SET{NTP} is
      res: SET{NTP} := #;  loop res.insert(adjacent!(n)) end;  return res;
   end;
   
   reachable_from(n: NTP): SET{NTP} is
      -- Returns the set of nodes reachable from "n"
      res: SET{NTP};  loop res.insert(reachable_from!(n)) end; return res;
   end;
   
   roots: SET{NTP} is
      -- Returns a list of "representative" nodes from which the
      -- whole graph is reachable. 
      -- With inout args, also return a mapping from nodes to the
      -- appropriate representative nodes (i.e. seen)
      seen: FSET{NTP};
      roots:SET{NTP};
      loop n ::= node!; 
	 if ~seen.test(n) then  
	    roots.insert(n); 
	    loop  seen := seen.insert(reachable_from!(n));  end;
	 end;
      end;
      return roots;
   end;

   node_depths(n: NTP,map:$MAP{NTP,INT}) is
      -- map should be inout, but this will work for now
      -- Do a bfs and return depths of each node
      d ::= 1; loop map[bfs!(n)] := d; d := d + 1; end;
   end;

   -- ------------------- Queries -------------------------
   has_edge(e: UEDGE{NTP}):BOOL is return has_edge(e.first,e.second) end;

   are_connected(n1,n2: NTP): BOOL is
      -- Return true if there exists a path from n1 to n2
      loop n: NTP := dfs!(n1);
	 if elt_eq(n,n2) then return true; end;
      end;
      return false;
   end;
   
   is_empty: BOOL is return(n_nodes = 0) end;

   has(n: NTP): BOOL is return has_node(n) end;
   
   n_reachable_from(n: NTP): INT is 
      i: INT := 0; loop discard ::= reachable_from!(n); i := i + 1;  end;
      return i
   end;

   n_edges: INT is
      i: INT := 0; loop e ::= edge!; i := i + 1; end;
      return i
   end;
   
   n_nodes: INT is
      i: INT := 0; loop e ::= node!; i := i + 1; end;
      return i
   end;      

   size: INT is return n_nodes end;
   
   n_adjacent(n: NTP): INT is
      i: INT := 0; 
      loop adj_n ::= adjacent!(n); i := i + 1; end;
      return i;
   end;

   -- ------------------- Cursor --------------------------
   elt!: NTP is loop yield node! end; end;
   
   edge!: UEDGE{NTP} is
      seen: FSET{NTP} := #;
      loop n ::= node!;
	 seen := seen.insert(n);
	 loop 
	    neigh ::= adjacent!(n);
	    if ~seen.test(neigh) then   yield #UEDGE{NTP}(n,adjacent!(n));  end;
	    -- Avoid yielding edges twice, from both directions
	 end;
      end;
   end;
   
   filter_edge!(once pred: ROUT{UEDGE{NTP}}:BOOL):UEDGE{NTP} is
      -- Return a set of edge tuples that are true for test "et"
      loop e ::= edge!; if pred.call(e) then yield(e) end; end;
   end;
   
   filter_node!(once pred: ROUT{NTP}:BOOL): NTP is
      -- Return the set of all nodes in g that satisfy the node test "nt"
      loop n ::= node!; if pred.call(n) then  yield n end end;
   end;

   bfs!(once n: NTP): NTP is
      -- Return all nodes reachable from "n" in bf order
      seen: FSET{NTP} := #;
      q: A_QUEUE{NTP} := #;
      q.enq(n);
      loop until!(q.is_empty);
	 current ::= q.remove;
	 yield current;
	 loop adjacent ::= adjacent!(current);
	    if ~seen.test(adjacent) then 
	       q.enq(adjacent); 
	       seen:=seen.insert(adjacent); 
	    end;
	 end;
      end;
   end;

   dfs!(once n: NTP): NTP is
      -- Return all nodes reachable from "n" in df order
      stack ::= #FLIST{NTP};  stack := stack.push(n);
      seen  ::= #FSET{NTP};   seen := seen.insert(n);       
      loop until!(stack.is_empty);
	 cur ::= stack.pop;     
	 yield cur;		-- Actual visit
	 loop neigh ::= adjacent!(cur);
	    if ~seen.test(neigh) then 
	       stack:=stack.push(neigh);
	       seen:=seen.insert(neigh);
	    end; -- else ( Adjacent has been seen before => backedge.) 
	 end;
      end; -- Until stack is empty
   end;

   reachable_from!(once n: NTP): NTP is
      -- Returns successive nodes reachable from "n"
      -- using dfs
      loop yield dfs!(n) end;
   end;
     
   -- ------------------- Comparison ----------------------
   equals(g: $RO_UGRAPH{NTP}): BOOL is
      -- Check that nodes and edges are the same
      -- Very inefficient n^2 version - sort for nlogn version
      if ~has_same_nodes(g) then return false end;
      loop e ::= edge!; if ~g.has_edge(e) then return false end; end;
      loop e ::= g.edge!; if ~has_edge(e) then return false end; end;
      return(true);
   end;

   has_same_nodes(g: $RO_UGRAPH{NTP}): BOOL is
      if n_nodes /= g.n_nodes then return false end;
      loop n ::= g.node!; if ~has_node(n) then return false end; end;
      return true;
   end;

   -- ------------------- Transformation ------------------
   to_union(g: $UGRAPH{NTP}) is
      loop add_node(g.node!) end;
      loop connect(g.edge!) end;
   end;

   to_difference(g: $UGRAPH{NTP}) is
      loop e ::= edge!; 
	 if g.has_edge(e) then 
	    disconnect(e);
	    f ::= e.first; s ::= e.second;
	    if n_adjacent(f) = 0  then delete_node(f) end;
	    if n_adjacent(s) = 0 then delete_node(s) end;
	 end; 
      end;
   end;
   
   dfs_apply(n: NTP,prewk:ROUT{NTP},postwk:ROUT{UEDGE{NTP}}) is
      -- Perform pre work before visiting a node and 
      -- perform postwk on the way back up each edge
      -- Recursive version of dfs (much simpler to code)
      -- Here postwork is applied to *all* edges, including back edges
      if void(postwk) then  dfs_apply(n,prewk);
      else dfs_rec(#FSET{NTP},n,prewk,postwk);
      end;
   end;
   
   dfs_apply(n: NTP,wk:ROUT{NTP}) is
      -- Apply the pre visit work "wk" to nodes in df order. Non recursive
      stack: FLIST{NTP} := #;
      seen ::= #FSET{NTP};
      seen := seen.insert(n);       
      stack := stack.push(n);
      loop until!(stack.is_empty);
	 cur ::= stack.pop;     
	 wk.call(cur);
	 loop adjacent ::= adjacent!(cur);
	    if ~seen.test(adjacent) then 
	       stack:=stack.push(adjacent);
	       seen:=seen.insert(adjacent);
	    end; -- else ( Adjacent has been seen before => backedge.) 
	 end;
      end; -- Until stack is empty
   end; 
   
   to_transitive_closure is
      -- Convert the graph to it's transitive closure
      -- For a non-destructive version, first make a copy
      loop 
	 u ::= node!;
	 loop v ::= node!;  if are_connected(u,v) then connect(u,v) end; end;
      end;
   end;

   delete_reflexive_edges is
      -- Delete all reflexive edges from the graph
      loop e ::= edge!;
	 if elt_eq(e.first,e.second) then disconnect(e) end;
      end;
   end;

   -- ------------------- Conversion ----------------------
   str: STR is
      return(str(bind(node_str(_))));
   end;

   private node_str(n: NTP): STR is
      if void(n) then return("void") end;
      typecase n
      when $STR then  return(n.str); else return("non-printable") end;
   end;

   str(f: ROUT{NTP}:STR): STR is
      -- Print out the graph using the bound routine "f"
      -- for the nodes   
      res ::= #FSTR("");
      loop n ::= node!;
	 if void(n) then res := res + "void  : ";
	 else res := res + f.call(n)+" : "; end;
	 loop
	    nm: STR := f.call(adjacent!(n));
	    res := res + ",".separate!(nm);
	 end; -- All parents edges
	 res := res+"\n";		-- End of another row of edges
      end; -- All graph nodes
      return(res.str);
   end;   

   -- ------------------- Basic Operations ----------------
   union(g: $UGRAPH{NTP}): $UGRAPH{NTP} is
      res: SAME := copy;
      res.to_union(g);
      return res;
   end;

   difference(g:$UGRAPH{NTP}): $UGRAPH{NTP} is
      res: SAME := copy; 
      res.to_difference(g);
      return res;
   end;

   induced_subgraph(v: $SET{NTP}): $UGRAPH{NTP} is
      -- Generate a subgraph which is induced by the edges "v".
      res: SAME := #SAME;
      loop n ::= node!;
	 res.add_node(n);
	 loop a ::= adjacent!(n);
	    if v.has(a) then res.connect(n,a) end;
	 end;
      end;
      return res;
   end;

   -- ------------------- Implementation ------------------
  private dfs_rec(seen:FSET{NTP},n:NTP,bef:ROUT{NTP},aft:ROUT{UEDGE{NTP}}) is
      -- Recursive depth first search, when both pre and postwork
      -- must be done. Seen holds the list of nodes already seen
      seen := seen.insert(n);
      bef.call(n);
      neigh: $ARR{NTP} := adjacent(n);
      ni: INT; nsz: INT := neigh.size;
      loop until!(ni=nsz);
	 child::=neigh[ni];
	 bef.call(child);	-- Pre work on node
	 if ~seen.test(child) then
	    dfs_app_rec(seen,child,bef,aft); 
	    aft.call(#UEDGE{NTP}(n,child));	-- Post work on edge
	 end;
	 ni := ni+1;
      end;
   end;
   
end; -- class UGRAPH_ALG_INCL
-------------------------------------------------------------------
