# digraph_alg.sa

Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
```
---------------------------> Sather 1.1 source file <--------------------------
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.

class DIGRAPH_ALG{NTP}
class DIGRAPH_ALG{NTP} is
-- The default version of the algorithm class expects node indices
-- of type NTP and will any kind of read-only directed graph.
-- Using this version simplifies some uses but can be significantly
-- less efficient
include DIGRAPH_ALG{INT,\$RO_DIGRAPH{INT}};

end;

class DIGRAPH_ALG{NTP, GTP < \$RO_DIGRAPH{NTP}}
class DIGRAPH_ALG{NTP, GTP < \$RO_DIGRAPH{NTP}} is
-- NTP is the node index type and GTP is the graph type
--
-- A collection of some very simple graph traversal algorithms
--
-- All the following routines assume that the graph is acyclic.
-- They may go into an infinite loop or fail in some other way if
-- the graph contains cycles.
-- Usage:
--     g: DIGRAPH{INT} := #;
--     g.connect(n1,n2); g.connect(n1,n3);
--     Constructs:
--      1
--      /\
--     2  3
--
--     Getting the layers of the graph:
--        l: LIST{SET{INT}} := #;
--        loop s: SET{INT} := DIGRAPH_ALG::layer!(g);
--             l := l.append(s);
--         end;

source!(once g: GTP): NTP is
-- Yield all source nodes in the graph "g"
loop n ::= g.node!;  if g.n_incoming(n) = 0 then yield n end; end;
end;

sink!(once g: GTP): NTP is
-- Yield all sink nodes in the graph "g"
loop n ::= g.node!;  if g.n_outgoing(n) = 0 then yield n end; end;
end;

bf!(once g: GTP,once n: NTP): NTP is
-- Return all nodes reachable from "n" in breadth first order
-- With inout arguments, also return the depth of the node
depths: FMAP{NTP,INT} := #;
q: A_QUEUE{NTP} := #;
q.enq(n);
depths := depths.insert(n,0);
loop until!(q.is_empty);
current ::= q.remove;
node_depth: INT := depths.get(current);
yield current;
child_node_depth: INT := node_depth + 1;
loop out_node ::= g.outgoing!(current);
if ~depths.has_ind(out_node) then
q.enq(out_node);
depths:=depths.insert(out_node,child_node_depth);
end;
end;
end;
end;

df!(once g: GTP,once n: NTP): NTP is
-- Return all nodes reachable from "n" in depth first order
stack ::= #FLIST{NTP};  stack := stack.push(n);
depths  ::= #FMAP{NTP,INT};   depths := depths.insert(n,0);
loop until!(stack.is_empty);
cur ::= stack.pop;
cur_depth: INT := depths.get(cur);
yield cur;		-- Actual visit
child_depth: INT := cur_depth+1;
loop neigh ::= g.outgoing!(cur);
if ~depths.has_ind(neigh) then
stack:=stack.push(neigh);
depths:=depths.insert(neigh,child_depth);
end; -- else ( Neighbor has been seen before => backedge.)
end;
end; -- Until stack is empty
end;

topo_order!(once g: GTP): NTP is
-- Yield nodes in topological order
if g.is_empty then quit end;
-- Current indegree holds the current number of incoming per node
-- When the number of incoming goes to zero, the node is
-- visited and the current indegree values of all its outgoing  are
-- decremented.
current_indeg ::= #FMAP{NTP,INT};
-- Mapping from nodes to living incoming
roots ::= #FLIST{NTP};	-- Root nodes
loop n: NTP := g.node!;
deg ::= g.n_incoming(n);
current_indeg := current_indeg.insert(n,deg);
if (deg = 0) then roots := roots.push(n); end;
end;
loop while!(roots.size > 0);
ni ::= roots.pop;
-- Yield the next node in topological order
yield(ni);
loop out_node ::= g.outgoing!(ni);
outgoing_indegree ::= current_indeg.get(out_node);
new_out_indeg ::= outgoing_indegree - 1;
current_indeg:=current_indeg.insert(out_node,new_out_indeg);
if (new_out_indeg=0) then roots := roots.push(out_node);  end;
end;
end;
end;

is_topo_order(g: GTP,nodes: \$ARR{NTP}): BOOL is
-- Verify that the nodes in "node_order" are in topological order,
-- that each node's order is greater than the order of any
-- of its parents. Better methods probably exist...
node_order ::= #FMAP{NTP,INT};
loop node_order:=node_order.insert(nodes.elt!, nodes.size.times!) end;
loop
node_depth_tup: TUP{NTP,INT} := node_order.pair!;
child: NTP:=node_depth_tup.t1; child_order: INT := node_depth_tup.t2;
if g.has_node(child) then
loop parent: NTP := g.incoming!(child);
if node_order.has_ind(parent) then
parent_order: INT := node_order.get(parent);
if parent_order >= child_order then
return false;
end;
end; -- Ignore the parent if it is not in the order
end; -- End of loop on parents
end; -- End of if has_node(child).
-- If the child is not in the current graph, also ignore it
end;
return true;
end;

layer!(once g: GTP): SET{NTP} is
-- Return the "layers" of the graph, i.e. peel off successive root
-- sets
-- Current indegree holds the current number of incoming per node
-- When the number of incoming goes to zero, the node is
-- visited and the current indegree values of all its outgoing  are
-- decremented.
-- All nodes/edges start out live.
-- Loop, at each iteration:
--    Find the nodes that have no live incoming edges and  yield them
--    Mark the nodes and all edges going out of them as dead
-- Until no more nodes are left alive

li::= #FMAP{NTP,INT}; -- Maps nodes to the number of live incoming edges
nodes_left: INT := g.n_nodes; -- Number of live nodes left
loop n: NTP := g.node!;
deg ::= g.n_incoming(n);
li := li.insert(n,deg);
if (deg = 0) then dead.insert(n); end;
end;
loop while!(nodes_left > 0);
-- Indicate that the outgoing edges from the old root set
loop out_node ::= g.outgoing!(r);
-- Get the current live indegree of the node "out_node"
indeg_of_out_node: INT := li.get(out_node);
-- Reduce the number of "live"  edges into "out_node"
-- by 1 since "r", a parent root,  has been yielded and is dead
new_live_indegree_of_out_node ::= indeg_of_out_node - 1;
li := li.insert(out_node,new_live_indegree_of_out_node);
-- If there are no more "live" incoming edges to "out_node",
-- yield it. Out_node is now dead
if new_live_indegree_of_out_node = 0 then
end;
end; -- End of loop around outgoing nodes of a root
end; -- End of loop through old dead