/* graph.q: directed graphs implemented using asymmetric adjacency lists
   $Id: graph.q,v 1.3 2004/04/16 00:32:20 agraef Exp $ */

/* This file is part of the Q programming system.

   The Q programming system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   The Q programming system 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 the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

/* This script implements graph objects which consist of nodes and directed
   edges connecting these nodes. Both nodes and edges can have arbitrary label
   values attached to them. Multiple edges between the same source and target
   node are allowed, thus multigraphs can be represented in a direct manner.
   No special representation is provided for undirected graphs, but these can
   easily be encoded as bidirected graphs, i.e., graphs with a symmetric
   adjacency relation. The labels allow all kind of additional information to
   be stored with the nodes and edges, such as node names and edge weights.

   For the purpose of building and inspecting graphs, a graph is described in
   one of two different ways:

   - The adjacency list representation. In this representation, the graph is
     given as a list of "node infos", where each node info specifies the index
     of the node (an integer), a list of "edge infos" (consisting of the index
     of a target node and optional edge labels), and the optional node labels.
     The syntax of the adjacency list representation is described by the
     following pseudo BNF rules (`?' indicates optional elements):

     graph	::= [?node-info?, ...]
     node-info	::= (node-index, [?edge-info?, ...], ?label?, ...)
     edge-info	::= node-index | (node-index, ?label?, ...)
     node-index	::= integer
     label	::= any value

   - The "split" representation which separately lists the nodes and edges of
     a graph. In this representation, the node descriptions specify a node
     index and the optional node labels. The edge descriptions consist of the
     source and target node index and optional edge labels. The syntax of the
     split representation is as follows:

     graph	::= ([?node?, ...],[?edge?, ...])
     node	::= node-index | (node-index, ?label?, ...)
     edge	::= (node-index, node-index, ?label?, ...)

   While the adjacency list representation is more compact and allows fast
   access to the outgoing edges of a node, the split representation is often
   more convenient when operating on a graph as a whole. For instance, here is
   how to specify a complete graph on 3 nodes using the adjacency list
   representation:

   graph [(1,[2,3]),(2,[1,3]),(3,[1,2])]

   The same graph specified using the split representation:

   graph ([1,2,3],[(1,2),(1,3),(2,1),(2,3),(3,1),(3,2)])

   You can also add node and edge labels, e.g., as follows:

   graph ([(1,(0.0,0.0)),(2,(1.0,0.0)),(3,(0.0,1.0))],
          [(1,2,1.0),(1,3,1.0),(2,1,1.0),(2,3,sqrt 2),(3,1,1.0),(3,2,sqrt 2)])

   Internally, a graph is always represented as a special kind of ordered node
   info dictionary, which allows fast random access to the labels and edges of
   each node. Operations are provided to extract the adjacency list or split
   representation of a graph and to translate between both kinds of
   representations. */

public type Graph = private const nil, bin H INF D1 D2;

/* Graph construction. ******************************************************/

public emptygraph;		// returns the empty graph

public graph DESC;		// creates a graph from its adjacency list
				// or split representation
public graph2 DESC;		// creates a bidirected graph, containing all
				// given edges plus their reversals

/* The following operations create random graphs with a given edge probability
   P, 0<=P<=1. Nodes are numbered from 1 to N, where N is the desired size of
   the graph. Each operation has a variant which creates bidirected graphs.
   
   All generated graphs are simple, i.e., do not contain multiple edges. The
   graphs created with ranlgraph/ranlgraph2 are also loopless, i.e., they do
   not contain any edges from a node to itself. For P=0 and P=1 you get
   edgeless and complete graphs, respectively. (A complete graph is one in
   which all pairs of nodes are connected.)

   The main purpose of these operations is to provide you with a method to
   create small test graphs for your algorithms. Since these operations take
   time proportional to N^2 they are too slow for generating large graphs. */

public rangraph N P;		// creates a random graph
public rangraph2 N P;		// creates a random bidirected graph

public ranlgraph N P;		// creates a random loopless graph
public ranlgraph2 N P;		// creates a random loopless bidirected graph

/* Graph inspection. ********************************************************/

public isgraph X;		// checks whether X is a graph

public stddecl::null G;		// checks whether G is the empty graph

public stddecl::member G N;	// checks whether G contains node N

public adj_list G;		// convert a graph or its split representation
				// to its adjacency list representation

public split_graph G;		// convert a graph or its adjacency list
				// representation to its split representation

// G1=G2, G1<>G2		// graph equality/inequality

// #G				// size of G (number of nodes)

// G!N				// the node info of node N

public minnode G;		// the smallest node of G

public maxnode G;		// the largest node of G

public nodes G;			// the list of all node numbers of G, sorted
				// in ascending order

/* Inspection of nodes and edges. *******************************************/

/* The following operations all take a node info as argument. */

public node N;			// the node number

public edge_infos N;		// edge infos of outgoing edges

public edges N;			// outgoing edges in (S,T|L) format

public adj N;			// list of adjacent nodes

public labels N;		// the node labels

/* The following functions operate on edge descriptions as returned by the
   edges function. */

public source E;		// source of an edge

public target E;		// target of an edge

public labels E;		// edge labels

/* Search operations. *******************************************************/

/* The following search operations take a predicate P as first argument. This
   predicate is applied to the node infos of a graph, or the edge infos of a
   node, to determine the first matching node or edge, respectively. The
   search_edge function can be invoked either with a node number or an edge
   specification of the form (S,T) where S is the source and T the target
   node. */

public search_node P G;		// return the index of the smallest node
				// satisfying P

public search_edge P G _;	// return the edge info of the first edge
				// satisfying P, among the edges with the
				// given source, or the given source and
				// target nodes

/* Graph manipulation. ******************************************************/

/* Add a new or update an existing node. The node is specified in the form N
   or (N|L), where N is the node number and L the node labels. To add a new
   node, the node must not already be in the graph. Conversely, when updating
   a node, the node must already exist. Note that update_node will replace
   *all* labels of the node; in particular, if only the node number is given,
   all current node labels will be deleted. */

public add_node G N;
public update_node G N;

/* Delete a node, given by its node number N. If the node does not belong to
   the graph, the operation leaves the graph unchanged. */

public del_node G N;

/* Rename a node. This only changes the node number. The new node number must
   not exist in the graph. */

public rename_node G N M;

/* Renames all nodes of a graph; maps N to F N in all node and edge infos. */

public map_nodes F G;

/* Update the edges of a node. The argument is a list of edge infos to be
   substituted for the current edges of the node. The targets of all given
   edges must exist in the graph. */

public update_edges G N E;

/* The following edge manipulation operations all come in two flavours. The
   first variation operates only on the given edge, while the second one
   operates both on the given edge (S,T) and its reversal (T,S) (if S<>T). The
   latter operations are convenient when manipulating bidirected graphs. In
   all cases, both the source and target node of the given edge must be
   contained in the graph. */

/* Add or update an edge. The edge is specified as a tuple E=(S,T|L) where S
   and T is the source and target node, and L the edge labels. When updating
   an edge, if an edge with the given source and target node does not exist in
   the graph, the graph is left unchanged; if there are multiple edges for the
   given source and target, the first matching edge is updated. Please also
   note that update_edge will replace *all* labels of the edge; in particular,
   if no labels are given, the current edge labels will be deleted. */

public add_edge G E;
public add_edge2 G E;

public update_edge G E;
public update_edge2 G E;

/* Update the first edge matching the given predicate. The predicate is
   applied to the edge infos of the source node. If no matching edge is found,
   the graph is left unchanged. */

public update_edge_with P G E;
public update_edge2_with P G E;

/* Delete an edge. The edge is specified as a pair E=(S,T), where S is the
   source and T the target node. If an edge with the given source and target
   does not exist in the graph, the operation leaves the graph unchanged. If
   multiple edges for the given source and target exist, the first matching
   edge is deleted. */

public del_edge G E;
public del_edge2 G E;

/* Delete the first edge matching the given predicate. The predicate is
   applied to the edge infos of the source node. If no matching edge is found,
   the graph is left unchanged. */

public del_edge_with P G E;
public del_edge2_with P G E;

/* Special graph operations. ************************************************/

public revgraph G;		// reverses a graph (makes the source of each
				// edge its target and vice versa)

public sortgraph G;		// sorts all edges in ascending order w.r.t.
				// target nodes

public subgraph G U;		// computes the subgraph induced by the given
				// node list; the resulting graph consists of
				// the given nodes and all incident edges

public addgraph G1 G2;		// computes the disjoint union of two graphs;
				// the nodes of G2 are shifted by maxnode G1-
				// minnode G2+1 to make the two node sets
				// disjoint

public joingraph G1 G2;		// merges G2 into G1; the resulting graphs has
				// all the nodes and edges from both G1 and G2

/* Implementation. **********************************************************/

/* Internally a graph is represented as a special type of ordered dictionary
   storing node infos. The following code is copied more or less verbatim
   from dict.q. */

private height G;		// return height of tree
private slope G;		// return slope (height diff between left and
				// right subtree)
private mkbin INF G1 G2;	// construct tree node, recomputing height

private rebal G;		// rebalance tree after insertions and 
				// deletions
private rol G, ror G;		// single rotation left/right
private shl G, shr G;		// shift to left/right (single or double
				// rotation)

private join G1 G2;		// join two balanced subtrees

private first G, last G;	// return first and last member of tree
private rmfirst G, rmlast G;	// remove first and last member from tree

private insert G INF;		// insert/update a node info
private delete G N;		// delete a node info

height nil			= 0;
height (bin H _ _ _)		= H;

slope nil			= 0;
slope (bin _ _ G1 G2)		= height G1 - height G2;

mkbin INF G1 G2			= bin (max (height G1) (height G2) + 1)
				  INF G1 G2;

rebal G				= shl G if slope G = -2;
				= shr G if slope G = 2;
				= G otherwise;

rol (bin H1 INF1 G1 (bin H2 INF2 G2 G3))
				= mkbin INF2 (mkbin INF1 G1 G2) G3;
ror (bin H1 INF1 (bin H2 INF2 G1 G2) G3)
				= mkbin INF2 G1 (mkbin INF1 G2 G3);

shl (bin H INF G1 G2)		= rol (mkbin INF G1 (ror G2))
				      if slope G2 = 1;
				= rol (bin H INF G1 G2) otherwise;

shr (bin H INF G1 G2)		= ror (mkbin INF (rol G1) G2)
				      if slope G1 = -1;
				= ror (bin H INF G1 G2) otherwise;

join nil G2			= G2;
join G1 G2			= rebal (mkbin (last G1) (rmlast G1) G2)
				    otherwise;

first (bin _ INF nil _)		= INF;
first (bin _ _ G1 _)		= first G1 otherwise;

last (bin _ INF _ nil)		= INF;
last (bin _ _ _ G2)		= last G2 otherwise;

rmfirst (bin _ _ nil G2)	= G2;
rmfirst (bin _ INF G1 G2)	= rebal (mkbin INF (rmfirst G1) G2)
				    otherwise;

rmlast (bin _ _ G1 nil)		= G1;
rmlast (bin _ INF G1 G2)	= rebal (mkbin INF G1 (rmlast G2))
				    otherwise;

insert nil INF1			= bin 1 INF1 nil nil;
insert (bin H INF G1 G2) INF1	= rebal (mkbin INF (insert G1 INF1) G2)
				    if node INF>node INF1;
				= rebal (mkbin INF G1
					 (insert G2 INF1))
				    if node INF<node INF1;
				= bin H INF1 G1 G2 if node INF=node INF1;

delete nil _			= nil;
delete (bin _ INF G1 G2) N	= rebal (mkbin INF (delete G1 N) G2)
				    if node INF>N;
				= rebal (mkbin INF G1 (delete G2 N))
				    if node INF<N;
				= join G1 G2 if node INF=N;

/* Public Functions: *******************************************************/

private index, node_desc, edge, dest, check;

/* Construction. */

emptygraph			= nil;

graph DESC:List			= foldl insert nil DESC if check DESC;

graph (V:List,E:List)		= foldl add_edge (foldl add_node nil V) E
				    if check (V,E);

graph2 DESC:List		= foldl add_edge2 (foldl add_node nil V) E
				    where (V,E) =
				      (map node_desc DESC,cat (map edges DESC))
				    if check DESC;

graph2 (V:List,E:List)		= foldl add_edge2 (foldl add_node nil V) E
				    if check (V,E);

var K;

rangraph N:Int P:Num		= graph
				  (listof (K,filter (select P) (nums 1 N))
				   (K in nums 1 N))
				    if (P>=0) and then (P<=1);

rangraph2 N:Int P:Num		= graph2
				  (listof (K,filter (select P) (nums 1 K))
				   (K in nums 1 N))
				    if (P>=0) and then (P<=1);

select P _			= random/0x100000000 < P;

lselect P K N			= (K<>N) and then (random/0x100000000<P);

ranlgraph N:Int P:Num		= graph
				  (listof (K,filter (lselect P K) (nums 1 N))
				   (K in nums 1 N))
				    if (P>=0) and then (P<=1);

ranlgraph2 N:Int P:Num		= graph2
				  (listof (K,filter (lselect P K) (nums 1 K))
				   (K in nums 1 N))
				    if (P>=0) and then (P<=1);

/* Inspection. */

isgraph _:Graph			= true;
isgraph _			= false otherwise;

null nil			= true;
null _:Graph			= false otherwise;

member nil _			= false;
member (bin _ INF G1 G2) N:Int	= member G1 N if node INF>N;
				= member G2 N if node INF<N;
				= true if node INF=N;

adj_list nil			= [];
adj_list (bin _ INF G1 G2)	= adj_list G1 ++ [INF|adj_list G2];

adj_list (V:List,E:List)	= adj_list
				  (foldl add_edge (foldl add_node nil V) E)
				    if check (V,E);

split_graph G:Graph		= (map node_desc DESC,cat (map edges DESC))
				    where DESC = adj_list G;

split_graph DESC:List		= (map node_desc DESC,cat (map edges DESC))
				    if check DESC;

(G1:Graph=G2:Graph)		= (adj_list G1 = adj_list G2);
(G1:Graph<>G2:Graph)		= (adj_list G1 <> adj_list G2);

#nil				= 0;
#bin _ _ G1 G2			= #G1+#G2+1;

bin _ INF G1 G2 !N		= G1!N if node INF>N;
				= G2!N if node INF<N;
				= INF if node INF=N;

minnode G:Graph			= node (first G) if not null G;
maxnode G:Graph			= node (last G) if not null G;

nodes G:Graph			= map node (adj_list G);

node (N:Int|_)			= N;
edge_infos (N:Int,E:List|_)	= E;
edges (N:Int,E:List|_)		= map (edge N) E;
adj (_:Int,E:List|_)		= map dest E;
labels (_,_|L)			= L;
source (N:Int,M:Int|_)		= N;
target (N:Int,M:Int|_)		= M;

// private helper functions for internal use

index N:Int			= N;
index (N:Int|_)			= N;
node_desc (N:Int,_:List)	= N;
node_desc (N:Int,_:List|L)	= (N|L);
edge N:Int (M:Int|L)		= (N,M|L);
edge N:Int M:Int		= (N,M);
dest N:Int			= N;
dest (N:Int|_)			= N;

// check the validity of a graph description in adjacency list or split
// representation

private check_node_info, check_edge_infos, check_edge_info,
  check_node, check_edge;

check DESC:List			= all check_node_info DESC and then
				  all (check_edge_infos (set (map node DESC)))
				  DESC;

check (V:List,E:List)		= all check_node V and then
				  all (check_edge (set (map index V))) E;

check_node_info (N:Int,E:List|_)
				= true;
check_node_info _		= false otherwise;

check_edge_infos V (N:Int,E:List|_)
				= all (check_edge_info V) E;
check_edge_infos _ _		= false otherwise;

check_edge_info V (M:Int|_)	= member V M;
check_edge_info V M:Int		= member V M;
check_edge_info _ _		= false otherwise;

check_node (N:Int|_)		= true;
check_node N:Int		= true;
check_node _			= false otherwise;

check_edge V (N:Int,M:Int|_)	= member V N and then member V M;
check_edge _ _			= false otherwise;

/* Search operations. */

private search_node_infos, search_edge_infos, search_edge_infos2;

search_node P G:Graph		= N if isint N or else istuple N
				    where N = search_node_infos P (adj_list G);

search_node_infos P [N|NODES]	= N if P N;
				= search_node_infos P NODES otherwise;

search_edge P G:Graph N:Int	= E if isint E or else istuple E
				    where E = search_edge_infos P
				      (edge_infos (G!N));

search_edge_infos P [E|EDGES]	= E if P E;
				= search_edge_infos P EDGES otherwise;

search_edge P G:Graph (N:Int,M:Int)
				= E if isint E or else istuple E
				    where E = search_edge_infos2 P
				      (edge_infos (G!N)) M;

search_edge_infos2 P [E|EDGES] M
				= E if (dest E=M) and then P E;
				= search_edge_infos2 P EDGES M otherwise;

/* Manipulation. */

// add a new node

add_node G:Graph N:Int		= insert G (N,[]) if not member G N;
add_node G:Graph (N:Int|L)	= insert G (N,[]|L) if not member G N;

// update an existing node

update_node G:Graph N:Int	= insert G (N,edge_infos INF)
				    where INF:Tuple = G!N;
update_node G:Graph (N:Int|L)	= insert G (N,edge_infos INF|L)
				    where INF:Tuple = G!N;

// delete a node

private filter_node;

del_node G:Graph N:Int		= graph
				  (map (filter_node N)
				   (filter ((<>N).node) (adj_list G)));

filter_node N (M,E|L)		= (M,filter ((<>N).dest) E|L);

// rename a node

private ren;

rename_node G:Graph N:Int M:Int	= G if N=M;
				= map_nodes (ren N M) G
				    if not member G M;

ren N M K			= M if K=N;
				= K otherwise;

// rename all nodes

private map_node, map_edge;

map_nodes F G:Graph		= graph (map (map_node F) (adj_list G));

map_node F (N,E|L)		= (F N,map (map_edge F) E|L);

map_edge F (N|L)		= (F N|L);
map_edge F N			= F N;

// update edges of a node

update_edges G:Graph N:Int E:List
				= insert G (N,E|labels INF)
				    if all (check_edge_info G) E
				    where INF:Tuple = G!N;

// add a new edge

add_edge G:Graph (N:Int,M:Int)	= insert G
				  (N, append (edge_infos INF) M|
				   labels INF)
				    if member G M
				    where INF:Tuple = G!N;

add_edge G:Graph (N:Int,M:Int|L)
				= insert G
				  (N, append (edge_infos INF) (M|L)|
				   labels INF)
				    if member G M
				    where INF:Tuple = G!N;

add_edge2 G:Graph (N:Int,N|L)	= add_edge G (N,N|L);
add_edge2 G:Graph (N:Int,M:Int|L)
				= add_edge (add_edge G (N,M|L)) (M,N|L);

// update an existing edge

private replace_edge;

update_edge G:Graph (N:Int,M:Int)
				= insert G
				  (N, replace_edge (edge_infos INF) M|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

update_edge G:Graph (N:Int,M:Int|L)
				= insert G
				  (N, replace_edge (edge_infos INF) (M|L)|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

update_edge2 G:Graph (N:Int,N|L)
				= update_edge G (N,N|L);
update_edge2 G:Graph (N:Int,M:Int|L)
				= update_edge (update_edge G (N,M|L)) (M,N|L);

replace_edge [E1|EDGES] E2	= [E2|EDGES] if dest E1=dest E2;
replace_edge [E1|EDGES] E2	= [E1|replace_edge EDGES E2] otherwise;
replace_edge [] _		= [];

private replace_edge_with;

update_edge_with P G:Graph (N:Int,M:Int)
				= insert G
				  (N, replace_edge_with P (edge_infos INF) M|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

update_edge_with P G:Graph (N:Int,M:Int|L)
				= insert G
				  (N, replace_edge_with P (edge_infos INF)
				   (M|L)|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

update_edge2_with P G:Graph (N:Int,N|L)
				= update_edge_with P G (N,N|L);
update_edge2_with P G:Graph (N:Int,M:Int|L)
				= update_edge_with P
				  (update_edge_with P G (N,M|L)) (M,N|L);

replace_edge_with P [E1|EDGES] E2
				= [E2|EDGES]
				    if (dest E1=dest E2) and then P E1;
replace_edge_with P [E1|EDGES] E2
				= [E1|replace_edge_with P EDGES E2] otherwise;
replace_edge_with _ [] _	= [];

// delete an edge

private delete_edge;

del_edge G:Graph (N:Int,M:Int)	= insert G
				  (N, delete_edge (edge_infos INF) M|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

del_edge G:Graph (N:Int,M:Int|L)
				= insert G
				  (N, delete_edge (edge_infos INF) M|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

del_edge2 G:Graph (N:Int,N|L)	= del_edge G (N,N|L);
del_edge2 G:Graph (N:Int,M:Int|L)
				= del_edge (del_edge G (N,M|L)) (M,N|L);

delete_edge [E|EDGES] M		= EDGES if dest E=M;
delete_edge [E|EDGES] M		= [E|delete_edge EDGES M] otherwise;
delete_edge [] _		= [];

private delete_edge_with;

del_edge_with P G:Graph (N:Int,M:Int)
				= insert G
				  (N, delete_edge_with P (edge_infos INF) M|
				   labels INF)
				    where INF:Tuple = G!N;
				= G otherwise;

del_edge2_with P G:Graph (N:Int,N)
				= del_edge_with P G (N,N);
del_edge2_with P G:Graph (N:Int,M:Int)
				= del_edge_with P
				  (del_edge_with P G (N,M)) (M,N);

delete_edge_with P [E|EDGES] M	= EDGES if (dest E=M) and then P E;
delete_edge_with P [E|EDGES] M	= [E|delete_edge_with P EDGES M] otherwise;
delete_edge_with P [] _		= [];

/* Special operations. */

// reverse a graph

private revedge;

revgraph G:Graph		= graph (V,map revedge E)
				    where (V,E) = split_graph G;

revedge (S,T|L)			= (T,S|L);

// sort edges of a graph

private sort_edges, cmpedge;

sortgraph G:Graph		= graph (map sort_edges (adj_list G));

sort_edges (N,E|L)		= (N,sort cmpedge E|L);

cmpedge E1 E2			= dest E1<dest E2;

// extract a subgraph

private filter_edges, chkedge;

subgraph G:Graph U:List		= graph (map (filter_edges M)
					 (map (G!) (members M)))
				    where M = set U;

filter_edges M (N,E|L)		= (N,filter (chkedge M) E|L);
chkedge M E			= member M (dest E);

// disjoint union of two graphs

addgraph G1:Graph G2:Graph	= G1 if null G2;
				= G2 if null G1;
				= graph (adj_list G1++adj_list G2) otherwise
  where G2 = map_nodes (+(maxnode G1-minnode G2+1)) G2;

// non-disjoint union of two graphs

private chknode;

joingraph G1:Graph G2:Graph	= graph (V1++V2,E1++E2)
  where (V1,E1) = split_graph G1, (V2,E2) = split_graph G2,
    V2 = filter (chknode (set (nodes G2)-set (nodes G1))) V2;

chknode M N:Int			= member M N;
chknode M (N:Int|_)		= member M N;