1/* Part of SWI-Prolog 2 3 Author: R.A.O'Keefe, Vitor Santos Costa, Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 1984-2023, VU University Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions .b.v 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(ugraphs, 38 [ add_edges/3, % +Graph, +Edges, -NewGraph 39 add_vertices/3, % +Graph, +Vertices, -NewGraph 40 complement/2, % +Graph, -NewGraph 41 compose/3, % +LeftGraph, +RightGraph, -NewGraph 42 del_edges/3, % +Graph, +Edges, -NewGraph 43 del_vertices/3, % +Graph, +Vertices, -NewGraph 44 edges/2, % +Graph, -Edges 45 neighbors/3, % +Vertex, +Graph, -Vertices 46 neighbours/3, % +Vertex, +Graph, -Vertices 47 reachable/3, % +Vertex, +Graph, -Vertices 48 top_sort/2, % +Graph, -Sort 49 ugraph_layers/2, % +Graph, -Layers 50 transitive_closure/2, % +Graph, -Closure 51 transpose_ugraph/2, % +Graph, -NewGraph 52 vertices/2, % +Graph, -Vertices 53 vertices_edges_to_ugraph/3, % +Vertices, +Edges, -Graph 54 ugraph_union/3, % +Graph1, +Graph2, -Graph 55 connect_ugraph/3 % +Graph1, -Start, -Graph 56 ]).
79:- autoload(library(lists),[append/3]). 80:- autoload(library(ordsets), 81 [ord_subtract/3,ord_union/3,ord_add_element/3,ord_union/4]). 82:- autoload(library(error), [instantiation_error/1]).
?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L). L = [1, 2, 3, 4, 5]
91vertices([], []) :- !. 92vertices([Vertex-_|Graph], [Vertex|Vertices]) :- 93 vertices(Graph, Vertices).
?- 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-[]]
117vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
118 sort(Edges, EdgeSet),
119 p_to_s_vertices(EdgeSet, IVertexBag),
120 append(Vertices, IVertexBag, VertexBag),
121 sort(VertexBag, VertexSet),
122 p_to_s_group(VertexSet, EdgeSet, Graph).
?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG). NG = [0-[], 1-[3,5], 2-[], 9-[]]
135add_vertices(Graph, Vertices, NewGraph) :- 136 msort(Vertices, V1), 137 add_vertices_to_s_graph(V1, Graph, NewGraph). 138 139add_vertices_to_s_graph(L, [], NL) :- 140 !, 141 add_empty_vertices(L, NL). 142add_vertices_to_s_graph([], L, L) :- !. 143add_vertices_to_s_graph([V1|VL], [V-Edges|G], NGL) :- 144 compare(Res, V1, V), 145 add_vertices_to_s_graph(Res, V1, VL, V, Edges, G, NGL). 146 147add_vertices_to_s_graph(=, _, VL, V, Edges, G, [V-Edges|NGL]) :- 148 add_vertices_to_s_graph(VL, G, NGL). 149add_vertices_to_s_graph(<, V1, VL, V, Edges, G, [V1-[]|NGL]) :- 150 add_vertices_to_s_graph(VL, [V-Edges|G], NGL). 151add_vertices_to_s_graph(>, V1, VL, V, Edges, G, [V-Edges|NGL]) :- 152 add_vertices_to_s_graph([V1|VL], G, NGL). 153 154add_empty_vertices([], []). 155add_empty_vertices([V|G], [V-[]|NG]) :- 156 add_empty_vertices(G, NG).
?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]], [2,1], NL). NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
176del_vertices(Graph, Vertices, NewGraph) :- 177 sort(Vertices, V1), % JW: was msort 178 ( V1 = [] 179 -> Graph = NewGraph 180 ; del_vertices(Graph, V1, V1, NewGraph) 181 ). 182 183del_vertices(G, [], V1, NG) :- 184 !, 185 del_remaining_edges_for_vertices(G, V1, NG). 186del_vertices([], _, _, []). 187del_vertices([V-Edges|G], [V0|Vs], V1, NG) :- 188 compare(Res, V, V0), 189 split_on_del_vertices(Res, V,Edges, [V0|Vs], NVs, V1, NG, NGr), 190 del_vertices(G, NVs, V1, NGr). 191 192del_remaining_edges_for_vertices([], _, []). 193del_remaining_edges_for_vertices([V0-Edges|G], V1, [V0-NEdges|NG]) :- 194 ord_subtract(Edges, V1, NEdges), 195 del_remaining_edges_for_vertices(G, V1, NG). 196 197split_on_del_vertices(<, V, Edges, Vs, Vs, V1, [V-NEdges|NG], NG) :- 198 ord_subtract(Edges, V1, NEdges). 199split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :- 200 ord_subtract(Edges, V1, NEdges). 201split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG).
?- 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-[]]
217add_edges(Graph, Edges, NewGraph) :-
218 p_to_s_graph(Edges, G1),
219 ugraph_union(Graph, G1, NewGraph).
?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L). L = [1-[2], 2-[3,4], 3-[1,2,4]]
230ugraph_union(Set1, [], Set1) :- !. 231ugraph_union([], Set2, Set2) :- !. 232ugraph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :- 233 compare(Order, Head1, Head2), 234 ugraph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union). 235 236ugraph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :- 237 ord_union(E1, E2, Es), 238 ugraph_union(Tail1, Tail2, Union). 239ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :- 240 ugraph_union(Tail1, [Head2|Tail2], Union). 241ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :- 242 ugraph_union([Head1|Tail1], Tail2, Union).
?- 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-[]]
256del_edges(Graph, Edges, NewGraph) :-
257 p_to_s_graph(Edges, G1),
258 graph_subtract(Graph, G1, NewGraph).
264graph_subtract(Set1, [], Set1) :- !. 265graph_subtract([], _, []). 266graph_subtract([Head1-E1|Tail1], [Head2-E2|Tail2], Difference) :- 267 compare(Order, Head1, Head2), 268 graph_subtract(Order, Head1-E1, Tail1, Head2-E2, Tail2, Difference). 269 270graph_subtract(=, H-E1, Tail1, _-E2, Tail2, [H-E|Difference]) :- 271 ord_subtract(E1,E2,E), 272 graph_subtract(Tail1, Tail2, Difference). 273graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :- 274 graph_subtract(Tail1, [Head2|Tail2], Difference). 275graph_subtract(>, Head1, Tail1, _, Tail2, Difference) :- 276 graph_subtract([Head1|Tail1], Tail2, Difference).
?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L). L = [1-3, 1-5, 2-4, 4-5]
285edges(Graph, Edges) :- 286 s_to_p_graph(Graph, Edges). 287 288p_to_s_graph(P_Graph, S_Graph) :- 289 sort(P_Graph, EdgeSet), 290 p_to_s_vertices(EdgeSet, VertexBag), 291 sort(VertexBag, VertexSet), 292 p_to_s_group(VertexSet, EdgeSet, S_Graph). 293 294 295p_to_s_vertices([], []). 296p_to_s_vertices([A-Z|Edges], [A,Z|Vertices]) :- 297 p_to_s_vertices(Edges, Vertices). 298 299 300p_to_s_group([], _, []). 301p_to_s_group([Vertex|Vertices], EdgeSet, [Vertex-Neibs|G]) :- 302 p_to_s_group(EdgeSet, Vertex, Neibs, RestEdges), 303 p_to_s_group(Vertices, RestEdges, G). 304 305 306p_to_s_group([V1-X|Edges], V2, [X|Neibs], RestEdges) :- V1 == V2, 307 !, 308 p_to_s_group(Edges, V2, Neibs, RestEdges). 309p_to_s_group(Edges, _, [], Edges). 310 311 312 313s_to_p_graph([], []) :- !. 314s_to_p_graph([Vertex-Neibs|G], P_Graph) :- 315 s_to_p_graph(Neibs, Vertex, P_Graph, Rest_P_Graph), 316 s_to_p_graph(G, Rest_P_Graph). 317 318 319s_to_p_graph([], _, P_Graph, P_Graph) :- !. 320s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :- 321 s_to_p_graph(Neibs, Vertex, P, Rest_P).
?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L). L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
333transitive_closure(Graph, Closure) :- 334 warshall(Graph, Graph, Closure). 335 336warshall([], Closure, Closure) :- !. 337warshall([V-_|G], E, Closure) :- 338 memberchk(V-Y, E), % Y := E(v) 339 warshall(E, V, Y, NewE), 340 warshall(G, NewE, Closure). 341 342 343warshall([X-Neibs|G], V, Y, [X-NewNeibs|NewG]) :- 344 memberchk(V, Neibs), 345 !, 346 ord_union(Neibs, Y, NewNeibs), 347 warshall(G, V, Y, NewG). 348warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :- 349 !, 350 warshall(G, V, Y, NewG). 351warshall([], _, _, []).
?- 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-[]]
371transpose_ugraph(Graph, NewGraph) :- 372 edges(Graph, Edges), 373 vertices(Graph, Vertices), 374 flip_edges(Edges, TransposedEdges), 375 vertices_edges_to_ugraph(Vertices, TransposedEdges, NewGraph). 376 377flip_edges([], []). 378flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :- 379 flip_edges(Pairs, Flipped).
?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L). L = [1-[4], 2-[1,2,4], 3-[]]
389compose(G1, G2, Composition) :- 390 vertices(G1, V1), 391 vertices(G2, V2), 392 ord_union(V1, V2, V), 393 compose(V, G1, G2, Composition). 394 395compose([], _, _, []) :- !. 396compose([Vertex|Vertices], [Vertex-Neibs|G1], G2, 397 [Vertex-Comp|Composition]) :- 398 !, 399 compose1(Neibs, G2, [], Comp), 400 compose(Vertices, G1, G2, Composition). 401compose([Vertex|Vertices], G1, G2, [Vertex-[]|Composition]) :- 402 compose(Vertices, G1, G2, Composition). 403 404 405compose1([V1|Vs1], [V2-N2|G2], SoFar, Comp) :- 406 compare(Rel, V1, V2), 407 !, 408 compose1(Rel, V1, Vs1, V2, N2, G2, SoFar, Comp). 409compose1(_, _, Comp, Comp). 410 411 412compose1(<, _, Vs1, V2, N2, G2, SoFar, Comp) :- 413 !, 414 compose1(Vs1, [V2-N2|G2], SoFar, Comp). 415compose1(>, V1, Vs1, _, _, G2, SoFar, Comp) :- 416 !, 417 compose1([V1|Vs1], G2, SoFar, Comp). 418compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :- 419 ord_union(N2, SoFar, Next), 420 compose1(Vs1, G2, Next, Comp).
These predicates fail if Graph is cyclic. If Graph is not connected, the sub-graphs are individually sorted, where the root of each subgraph is in the first layer, the nodes connected to the roots in the second, etc.
?- top_sort([1-[2], 2-[3], 3-[]], L). L = [1, 2, 3]
458top_sort(Graph, Sorted) :- 459 ugraph_layers(Graph, Layers), 460 append(Layers, Sorted). 461 462ugraph_layers(Graph, Layers) :- 463 vertices_and_zeros(Graph, Vertices, Counts0), 464 count_edges(Graph, Vertices, Counts0, Counts1), 465 select_zeros(Counts1, Vertices, Zeros), 466 top_sort(Zeros, Layers, Graph, Vertices, Counts1). 467 468vertices_and_zeros([], [], []) :- !. 469vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :- 470 vertices_and_zeros(Graph, Vertices, Zeros). 471 472% Count the number of incomming edges for each vertex 473 474count_edges([], _, Counts, Counts) :- !. 475count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :- 476 incr_list(Neibs, Vertices, Counts0, Counts1), 477 count_edges(Graph, Vertices, Counts1, Counts2). 478 479 480incr_list([], _, Counts, Counts) :- !. 481incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :- 482 V1 == V2, 483 !, 484 N is M+1, 485 incr_list(Neibs, Vertices, Counts0, Counts1). 486incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :- 487 incr_list(Neibs, Vertices, Counts0, Counts1). 488 489% get the vertices with 0 incoming edges, i.e., the origins. 490 491select_zeros([], [], []) :- !. 492select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :- 493 !, 494 select_zeros(Counts, Vertices, Zeros). 495select_zeros([_|Counts], [_|Vertices], Zeros) :- 496 select_zeros(Counts, Vertices, Zeros).
500top_sort([], Layers, Graph, _, Counts) :- 501 !, 502 vertices_and_zeros(Graph, _, Counts), % verify nothing left 503 Layers = []. 504top_sort(Zeros, [Zeros|Layers], Graph, Vertices, Counts1) :- 505 decr_zero_neighbors(Zeros, Graph, Vertices, Counts1, Counts2, NewZeros, []), 506 top_sort(NewZeros, Layers, Graph, Vertices, Counts2). 507 508decr_zero_neighbors([], _, _, Counts, Counts, Z, Z). 509decr_zero_neighbors([Zero|Zeros], Graph, Vertices, Counts0, Counts, Z0, Z) :- 510 graph_memberchk(Zero-Neibs, Graph), 511 decr_list(Neibs, Vertices, Counts0, Counts1, Z0, Z1), 512 decr_zero_neighbors(Zeros, Graph, Vertices, Counts1, Counts, Z1, Z). 513 514graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :- 515 Element1 == Element2, 516 !, 517 Edges = Edges2. 518graph_memberchk(Element, [_|Rest]) :- 519 graph_memberchk(Element, Rest). 520 521decr_list([], _, Counts, Counts, Zeros, Zeros) :- 522 !. 523decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Z0, Z) :- 524 V1 == V2, 525 !, 526 M is N - 1, 527 ( M == 0 528 -> Z0 = [V1|Z1], 529 decr_list(Neibs, Vertices, Counts1, Counts2, Z1, Z) 530 ; decr_list(Neibs, Vertices, Counts1, Counts2, Z0, Z) 531 ). 532decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :- 533 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
?- neighbours(4,[1-[3,5],2-[4],3-[], 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL). NL = [1,2,7,5]
548neighbors(Vertex, Graph, Neig) :- 549 neighbours(Vertex, Graph, Neig). 550 551neighbours(V,[V0-Neig|_],Neig) :- 552 V == V0, 553 !. 554neighbours(V,[_|G],Neig) :- 555 neighbours(V,G,Neig).
Can be used to order a not-connected graph as follows:
top_sort_unconnected(Graph, Vertices) :- ( top_sort(Graph, Vertices) -> true ; connect_ugraph(Graph, Start, Connected), top_sort(Connected, Ordered0), Ordered0 = [Start|Vertices] ).
577connect_ugraph([], 0, []) :- !. 578connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :- 579 vertices(Graph, Vertices), 580 Vertices = [First|_], 581 before(First, Start).
590before(X, _) :- 591 var(X), 592 !, 593 instantiation_error(X). 594before(Number, Start) :- 595 number(Number), 596 !, 597 Start is Number - 1. 598before(_, 0).
?- 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]]
617complement(G, NG) :- 618 vertices(G,Vs), 619 complement(G,Vs,NG). 620 621complement([], _, []). 622complement([V-Ns|G], Vs, [V-INs|NG]) :- 623 ord_add_element(Ns,V,Ns1), 624 ord_subtract(Vs,Ns1,INs), 625 complement(G, Vs, NG).
?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V). V = [1, 3, 5]
635reachable(N, G, Rs) :- 636 reachable([N], G, [N], Rs). 637 638reachable([], _, Rs, Rs). 639reachable([N|Ns], G, Rs0, RsF) :- 640 neighbours(N, G, Nei), 641 ord_union(Rs0, Nei, Rs1, D), 642 append(Ns, D, Nsi), 643 reachable(Nsi, G, Rs1, RsF)
Graph manipulation library
The S-representation of a graph is a list of (vertex-neighbours) pairs, where the pairs are in standard order (as produced by keysort) and the neighbours of each vertex are also in standard order (as produced by sort). This form is convenient for many calculations.
A new UGraph from raw data can be created using vertices_edges_to_ugraph/3.
Adapted to support some of the functionality of the SICStus ugraphs library by Vitor Santos Costa.
Ported from YAP 5.0.1 to SWI-Prolog by Jan Wielemaker.