A.23 library( ugraphs ): Unweighted Graphs

Authors: Richard O'Keefe & Vitor Santos Costa
Implementation and documentation are copied from YAP 5.0.1. The library(ugraph) library is based on code originally written by Richard O'Keefe. The code was then extended to be compatible with the SICStus Prolog ugraphs library. Code and documentation have been cleaned and style has been changed to be more in line with the rest of SWI-Prolog.

The ugraphs library was originally released in the public domain. YAP is convered by the Perl artistic license, which does not imply further restrictions on the SWI-Prolog LGPL license.

The routines assume directed graphs, undirected graphs may be implemented by using two edges.

Originally graphs where represented in two formats. The SICStus library and this version of library(ugraphs.pl) only uses the S-representation. The S-representation of a graph is a list of (vertex-neighbors) pairs, where the pairs are in standard order (as produced by keysort) and the neighbors of each vertex are also in standard order (as produced by sort). This form is convenient for many calculations. Each vertex appears in the S-representation, also if it has no neighbors.

vertices_edges_to_ugraph(+Vertices, +Edges, -Graph)
Given a graph with a set of Vertices and a set of Edges, Graph must unify with the corresponding S-representation. Note that the vertices without edges will appear in Vertices but not in Edges. Moreover, it is sufficient for a vertice to appear in Edges.
?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]

In this case all vertices are defined implicitly. The next example shows three unconnected vertices:

?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5], L).
L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[], 6-[], 7-[], 8-[]] ? 
vertices(+Graph, -Vertices)
Unify Vertices with all vertices appearing in graph Graph. Example:
?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
L = [1, 2, 3, 4, 5]
edges(+Graph, -Edges)
Unify Edges with all edges appearing in Graph. In the next example:
?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
L = [1-3, 1-5, 2-4, 4-5]
add_vertices(+Graph, +Vertices, -NewGraph)
Unify NewGraph with a new graph obtained by adding the list of Vertices to the Graph. Example:
?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
NG = [0-[], 1-[3,5], 2-[], 9-[]]
del_vertices(+Graph, +Vertices, -NewGraph)
Unify NewGraph with a new graph obtained by deleting the list of Vertices and all the edges that start from or go to a vertex in Vertices to the Graph. Example:
?- del_vertices([2,1],
                [1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
                NL).
NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
add_edges(+Graph, +Edges, -NewGraph)
Unify NewGraph with a new graph obtained by adding the list of edges Edges to the graph Graph. Example:
?- add_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
             [1-6,2-3,3-2,5-7,3-2,4-5],
             NL).
NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5], 5-[7], 6-[], 7-[], 8-[]]
del_edges(+Graph, +Edges, -NewGraph)
Unify NewGraph with a new graph obtained by removing the list of Edges from the Graph. Notice that no vertices are deleted. In the next example:
?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
             [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
             NL).
NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
transpose(+Graph, -NewGraph)
Unify NewGraph with a new graph obtained from Graph by replacing all edges of the form V1-V2 by edges of the form V2-V1. The cost is O(|V|^2). Notice that an undirected graph is its own transpose. Example:
?- transpose([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]], NL).
NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
neighbours(+Vertex, +Graph, -Vertices)
Unify Vertices with the list of neighbours of vertex Vertex in Graph. Example:
?- neighbours(4,[1-[3,5],2-[4],3-[],
                 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
NL = [1,2,7,5]
neighbors(+Vertex, +Graph, -Vertices)
American version of neighbours/3.
complement(+Graph, -NewGraph)
Unify NewGraph with the graph complementary to Graph. Example:
?- complement([1-[3,5],2-[4],3-[],
               4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
      4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
      7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
compose(+LeftGraph, +RightGraph, -NewGraph)
Compose, by connecting the drains of LeftGraph to the sources of RightGraph. Example:
?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
L = [1-[4], 2-[1,2,4], 3-[]]
ugraph_union(+Graph1, +Graph2, -NewGraph)
NewGraph is the union of Graph1 and Graph2. Example:
?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
L = [1-[2], 2-[3,4], 3-[1,2,4]]
top_sort(+Graph, -Sort)
Generate the set of nodes Sort as a topological sorting of graph Graph, if one is possible. A toplogical sort is possible if the graph is connected and acyclic. In the example we show how topological sorting works for a linear graph:
?- top_sort([1-[2], 2-[3], 3-[]], L).
L = [1, 2, 3]
top_sort(+Graph, -Sort0, -Sort)
Generate the difference list Sort-Sort0 as a topological sorting of graph Graph, if one is possible.
transitive_closure(+Graph, -Closure)
Generate the graph Closure as the transitive closure of graph Graph. Example:
 ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
reachable(+Vertex, +Graph, -Vertices)
Unify Vertices with the set of all vertices in graph Graph that are reachable from Vertex. Example:
?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
V = [1, 3, 5]