For review: changes to graph.m

Thomas Charles CONWAY conway at cs.mu.oz.au
Tue Jun 3 14:18:54 AEST 1997


Hi

Warwick has given me the following changes to the support for graphs
in the library: graph.m becomes digraph.m, and graph.m is for undirected
graphs.

They have been substantially modified, so I am posting their complete
sources.
(the beginning of each file is marked by a row of `=')
-- 
ZZ:wq!
^X^C
Thomas Conway               				      conway at cs.mu.oz.au
AD DEUM ET VINUM	  			      Every sword has two edges.
================================================================================
%------------------------------------------------------------------------------%
% Copyright (C) 1995,1997 University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% File: digraph.m.
% Main author: conway.
% Additional author: warwick.
% Stability: low.
%
% This module defines a directed graph data type. The type digraph(N, A)
% stores information of type N in the nodes, and information of type A
% in the arcs.
%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- module digraph.

:- interface.
:- import_module assoc_list, set, std_util.

	% digraph(Node, Arc) represents a directed graph with information of
	% type Node associated with each node, and information of type Arc
	% associated with each arc.
:- type digraph(N, A).

:- type node(N).

:- type arc(A).

	% Lots of graphs don't need to store anything in the arcs so here's
	% a type equivalence that only has `real' information in the nodes.
:- type digraph(N)	== digraph(N, unit).

:- type arc		== arc(unit).

	% digraph__init(Graph) binds Graph to an empty graph
	% containing no nodes and no arcs. (The graph contains
	% a counter of the number of nodes allocated in it, so
	% it is possible for a graph to contain no nodes or arcs
	% and still fail to unify with the binding of Graph from
	% digraph__init.)
:- pred digraph__init(digraph(N, A)).
:- mode digraph__init(out) is det.

	% digraph__set_node(OldGraph, NodeInfo, Node, NewGraph) takes
	% OldGraph and NodeInfo which is the information to be stored
	% in a new node, and returns a key "Node" which refers to that
	% node, and the new graph NewGraph containing all of the nodes
	% and arcs in OldGraph as well as the new node.
	% It is possible to have two nodes in the graph with the
	% same information stored in them.
	%
	% This operation is O(lgN) for a graph containing N nodes.
:- pred digraph__set_node(digraph(N, A), N, node(N), digraph(N, A)).
:- mode digraph__set_node(in, in, out, out) is det.

	% digraph__insert_node/4 is the same as digraph__set_node/4 except
	% that if the information to be stored in the node is stored
	% in another node, then the digraph__insert_node/4 fails.
	%
	% This operation is O(N) for a graph containing N nodes since
	% this predicate has to check that the node data isn't in an
	% existing node.
:- pred digraph__insert_node(digraph(N, A), N, node(N), digraph(N, A)).
:- mode digraph__insert_node(in, in, out, out) is semidet.

	% digraph__det_insert_node/4 is like digraph__insert_node, except
	% that if the insertion would fail, it calls error/1.
:- pred digraph__det_insert_node(digraph(N, A), N, node(N), digraph(N, A)).
:- mode digraph__det_insert_node(in, in, out, out) is det.

	% digraph__update_node(OldGraph, Node, NodeInfo, NewGraph):
	% NewGraph is the result of taking OldGraph and replacing the
	% information stored in node Node with NodeInfo.  Fails if Node
	% does not exist in the graph.
:- pred digraph__update_node(digraph(N, A), node(N), N, digraph(N, A)).
:- mode digraph__update_node(in, in, in, out) is semidet.

	% digraph__det_update_node/4 is like digraph__update_node, except
	% that if the update would fail, it calls error/1.
:- pred digraph__det_update_node(digraph(N, A), node(N), N, digraph(N, A)).
:- mode digraph__det_update_node(in, in, in, out) is det.

	% digraph__search_node(Graph, NodeInfo, Node) nondeterministically
	% produces bindings of Node such that Node is a node in Graph
	% that has the information NodeInfo attatched to it.
	%
	% This operation is O(lgN) for the first solution for a graph
	% containing N nodes.
:- pred digraph__search_node(digraph(N, A), N, node(N)).
:- mode digraph__search_node(in, in, out) is nondet.

	% digraph__find_matching_nodes(Graph, NodeInfo, Nodes) takes a graph
	% Graph and the information NodeInfo and returns the set of nodes
	% Nodes which have the information NodeInfo stored in them. (The set
	% Nodes will of course be empty if there are no matching nodes.)
	%
	% This operation is O(NlgN) for a graph containing N nodes.
:- pred digraph__find_matching_nodes(digraph(N, A), N, set(node(N))).
:- mode digraph__find_matching_nodes(in, in, out) is det.

	% digraph__node_contents(Graph, Node, NodeInfo) takes Graph and
	% Node and returns the information NodeInfo stored in Node.
	%
	% This operation is O(lgN) for a graph containing N nodes.
:- pred digraph__node_contents(digraph(N, A), node(N), N).
:- mode digraph__node_contents(in, in, out) is det.

	% digraph__successors(Graph, Node, Nodes) takes a graph Graph and
	% a node Node and returns the set of nodes Nodes that are reachable
	% (directly - not transitively) from Node.
	%
	% This operation is O(NlgN) for a graph containing N nodes.
:- pred digraph__successors(digraph(N, A), node(N), set(node(N))).
:- mode digraph__successors(in, in, out) is det.

	% digraph__nodes(Graph, Nodes) binds Nodes to the set of nodes in Graph.
:- pred digraph__nodes(digraph(N, A), set(node(N))).
:- mode digraph__nodes(in, out) is det.

	% digraph__set_arc(OldGraph, Start, End, ArcInfo, Arc, NewGraph)
	% takes a graph OldGraph and adds an arc from Start to End with
	% the information ArcInfo stored in it, and returns a key for
	% that arc Arc, and the new graph NewGraph.
	% If an identical arc already exists then this operation has
	% no effect.
	%
	% This operation is O(lgN+lgM) for a graph with N nodes and M arcs.
:- pred digraph__set_arc(digraph(N, A), node(N), node(N), A,
						arc(A), digraph(N, A)).
:- mode digraph__set_arc(in, in, in, in, out, out) is det.

	% digraph__insert_arc/6 is the same as digraph__set_arc/6 except that
	% if an identical arc already exists in the graph the operation fails.
	% This is O(N) for a graph with N arcs between the two nodes.
:- pred digraph__insert_arc(digraph(N, A), node(N), node(N), A,
						arc(A), digraph(N, A)).
:- mode digraph__insert_arc(in, in, in, in, out, out) is semidet.

	% digraph__insert_arc/5 is like digraph__insert_arc/6,
	% except that it takes an existing arc key rather than arc info.
:- pred digraph__insert_arc(digraph(N, A), node(N), node(N),
						arc(A), digraph(N, A)).
:- mode digraph__insert_arc(in, in, in, in, out) is semidet.

	% digraph__det_insert_arc/6 is like digraph__insert_arc except
	% than instead of failing, it calls error/1.
:- pred digraph__det_insert_arc(digraph(N, A), node(N), node(N), A,
						arc(A), digraph(N, A)).
:- mode digraph__det_insert_arc(in, in, in, in, out, out) is det.

	% digraph__arc_nodes_from(Graph, Node, ArcNodes) takes a graph
	% Graph and a node Node and returns an association list of the
	% arcs and corresponding destination nodes that originate from
	% that node.
:- pred digraph__arc_nodes_from(digraph(N, A), node(N), assoc_list(arc(A), node(N))).
:- mode digraph__arc_nodes_from(in, in, out) is det.

	% digraph__arcs_from(Graph, Node, Arcs) takes a graph Graph and
	% a node Node and returns the set of arcs Arcs that originate
	% from that node.
:- pred digraph__arcs_from(digraph(N, A), node(N), set(arc(A))).
:- mode digraph__arcs_from(in, in, out) is det.

	% digraph__arc_contents(Graph, Arc, Start, End, ArcInfo) takes a
	% graph Graph and an arc Arc and returns the start and end nodes
	% and the information stored in that arc.
:- pred digraph__arc_contents(digraph(N, A), arc(A), node(N), node(N), A).
:- mode digraph__arc_contents(in, in, out, out, out) is det.

	% digraph__path(Graph, Start, End, Path) is true iff there is a path
	% from the node Start to the node End in Graph that goes through
	% the sequence of arcs Arcs.
	% The algorithm will return paths containing at most one cycle.
:- pred digraph__path(digraph(N, A), node(N), node(N), list(arc(A))).
:- mode digraph__path(in, in, in, out) is nondet.
:- mode digraph__path(in, in, out, out) is nondet.

	% digraph__dummy_node(Graph, Node) is true iff Node is the dummy node
	% for graph Graph.
:- pred digraph__dummy_node(digraph(N, A), node(N)).
:- mode digraph__dummy_node(in, out) is det.

	% digraph__dummy_arc(Graph, Arc) is true iff Arc is the dummy arc
	% for graph Graph.
:- pred digraph__dummy_arc(digraph(N, A), arc(A)).
:- mode digraph__dummy_arc(in, out) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module map, int, std_util, list.
:- import_module require.

:- type digraph(N, A)	--->
		digraph(
			digraph__node_supply,
			digraph__arc_supply,
			map(node(N), N),
			map(arc(A), arc_info(N, A)),
			map(node(N), map(arc(A), node(N)))
		).

:- type digraph__node_supply	==	int.

:- type digraph__arc_supply	==	int.

:- type node(N)			==	int.

:- type arc(A)			==	int.

:- type arc_info(N, A)	--->	arc_info(node(N), node(N), A).

%------------------------------------------------------------------------------%

digraph__init(Graph) :-
	Graph = digraph(0, 0, Nodes, Arcs, Edges),
	map__init(Nodes),
	map__init(Arcs),
	map__init(Edges).

%------------------------------------------------------------------------------%

digraph__set_node(G0, NInfo, N, G) :-
	digraph__get_node_supply(G0, NS0),
	NS is NS0 + 1,
	N = NS,
	digraph__set_node_supply(G0, NS, G1),

	digraph__get_nodes(G1, Nodes0),
	map__set(Nodes0, N, NInfo, Nodes),
	digraph__set_nodes(G1, Nodes, G2),

	digraph__get_edges(G2, Edges0),
	map__init(EdgeMap),
	map__set(Edges0, N, EdgeMap, Edges),
	digraph__set_edges(G2, Edges, G).

digraph__det_insert_node(G0, NInfo, N, G) :-
	(
		digraph__insert_node(G0, NInfo, N1, G1)
	->
		N = N1,
		G = G1
	;
		error("digraph__det_insert_node: node already exists.")
	).

digraph__insert_node(G0, NInfo, N, G) :-
		% Make sure that the graph doesn't contain
		% NInfo already.
	digraph__get_nodes(G0, Nodes0),
	\+ map__member(Nodes0, _, NInfo),

	digraph__get_node_supply(G0, NS0),
	NS is NS0 + 1,
	N = NS,
	digraph__set_node_supply(G0, NS, G1),

	digraph__get_nodes(G1, Nodes1),
	map__set(Nodes1, N, NInfo, Nodes),
	digraph__set_nodes(G1, Nodes, G2),

	digraph__get_edges(G2, Edges0),
	map__init(EdgeSet),
	map__set(Edges0, N, EdgeSet, Edges),
	digraph__set_edges(G2, Edges, G).

%------------------------------------------------------------------------------%

digraph__det_update_node(G0, N, NInfo, G) :-
	(
		digraph__update_node(G0, N, NInfo, G1)
	->
		G = G1
	;
		error("digraph__det_update_node: node does not exist.")
	).

digraph__update_node(G0, N, NInfo, G) :-
	digraph__get_nodes(G0, Nodes0),
	map__update(Nodes0, N, NInfo, Nodes),
	digraph__set_nodes(G0, Nodes, G).

%------------------------------------------------------------------------------%

digraph__search_node(Graph, NodeInfo, Node) :-
	digraph__get_nodes(Graph, NodeTable),
	map__member(NodeTable, Node, NodeInfo).

%------------------------------------------------------------------------------%

digraph__find_matching_nodes(Graph, NodeInfo, NodeSet) :-
	digraph__get_nodes(Graph, NodeTable),
%	SolnGoal = lambda([Node::out] is nondet,
%			map__member(NodeTable, Node, NodeInfo)),
%	solutions(SolnGoal, NodeList),
	solutions(digraph__select_node(NodeTable, NodeInfo), NodeList),
	set__sorted_list_to_set(NodeList, NodeSet).

:- pred digraph__select_node(map(node(N), N), N, node(N)).
:- mode digraph__select_node(in, in, out) is nondet.

digraph__select_node(NodeTable, NodeInfo, Node) :-
	map__member(NodeTable, Node, NodeInfo).

%------------------------------------------------------------------------------%

digraph__node_contents(G, N, I) :-
	digraph__get_nodes(G, Ns),
	( map__search(Ns, N, I0) ->
		I = I0
	;
		error("digraph__node_contents: invalid node id")
	).
	%map__lookup(Ns, N, I).

%------------------------------------------------------------------------------%

digraph__successors(G, N, Ss) :-
	digraph__get_edges(G, Es),
	map__lookup(Es, N, E),
	map__values(E, SsList),
	set__list_to_set(SsList, Ss).

%------------------------------------------------------------------------------%

digraph__nodes(G, Ns) :-
	digraph__get_nodes(G, Ns0),
	map__keys(Ns0, Ns1),
	set__list_to_set(Ns1, Ns).

%------------------------------------------------------------------------------%

digraph__set_arc(G0, Start, End, Info, Arc, G) :-
	digraph__get_arc_supply(G0, AS0),
	AS is AS0 + 1,
	Arc = AS,
	digraph__set_arc_supply(G0, AS, G1),

	digraph__get_arcs(G1, Arcs0),
	map__set(Arcs0, Arc, arc_info(Start, End, Info), Arcs),
	digraph__set_arcs(G1, Arcs, G2),

	digraph__get_edges(G2, Es0),
	map__lookup(Es0, Start, EdgeMap0),
	map__set(EdgeMap0, Arc, End, EdgeMap),
	map__set(Es0, Start, EdgeMap, Es),
	digraph__set_edges(G2, Es, G).

%------------------------------------------------------------------------------%

digraph__det_insert_arc(G0, Start, End, Info, Arc, G) :-
	(
		digraph__insert_arc(G0, Start, End, Info, Arc1, G1)
	->
		Arc = Arc1,
		G = G1
	;
		error("digraph__det_insert_arc: this arc is already in the graph.")
	).

digraph__insert_arc(G0, Start, End, Info, Arc, G) :-
	digraph__get_arc_supply(G0, AS0),
	AS is AS0 + 1,
	Arc = AS,
	digraph__set_arc_supply(G0, AS, G1),

	digraph__get_arcs(G1, Arcs0),
	map__insert(Arcs0, Arc, arc_info(Start, End, Info), Arcs),
	digraph__set_arcs(G1, Arcs, G2),

	digraph__insert_arc(G2, Start, End, Arc, G).

digraph__insert_arc(G0, Start, End, Arc, G) :-
	digraph__get_edges(G0, Es0),
	map__lookup(Es0, Start, EdgeMap0),
	map__insert(EdgeMap0, Arc, End, EdgeMap),
	map__set(Es0, Start, EdgeMap, Es),
	digraph__set_edges(G0, Es, G).

%------------------------------------------------------------------------------%

digraph__arc_nodes_from(G, N, ANs) :-
	digraph__get_edges(G, Es),
	map__lookup(Es, N, E),
	map__to_assoc_list(E, ANs).

%------------------------------------------------------------------------------%

digraph__arcs_from(G, N, As) :-
	digraph__get_edges(G, Es),
	map__lookup(Es, N, E),
	map__keys(E, AsList),
	set__list_to_set(AsList, As).

%------------------------------------------------------------------------------%

digraph__arc_contents(G, N, S, E, A) :-
	digraph__get_arcs(G, Ns),
	( map__search(Ns, N, I0) ->
		I = I0
	;
		error("digraph__arc_contents: invalid arc id")
	),
	%map__lookup(Ns, N, I),
	I = arc_info(S, E, A).

%------------------------------------------------------------------------------%

digraph__path(G, S, E, Path) :-
	digraph__path_2(G, S, E, [], Path).

:- pred digraph__path_2(digraph(N, A), node(N), node(N),
				list(node(N)), list(arc(A))).
:- mode digraph__path_2(in, in, in, in, out) is nondet.
:- mode digraph__path_2(in, in, out, in, out) is nondet.

digraph__path_2(G, S, E, Nodes0, Path) :-
	digraph__get_edges(G, Es),
	map__lookup(Es, S, Arcs),
	(
		map__member(Arcs, A, E),
		\+ list__member(E, Nodes0),
		Path = [A]
	;
		map__member(Arcs, A, N),
		\+ list__member(N, Nodes0),
		digraph__path_2(G, N, E, [N|Nodes0], Path0),
		Path = [A|Path0]
	).

%------------------------------------------------------------------------------%

digraph__dummy_node(_G, -1).

%------------------------------------------------------------------------------%

digraph__dummy_arc(_G, -1).

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- pred digraph__get_node_supply(digraph(N, A), digraph__node_supply).
:- mode digraph__get_node_supply(in, out) is det.

digraph__get_node_supply(G, NS) :-
	G = digraph(NS, _AS, _N, _A, _E).

:- pred digraph__get_arc_supply(digraph(N, A), digraph__arc_supply).
:- mode digraph__get_arc_supply(in, out) is det.

digraph__get_arc_supply(G, AS) :-
	G = digraph(_NS, AS, _N, _A, _E).

:- pred digraph__get_nodes(digraph(N, A), map(node(N), N)).
:- mode digraph__get_nodes(in, out) is det.

digraph__get_nodes(G, N) :-
	G = digraph(_NS, _AS, N, _A, _E).

:- pred digraph__get_arcs(digraph(N, A), map(arc(A), arc_info(N, A))).
:- mode digraph__get_arcs(in, out) is det.

digraph__get_arcs(G, A) :-
	G = digraph(_NS, _AS, _N, A, _E).

:- pred digraph__get_edges(digraph(N, A), map(node(N), map(arc(A), node(N)))).
:- mode digraph__get_edges(in, out) is det.

digraph__get_edges(G, E) :-
	G = digraph(_NS, _AS, _N, _A, E).

:- pred digraph__set_node_supply(digraph(N, A), digraph__node_supply, digraph(N, A)).
:- mode digraph__set_node_supply(in, in, out) is det.

digraph__set_node_supply(G0, NS, G) :-
	G0 = digraph(_, AS, N, A, E),
	G = digraph(NS, AS, N, A, E).

:- pred digraph__set_arc_supply(digraph(N, A), digraph__arc_supply, digraph(N, A)).
:- mode digraph__set_arc_supply(in, in, out) is det.

digraph__set_arc_supply(G0, AS, G) :-
	G0 = digraph(NS, _, N, A, E),
	G = digraph(NS, AS, N, A, E).

:- pred digraph__set_nodes(digraph(N, A), map(node(N), N), digraph(N, A)).
:- mode digraph__set_nodes(in, in, out) is det.

digraph__set_nodes(G0, N, G) :-
	G0 = digraph(NS, AS, _, A, E),
	G = digraph(NS, AS, N, A, E).

:- pred digraph__set_arcs(digraph(N, A), map(arc(A), arc_info(N, A)), digraph(N, A)).
:- mode digraph__set_arcs(in, in, out) is det.

digraph__set_arcs(G0, A, G) :-
	G0 = digraph(NS, AS, N, _, E),
	G = digraph(NS, AS, N, A, E).

:- pred digraph__set_edges(digraph(N, A), map(node(N), map(arc(A), node(N))), digraph(N, A)).
:- mode digraph__set_edges(in, in, out) is det.

digraph__set_edges(G0, E, G) :-
	G0 = digraph(NS, AS, N, A, _),
	G = digraph(NS, AS, N, A, E).

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
================================================================================
%------------------------------------------------------------------------------%
% Copyright (C) 1995,1997 University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% File: graph.m.
% Main author: conway, warwick.
% Stability: low.
%
% This module defines an undirected graph data type. The type graph(N, E)
% stores information of type N in the nodes, and information of type E
% in the edges.
%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- module graph.

:- interface.
:- import_module digraph, set, std_util.

	% graph(Node, Edge) represents an undirected graph with information of
	% type Node associated with each node, and information of type Edge
	% associated with each edge.
:- type graph(N, E).

%:- type node(N).

:- type edge(E)		== arc(E).

	% Lots of graphs don't need to store anything in the edges so here's
	% a type equivalence that only has `real' information in the nodes.
:- type graph(N)	== graph(N, unit).

:- type edge		== edge(unit).

	% graph__init(Graph) binds Graph to an empty graph
	% containing no nodes and no edges. (The graph contains
	% a counter of the number of nodes allocated in it, so
	% it is possible for a graph to contain no nodes or edges
	% and still fail to unify with the binding of Graph from
	% graph__init.)
:- pred graph__init(graph(N, E)).
:- mode graph__init(out) is det.

	% graph__set_node(OldGraph, NodeInfo, Node, NewGraph) takes
	% OldGraph and NodeInfo which is the information to be stored
	% in a new node, and returns a key "Node" which refers to that
	% node, and the new graph NewGraph containing all of the nodes
	% and edges in OldGraph as well as the new node.
	% It is possible to have two nodes in the graph with the
	% same information stored in them.
	%
	% This operation is O(lgN) for a graph containing N nodes.
:- pred graph__set_node(graph(N, E), N, node(N), graph(N, E)).
:- mode graph__set_node(in, in, out, out) is det.

	% graph__insert_node/4 is the same as graph__set_node/4 except
	% that if the information to be stored in the node is stored
	% in another node, then the graph__insert_node/4 fails.
	%
	% This operation is O(N) for a graph containing N nodes since
	% this predicate has to check that the node data isn't in an
	% existing node.
:- pred graph__insert_node(graph(N, E), N, node(N), graph(N, E)).
:- mode graph__insert_node(in, in, out, out) is semidet.

	% graph__det_insert_node/4 is like graph__insert_node, except
	% that if the insertion would fail, it calls error/1.
:- pred graph__det_insert_node(graph(N, E), N, node(N), graph(N, E)).
:- mode graph__det_insert_node(in, in, out, out) is det.

	% graph__update_node(OldGraph, Node, NodeInfo, NewGraph):
	% NewGraph is the result of taking OldGraph and replacing the
	% information stored in node Node with NodeInfo.  Fails if Node
	% does not exist in the graph.
:- pred graph__update_node(graph(N, A), node(N), N, graph(N, A)).
:- mode graph__update_node(in, in, in, out) is semidet.

	% graph__det_update_node/4 is like graph__update_node, except
	% that if the update would fail, it calls error/1.
:- pred graph__det_update_node(graph(N, A), node(N), N, graph(N, A)).
:- mode graph__det_update_node(in, in, in, out) is det.

	% graph__search_node(Graph, NodeInfo, Node) nondeterministically
	% produces bindings of Node such that Node is a node in Graph
	% that has the information NodeInfo attatched to it.
	%
	% This operation is O(lgN) for the first solution for a graph
	% containing N nodes.
:- pred graph__search_node(graph(N, E), N, node(N)).
:- mode graph__search_node(in, in, out) is nondet.

	% graph__find_matching_nodes(Graph, NodeInfo, Nodes) takes a graph
	% Graph and the information NodeInfo and returns the set of nodes
	% Nodes which have the information NodeInfo stored in them. (The set
	% Nodes will of course be empty if there are no matching nodes.)
	%
	% This operation is O(NlgN) for a graph containing N nodes.
:- pred graph__find_matching_nodes(graph(N, E), N, set(node(N))).
:- mode graph__find_matching_nodes(in, in, out) is det.

	% graph__node_contents(Graph, Node, NodeInfo) takes Graph and
	% Node and returns the information NodeInfo stored in Node.
	%
	% This operation is O(lgN) for a graph containing N nodes.
:- pred graph__node_contents(graph(N, E), node(N), N).
:- mode graph__node_contents(in, in, out) is det.

	% graph__adjacent_nodes(Graph, Node, Nodes) takes a graph Graph and
	% a node Node and returns the set of nodes Nodes that are adjacent
	% to Node.
	%
	% This operation is O(NlgN) for a graph containing N nodes.
:- pred graph__adjacent_nodes(graph(N, E), node(N), set(node(N))).
:- mode graph__adjacent_nodes(in, in, out) is det.

	% graph__nodes(Graph, Nodes) binds Nodes to the set of nodes in Graph.
:- pred graph__nodes(graph(N, E), set(node(N))).
:- mode graph__nodes(in, out) is det.

	% graph__set_edge(OldGraph, Start, End, EdgeInfo, Edge, NewGraph)
	% takes a graph OldGraph and adds an edge from Start to End with
	% the information EdgeInfo stored in it, and returns a key for
	% that edge Edge, and the new graph NewGraph.
	% If an identical edge already exists then this operation has
	% no effect.
	%
	% This operation is O(lgN+lgM) for a graph with N nodes and M edges.
:- pred graph__set_edge(graph(N, E), node(N), node(N), E,
						edge(E), graph(N, E)).
:- mode graph__set_edge(in, in, in, in, out, out) is det.

	% graph__insert_edge/6 is the same as graph__set_edge/6 except that
	% if an identical edge already exists in the graph the operation fails.
	% This is O(N) for a graph with N edges between the two nodes.
:- pred graph__insert_edge(graph(N, E), node(N), node(N), E,
						edge(E), graph(N, E)).
:- mode graph__insert_edge(in, in, in, in, out, out) is semidet.

	% graph__det_insert_edge/6 is like graph__insert_edge except
	% than instead of failing, it calls error/1.
:- pred graph__det_insert_edge(graph(N, E), node(N), node(N), E,
						edge(E), graph(N, E)).
:- mode graph__det_insert_edge(in, in, in, in, out, out) is det.

	% graph__incident(Graph, Node, EdgeNodes) takes a graph Graph and
	% a node Node and returns an association list of the edges and
	% corresponding nodes that are incident to that node.
:- pred graph__incident(graph(N, E), node(N), assoc_list(edge(E), node(N))).
:- mode graph__incident(in, in, out) is det.

	% graph__incident_edges(Graph, Node, Edges) takes a graph Graph and
	% a node Node and returns the set of edges Edges that are incident
	% to that node.
:- pred graph__incident_edges(graph(N, E), node(N), set(edge(E))).
:- mode graph__incident_edges(in, in, out) is det.

	% graph__edge_contents(Graph, Edge, Start, End, EdgeInfo) takes a
	% graph Graph and an edge Edge and returns the start and end nodes
	% and the information stored in that edge.
:- pred graph__edge_contents(graph(N, E), edge(E), node(N), node(N), E).
:- mode graph__edge_contents(in, in, out, out, out) is det.

/*
	% graph__path(Graph, Start, End, Path) is true iff there is a path
	% from the node Start to the node End in Graph that goes through
	% the sequence of edges Edges.
	% The algorithm will return paths containing at most one cycle.
:- pred graph__path(graph(N, E), node(N), node(N), list(edge(E))).
:- mode graph__path(in, in, in, out) is nondet.
:- mode graph__path(in, in, out, out) is nondet.
*/

	% graph__dummy_node(Graph, Node) is true iff Node is the dummy node
	% for graph Graph.
:- pred graph__dummy_node(graph(N, A), node(N)).
:- mode graph__dummy_node(in, out) is det.
:- mode graph__dummy_node(in, in) is semidet.

	% graph__dummy_edge(Graph, Edge) is true iff Edge is the dummy edge
	% for graph Graph.
:- pred graph__dummy_edge(graph(N, A), edge(A)).
:- mode graph__dummy_edge(in, out) is det.

	% graph__dfs_pred(Node, Edge, World) is the type of a predicate
	% used for enter/leave/revisit in a depth-first search of a graph
	% with type graph(Node, Edge), passing a state of type World.
:- type graph__dfs_pred(N, E, W) == pred(graph(N, E), node(N), edge(E), node(N), W, W).
	% graph__dfs_mode is the mode for a graph__dfs_pred.
:- mode graph__dfs_mode :: pred(in, in, in, in, in, out) is det.

	% graph__dfs(Graph, Node, Enter, Leave, Revisit, World0, World)
	% performs a depth-first search of graph Graph, starting at node Node,
	% calling predicate Enter when it first visits a node, Leave when it
	% (last) leaves a node, Revisit when it visits a node already visited,
	% and threads the state World through all these calls.
:- pred graph__dfs(graph(N, E), node(N), graph__dfs_pred(N, E, W), graph__dfs_pred(N, E, W), graph__dfs_pred(N, E, W), W, W).
:- mode graph__dfs(in, in, graph__dfs_mode, graph__dfs_mode, graph__dfs_mode, in, out) is det.

	% graph__dfs_null is a do-nothing predicate which can be passed to
	% graph__dfs when there is nothing to do for enter, leave, or revisit.
:- pred graph__dfs_null(_, _, _, _, T, T).
:- mode graph__dfs_null(in, in, in, in, in, out) is det.

	% graph__connected_components(Graph, ComponentSet) takes a graph
	% Graph, and returns the set of all connected components ComponentSet
	% (where each component is represented as a set of nodes).
:- pred graph__connected_components(graph(N, E), set(set(node(N)))).
:- mode graph__connected_components(in, out) is det.

	% graph__biconnected_components(Graph, Root, CutNodes, BiGraph, BiRoot)
	% finds the biconnected components of a connected graph Graph,
	% starting at node Root.  BiGraph is an acyclic graph (tree) of the
	% resulting components, with nodes of BiGraph containing the set of
	% nodes for the corresponding component of Graph.  Edges in BiGraph
	% are labelled with the ``cut'' or ``articulation'' node in common
	% between the joined nodes.  Note, however, that if three or more
	% biconnected components share a common cut node, then there is not
	% an edge between every pair of components; instead, one (the first
	% encountered) is treated as the ``parent'', and the rest are
	% connected only to it.  BiRoot is the ``root'' of BiGraph (treating
	% it like a tree), and is the component containing the original node
	% Root.  The cut nodes are also collected and placed in CutNodes.
	% Note that this predicate perhaps stretches the definition of
	% biconnected a little, in that it treats two nodes with a single
	% edge between them and no other path connecting them as biconnected.
:- pred graph__biconnected_components(graph(N, E), node(N), set(node(N)), graph(set(node(N)), node(N)), node(set(node(N)))).
:- mode graph__biconnected_components(in, in, out, out, out) is det.

	% graph__biconnected_components(Graph, CutNodes, BiGraph, BiRoot) is
	% the same as graph__biconnected_components/5, except that no root
	% node is specified as a starting point for the search.
:- pred graph__biconnected_components(graph(N, E), set(node(N)), graph(set(node(N)), node(N)), node(set(node(N)))).
:- mode graph__biconnected_components(in, out, out, out) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module assoc_list, map, int, std_util, list, string.
:- import_module require.

:- type graph(N, E)	== digraph(N, E).

%------------------------------------------------------------------------------%

graph__init(Graph) :-
	digraph__init(Graph).

%------------------------------------------------------------------------------%

graph__set_node(G0, NInfo, N, G) :-
	digraph__set_node(G0, NInfo, N, G).

graph__det_insert_node(G0, NInfo, N, G) :-
	(
		graph__insert_node(G0, NInfo, N1, G1)
	->
		N = N1,
		G = G1
	;
		error("digraph__det_insert_node: node already exists.")
	).

graph__insert_node(G0, NInfo, N, G) :-
	digraph__insert_node(G0, NInfo, N, G).

%------------------------------------------------------------------------------%

graph__det_update_node(G0, NInfo, N, G) :-
	(
		graph__update_node(G0, NInfo, N, G1)
	->
		G = G1
	;
		error("digraph__det_update_node: node doesn't exist.")
	).

graph__update_node(G0, NInfo, N, G) :-
	digraph__update_node(G0, NInfo, N, G).

%------------------------------------------------------------------------------%

graph__search_node(Graph, NodeInfo, Node) :-
	digraph__search_node(Graph, NodeInfo, Node).

%------------------------------------------------------------------------------%

graph__find_matching_nodes(Graph, NodeInfo, NodeSet) :-
	digraph__find_matching_nodes(Graph, NodeInfo, NodeSet).

%------------------------------------------------------------------------------%

graph__node_contents(G, N, I) :-
	digraph__node_contents(G, N, I).

%------------------------------------------------------------------------------%

graph__adjacent_nodes(G, N, Ns) :-
	digraph__successors(G, N, Ns).

%------------------------------------------------------------------------------%

graph__nodes(G, Ns) :-
	digraph__nodes(G, Ns).

%------------------------------------------------------------------------------%

graph__set_edge(G0, Start, End, Info, Edge, G) :-
	digraph__set_arc(G0, Start, End, Info, Edge, G1),
	(
		digraph__insert_arc(G1, End, Start, Edge, G2)
	->
		G = G2
	;
		G = G1
	).

%------------------------------------------------------------------------------%

graph__det_insert_edge(G0, Start, End, Info, Edge, G) :-
	(
		graph__insert_edge(G0, Start, End, Info, Edge1, G1)
	->
		Edge = Edge1,
		G = G1
	;
		error("graph__det_insert_edge: this edge is already in the graph.")
	).

graph__insert_edge(G0, Start, End, Info, Edge, G) :-
	digraph__insert_arc(G0, Start, End, Info, Edge, G1),
	digraph__insert_arc(G1, End, Start, Edge, G).

%------------------------------------------------------------------------------%

graph__incident(G, N, ENs) :-
	digraph__arc_nodes_from(G, N, ENs).

%------------------------------------------------------------------------------%

graph__incident_edges(G, N, Es) :-
	digraph__arcs_from(G, N, Es).

%------------------------------------------------------------------------------%

graph__edge_contents(G, Edge, S, E, I) :-
	digraph__arc_contents(G, Edge, S, E, I).

%------------------------------------------------------------------------------%

graph__connected_components(G, CCs) :-
	graph__nodes(G, Ns),
	set__init(CCs0),
	graph__connected_components_2(G, Ns, CCs0, CCs).

:- pred graph__connected_components_2(graph(N, E), set(node(N)), set(set(node(N))), set(set(node(N)))).
:- mode graph__connected_components_2(in, in, in, out) is det.

graph__connected_components_2(G, Ns, CCs0, CCs) :-
	(
		set__remove_least(Ns, N, Ns1)
	->
		graph__reachable_from(G, N, CC),
		set__insert(CCs0, CC, CCs1),
		set__difference(Ns1, CC, Ns2),
		graph__connected_components_2(G, Ns2, CCs1, CCs)
	;
		CCs = CCs0
	).

	% Returns the set of nodes reachable from a given node
	% (i.e. returns the connected component containing the given node)
:- pred graph__reachable_from(graph(N, E), node(N), set(node(N))).
:- mode graph__reachable_from(in, in, out) is det.

graph__reachable_from(G, N, Ns) :-
	set__init(Ns0),
	graph__dfs(G, N, graph__dfs_null, graph__dfs_set_insert, graph__dfs_null, Ns0, Ns).

:- pred graph__dfs_set_insert(G, Elem, N, Elem, set(Elem), set(Elem)).
:- mode graph__dfs_set_insert(in, in, in, in, in, out) is det.

graph__dfs_set_insert(_, Elem, _, _, Set0, Set) :-
	set__insert(Set0, Elem, Set).

%------------------------------------------------------------------------------%

:- type binode(N) == node(set(node(N))).

	% Returns a graph of the biconnected components, with
	% the edges labelled with the corresponding cut points.

graph__biconnected_components(G, CutSet, Graph, Root) :-
	graph__nodes(G, Ns),
	(
		set__remove_least(Ns, N, _)
	->
		graph__biconnected_components(G, N, CutSet, Graph, Root)
	;
		set__init(CutSet),
		graph__init(Graph),
		graph__dummy_node(Graph, Root)
	).

graph__biconnected_components(G, N, CutSet, Graph, Root) :-
	map__init(VMap0),
	map__init(LowMap0),
	graph__incident_edges(G, N, EdgeSet),
	set__to_sorted_list(EdgeSet, EdgeList),
	list__length(EdgeList, RootRem0),
	map__init(CompMap0),
	map__init(AdjMap0),
	set__init(CutSet0),
	graph__init(Graph0),
	graph__dummy_node(Graph0, Root0),
	graph__dfs(G, N, graph__bi_visit, graph__bi_leave, graph__bi_revisit, bi(1, VMap0, LowMap0, RootRem0, CompMap0, AdjMap0, Root0, CutSet0, Graph0), bi(_, _, _, _, _, _, Root, CutSet, Graph)).

	% The "world" data type used to find biconnected components.
	% Should really have set up access predicates for this data.
:- type bidata(N, E) --->
	bi(
		int,				% Id for next node processed
		map(node(N), int),	% Maps nodes to Ids
		map(node(N), int),	% Maps nodes to Low values
		int,				% # unexplored root edges
		map(node(N), set(node(N))),	% Maps nodes to partial component
		% Maps nodes to the ids of "Child" components in the component graph
		map(node(N), set(pair(node(N), node(set(node(N)))))),
		node(set(node(N))),				% Root of component graph
		set(node(N)),					% Set of cut points
		graph(set(node(N)), node(N))	% Graph of components
	).

	% Visit a node for the first time.
:- pred graph__bi_visit(graph(N, E), node(N), edge(E), node(N), bidata(N, E), bidata(N, E)).
:- mode graph__bi_visit(in, in, in, in, in, out) is det.

graph__bi_visit(_G, N, _E, _N0,
		bi(Num0, VMap0, LowMap0, RootRem0, CompMap0, AdjMap0, Root0, CutSet0, Graph0),
		bi(Num, VMap, LowMap, RootRem, CompMap, AdjMap, Root, CutSet, Graph)
	) :-
	Num = Num0 + 1,
	map__det_insert(VMap0, N, Num0, VMap),
	map__det_insert(LowMap0, N, Num0, LowMap),
	RootRem = RootRem0,
	set__singleton_set(CompSet0, N),
	map__det_insert(CompMap0, N, CompSet0, CompMap),
	set__init(AdjSet0),
	map__det_insert(AdjMap0, N, AdjSet0, AdjMap),
	Root = Root0,
	CutSet = CutSet0,
	Graph = Graph0.

	% Revisit a node.
:- pred graph__bi_revisit(graph(N, E), node(N), edge(E), node(N), bidata(N, E), bidata(N, E)).
:- mode graph__bi_revisit(in, in, in, in, in, out) is det.

graph__bi_revisit(_G, N, _E, N0,
		bi(Num0, VMap0, LowMap0, RootRem0, CompMap0, AdjMap0, Root0, CutSet0, Graph0),
		bi(Num, VMap, LowMap, RootRem, CompMap, AdjMap, Root, CutSet, Graph)
	) :-
	% Update Low(N0) if necessary
	map__lookup(VMap0, N, V),
	map__lookup(LowMap0, N0, Low0),
	(
		V < Low0
	->
		map__det_update(LowMap0, N0, V, LowMap)
	;
		LowMap = LowMap0
	),
	% If N is the root node, update # unexplored root edges
	(
		V = 1
	->
		RootRem = RootRem0 - 1
	;
		RootRem = RootRem0
	),
	Num = Num0,
	VMap = VMap0,
	CompMap = CompMap0,
	AdjMap = AdjMap0,
	Root = Root0,
	CutSet = CutSet0,
	Graph = Graph0.

:- pred graph__bi_insert_edges(
			graph(set(node(N)), node(N)),
			node(set(node(N))),
			list(pair(node(N), node(set(node(N))))),
			graph(set(node(N)), node(N))
		).
:- mode graph__bi_insert_edges(in, in, in, out) is det.

graph__bi_insert_edges(Graph, _Node1, [], Graph).
graph__bi_insert_edges(Graph0, Node1, [(EdgeInfo - Node2) | Tail], Graph) :-
	graph__set_edge(Graph0, Node1, Node2, EdgeInfo, _Edge, Graph1),
	graph__bi_insert_edges(Graph1, Node1, Tail, Graph).

	% Leave a node for the last time.
:- pred graph__bi_leave(graph(N, E), node(N), edge(E), node(N), bidata(N, E), bidata(N, E)).
:- mode graph__bi_leave(in, in, in, in, in, out) is det.

graph__bi_leave(G, N, E, N0,
		bi(Num0, VMap0, LowMap0, RootRem0, CompMap0, AdjMap0, Root0, CutSet0, Graph0),
		bi(Num, VMap, LowMap, RootRem, CompMap, AdjMap, Root, CutSet, Graph)
	) :-
	(
		graph__dummy_edge(G, E)
	->
		% N is the root node
		% Add newly completed component to the component graph
		map__lookup(CompMap0, N, Comp),
		graph__set_node(Graph0, Comp, CompNode, Graph1),
		% Add edges to existing adjacent components
		map__lookup(AdjMap0, N, AdjSet),
		set__to_sorted_list(AdjSet, AdjList),
		graph__bi_insert_edges(Graph1, CompNode, AdjList, Graph),
		Root = CompNode,
		CutSet = CutSet0,
		% Like we really care now...
		LowMap = LowMap0,
		CompMap = CompMap0,
		AdjMap = AdjMap0
	;
		% Check for N0 being a cut point
		map__lookup(VMap0, N0, V0),
		map__lookup(LowMap0, N, Low),
		(
			(
				V0 = 1
			->
				RootRem0 > 0
			;
				Low >= V0
			)
		->
			% N0 is a cut point
			set__insert(CutSet0, N0, CutSet),
			% Add newly completed component to the component graph
			map__lookup(CompMap0, N, Comp),
			set__insert(Comp, N0, Comp1),
			graph__set_node(Graph0, Comp1, CompNode, Graph1),
			% Add edges to existing adjacent components
			map__lookup(AdjMap0, N, AdjSet),
			set__to_sorted_list(AdjSet, AdjList),
			graph__bi_insert_edges(Graph1, CompNode, AdjList, Graph),
			% Add new component as adjacent to parent component
			map__lookup(AdjMap0, N0, AdjSet0),
			set__insert(AdjSet0, (N0 - CompNode), AdjSet0a),
			map__det_update(AdjMap0, N0, AdjSet0a, AdjMap),
			% Don't update parent's partial component
			CompMap = CompMap0
		;
			% Merge component collected so far with parent's collection
			map__lookup(CompMap0, N, Comp),
			map__lookup(CompMap0, N0, Comp0),
			set__union(Comp0, Comp, Comp0a),
			map__det_update(CompMap0, N0, Comp0a, CompMap),
			% Merge adjacent component collection with parent's
			map__lookup(AdjMap0, N, Adj),
			map__lookup(AdjMap0, N0, Adj0),
			set__union(Adj0, Adj, Adj0a),
			map__det_update(AdjMap0, N0, Adj0a, AdjMap),
			% Cut set and component graph unchanged
			CutSet = CutSet0,
			Graph = Graph0
		),
		% Update Low(N0) if necessary
		map__lookup(LowMap0, N0, Low0),
		(
			Low < Low0
		->
			map__det_update(LowMap0, N0, Low, LowMap)
		;
			LowMap = LowMap0
		),
		Root = Root0
	),
	RootRem = RootRem0,
	Num = Num0,
	VMap = VMap0.

%------------------------------------------------------------------------------%

graph__dfs_null(_, _, _, _, World, World).

graph__dfs(G, Node, Enter, Leave, Revisit, World0, World) :-
	set__init(Visit0),
	graph__dummy_edge(G, DummyEdge),
	graph__dummy_node(G, DummyNode),
	graph__dfs_1([(DummyEdge - Node)], G, DummyNode, Enter, Leave, Revisit, Visit0, _, World0, World).

:- pred graph__dfs_1(
			assoc_list(edge(E), node(N)),
			graph(N, E),
			node(N),
			graph__dfs_pred(N, E, W),
			graph__dfs_pred(N, E, W),
			graph__dfs_pred(N, E, W),
			set(node(N)), set(node(N)),
			W, W
		).
:- mode graph__dfs_1(in, in, in, graph__dfs_mode, graph__dfs_mode, graph__dfs_mode, in, out, in, out) is det.

graph__dfs_1([], _G, _N, _Enter, _Leave, _Revisit, Visit, Visit, World, World).
graph__dfs_1([(Edge - Node) | ENList], G, N, Enter, Leave, Revisit, Visit0, Visit, World0, World) :-
	(
		set__member(Node, Visit0)
	->
		call(Revisit, G, Node, Edge, N, World0, World1),
		graph__dfs_1(ENList, G, N, Enter, Leave, Revisit, Visit0, Visit, World1, World)
	;
		call(Enter, G, Node, Edge, N, World0, World1),
		graph__incident(G, Node, AdjList0),
		AdjList = AdjList0,
		set__insert(Visit0, Node, Visit1),
		% Visit children
		graph__dfs_1(AdjList, G, Node, Enter, Leave, Revisit, Visit1, Visit2, World1, World2),
		call(Leave, G, Node, Edge, N, World2, World3),
		graph__dfs_1(ENList, G, N, Enter, Leave, Revisit, Visit2, Visit, World3, World)
	).

%------------------------------------------------------------------------------%

/*
graph__path(G, S, E, Path) :-
	graph__path_2(G, S, E, [], Path).

:- pred graph__path_2(graph(N, E), node(N), node(N),
				list(node(N)), list(edge(E))).
:- mode graph__path_2(in, in, in, in, out) is nondet.
:- mode graph__path_2(in, in, out, in, out) is nondet.

graph__path_2(G, S, E, Nodes0, Path) :-
	graph__get_edges(G, Es),
	map__lookup(Es, S, Edges),
	(
		map__member(Edges, E, E),
		\+ list__member(E, Nodes0),
		Path = [E]
	;
		map__member(Edges, E, N),
		\+ list__member(N, Nodes0),
		graph__path_2(G, N, E, [N|Nodes0], Path0),
		Path = [E|Path0]
	).
*/

%------------------------------------------------------------------------------%

graph__dummy_node(G, N) :-
	digraph__dummy_node(G, N).

%------------------------------------------------------------------------------%

graph__dummy_edge(G, E) :-
	digraph__dummy_arc(G, E).

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%



More information about the developers mailing list