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-2012, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(ugraphs, 36 [ add_edges/3, % +Graph, +Edges, -NewGraph 37 add_vertices/3, % +Graph, +Vertices, -NewGraph 38 complement/2, % +Graph, -NewGraph 39 compose/3, % +LeftGraph, +RightGraph, -NewGraph 40 del_edges/3, % +Graph, +Edges, -NewGraph 41 del_vertices/3, % +Graph, +Vertices, -NewGraph 42 edges/2, % +Graph, -Edges 43 neighbors/3, % +Vertex, +Graph, -Vertices 44 neighbours/3, % +Vertex, +Graph, -Vertices 45 reachable/3, % +Vertex, +Graph, -Vertices 46 top_sort/2, % +Graph, -Sort 47 top_sort/3, % +Graph, -Sort0, -Sort 48 transitive_closure/2, % +Graph, -Closure 49 transpose_ugraph/2, % +Graph, -NewGraph 50 vertices/2, % +Graph, -Vertices 51 vertices_edges_to_ugraph/3, % +Vertices, +Edges, -Graph 52 ugraph_union/3 % +Graph1, +Graph2, -Graph 53 ]).
76:- use_module(library(lists), [ 77 append/3, 78 member/2 79 ]). 80 81:- use_module(library(ordsets), [ 82 ord_add_element/3, 83 ord_subtract/3, 84 ord_union/3, 85 ord_union/4 86 ]). 87 88 89/* 90 91:- public 92 p_to_s_graph/2, 93 s_to_p_graph/2, % edges 94 s_to_p_trans/2, 95 p_member/3, 96 s_member/3, 97 p_transpose/2, 98 s_transpose/2, 99 compose/3, 100 top_sort/2, 101 vertices/2, 102 warshall/2. 103 104:- mode 105 vertices(+, -), 106 p_to_s_graph(+, -), 107 p_to_s_vertices(+, -), 108 p_to_s_group(+, +, -), 109 p_to_s_group(+, +, -, -), 110 s_to_p_graph(+, -), 111 s_to_p_graph(+, +, -, -), 112 s_to_p_trans(+, -), 113 s_to_p_trans(+, +, -, -), 114 p_member(?, ?, +), 115 s_member(?, ?, +), 116 p_transpose(+, -), 117 s_transpose(+, -), 118 s_transpose(+, -, ?, -), 119 transpose_s(+, +, +, -), 120 compose(+, +, -), 121 compose(+, +, +, -), 122 compose1(+, +, +, -), 123 compose1(+, +, +, +, +, +, +, -), 124 top_sort(+, -), 125 vertices_and_zeros(+, -, ?), 126 count_edges(+, +, +, -), 127 incr_list(+, +, +, -), 128 select_zeros(+, +, -), 129 top_sort(+, -, +, +, +), 130 decr_list(+, +, +, -, +, -), 131 warshall(+, -), 132 warshall(+, +, -), 133 warshall(+, +, +, -). 134 135*/
146vertices([], []) :- !. 147vertices([Vertex-_|Graph], [Vertex|Vertices]) :- 148 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-[]]
172vertices_edges_to_ugraph(Vertices, Edges, Graph) :- 173 sort(Edges, EdgeSet), 174 p_to_s_vertices(EdgeSet, IVertexBag), 175 append(Vertices, IVertexBag, VertexBag), 176 sort(VertexBag, VertexSet), 177 p_to_s_group(VertexSet, EdgeSet, Graph). 178 179 180add_vertices(Graph, Vertices, NewGraph) :- 181 msort(Vertices, V1), 182 add_vertices_to_s_graph(V1, Graph, NewGraph). 183 184add_vertices_to_s_graph(L, [], NL) :- 185 !, 186 add_empty_vertices(L, NL). 187add_vertices_to_s_graph([], L, L) :- !. 188add_vertices_to_s_graph([V1|VL], [V-Edges|G], NGL) :- 189 compare(Res, V1, V), 190 add_vertices_to_s_graph(Res, V1, VL, V, Edges, G, NGL). 191 192add_vertices_to_s_graph(=, _, VL, V, Edges, G, [V-Edges|NGL]) :- 193 add_vertices_to_s_graph(VL, G, NGL). 194add_vertices_to_s_graph(<, V1, VL, V, Edges, G, [V1-[]|NGL]) :- 195 add_vertices_to_s_graph(VL, [V-Edges|G], NGL). 196add_vertices_to_s_graph(>, V1, VL, V, Edges, G, [V-Edges|NGL]) :- 197 add_vertices_to_s_graph([V1|VL], G, NGL). 198 199add_empty_vertices([], []). 200add_empty_vertices([V|G], [V-[]|NG]) :- 201 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-[]]
221del_vertices(Graph, Vertices, NewGraph) :- 222 sort(Vertices, V1), % JW: was msort 223 ( V1 = [] 224 -> Graph = NewGraph 225 ; del_vertices(Graph, V1, V1, NewGraph) 226 ). 227 228del_vertices(G, [], V1, NG) :- 229 !, 230 del_remaining_edges_for_vertices(G, V1, NG). 231del_vertices([], _, _, []). 232del_vertices([V-Edges|G], [V0|Vs], V1, NG) :- 233 compare(Res, V, V0), 234 split_on_del_vertices(Res, V,Edges, [V0|Vs], NVs, V1, NG, NGr), 235 del_vertices(G, NVs, V1, NGr). 236 237del_remaining_edges_for_vertices([], _, []). 238del_remaining_edges_for_vertices([V0-Edges|G], V1, [V0-NEdges|NG]) :- 239 ord_subtract(Edges, V1, NEdges), 240 del_remaining_edges_for_vertices(G, V1, NG). 241 242split_on_del_vertices(<, V, Edges, Vs, Vs, V1, [V-NEdges|NG], NG) :- 243 ord_subtract(Edges, V1, NEdges). 244split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :- 245 ord_subtract(Edges, V1, NEdges). 246split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG). 247 248add_edges(Graph, Edges, NewGraph) :- 249 p_to_s_graph(Edges, G1), 250 ugraph_union(Graph, G1, NewGraph).
257ugraph_union(Set1, [], Set1) :- !. 258ugraph_union([], Set2, Set2) :- !. 259ugraph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :- 260 compare(Order, Head1, Head2), 261 ugraph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union). 262 263ugraph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :- 264 ord_union(E1, E2, Es), 265 ugraph_union(Tail1, Tail2, Union). 266ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :- 267 ugraph_union(Tail1, [Head2|Tail2], Union). 268ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :- 269 ugraph_union([Head1|Tail1], Tail2, Union). 270 271del_edges(Graph, Edges, NewGraph) :- 272 p_to_s_graph(Edges, G1), 273 graph_subtract(Graph, G1, NewGraph).
279graph_subtract(Set1, [], Set1) :- !. 280graph_subtract([], _, []). 281graph_subtract([Head1-E1|Tail1], [Head2-E2|Tail2], Difference) :- 282 compare(Order, Head1, Head2), 283 graph_subtract(Order, Head1-E1, Tail1, Head2-E2, Tail2, Difference). 284 285graph_subtract(=, H-E1, Tail1, _-E2, Tail2, [H-E|Difference]) :- 286 ord_subtract(E1,E2,E), 287 graph_subtract(Tail1, Tail2, Difference). 288graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :- 289 graph_subtract(Tail1, [Head2|Tail2], Difference). 290graph_subtract(>, Head1, Tail1, _, Tail2, Difference) :- 291 graph_subtract([Head1|Tail1], Tail2, Difference).
298edges(Graph, Edges) :- 299 s_to_p_graph(Graph, Edges). 300 301p_to_s_graph(P_Graph, S_Graph) :- 302 sort(P_Graph, EdgeSet), 303 p_to_s_vertices(EdgeSet, VertexBag), 304 sort(VertexBag, VertexSet), 305 p_to_s_group(VertexSet, EdgeSet, S_Graph). 306 307 308p_to_s_vertices([], []). 309p_to_s_vertices([A-Z|Edges], [A,Z|Vertices]) :- 310 p_to_s_vertices(Edges, Vertices). 311 312 313p_to_s_group([], _, []). 314p_to_s_group([Vertex|Vertices], EdgeSet, [Vertex-Neibs|G]) :- 315 p_to_s_group(EdgeSet, Vertex, Neibs, RestEdges), 316 p_to_s_group(Vertices, RestEdges, G). 317 318 319p_to_s_group([V1-X|Edges], V2, [X|Neibs], RestEdges) :- V1 == V2, 320 !, 321 p_to_s_group(Edges, V2, Neibs, RestEdges). 322p_to_s_group(Edges, _, [], Edges). 323 324 325 326s_to_p_graph([], []) :- !. 327s_to_p_graph([Vertex-Neibs|G], P_Graph) :- 328 s_to_p_graph(Neibs, Vertex, P_Graph, Rest_P_Graph), 329 s_to_p_graph(G, Rest_P_Graph). 330 331 332s_to_p_graph([], _, P_Graph, P_Graph) :- !. 333s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :- 334 s_to_p_graph(Neibs, Vertex, P, Rest_P). 335 336 337transitive_closure(Graph, Closure) :- 338 warshall(Graph, Graph, Closure). 339 340warshall([], Closure, Closure) :- !. 341warshall([V-_|G], E, Closure) :- 342 memberchk(V-Y, E), % Y := E(v) 343 warshall(E, V, Y, NewE), 344 warshall(G, NewE, Closure). 345 346 347warshall([X-Neibs|G], V, Y, [X-NewNeibs|NewG]) :- 348 memberchk(V, Neibs), 349 !, 350 ord_union(Neibs, Y, NewNeibs), 351 warshall(G, V, Y, NewG). 352warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :- 353 !, 354 warshall(G, V, Y, NewG). 355warshall([], _, _, []).
?- 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-[]]
375transpose_ugraph(Graph, NewGraph) :- 376 edges(Graph, Edges), 377 vertices(Graph, Vertices), 378 flip_edges(Edges, TransposedEdges), 379 vertices_edges_to_ugraph(Vertices, TransposedEdges, NewGraph). 380 381flip_edges([], []). 382flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :- 383 flip_edges(Pairs, Flipped).
391compose(G1, G2, Composition) :- 392 vertices(G1, V1), 393 vertices(G2, V2), 394 ord_union(V1, V2, V), 395 compose(V, G1, G2, Composition). 396 397 398compose([], _, _, []) :- !. 399compose([Vertex|Vertices], [Vertex-Neibs|G1], G2, 400 [Vertex-Comp|Composition]) :- 401 !, 402 compose1(Neibs, G2, [], Comp), 403 compose(Vertices, G1, G2, Composition). 404compose([Vertex|Vertices], G1, G2, [Vertex-[]|Composition]) :- 405 compose(Vertices, G1, G2, Composition). 406 407 408compose1([V1|Vs1], [V2-N2|G2], SoFar, Comp) :- 409 compare(Rel, V1, V2), 410 !, 411 compose1(Rel, V1, Vs1, V2, N2, G2, SoFar, Comp). 412compose1(_, _, Comp, Comp). 413 414 415compose1(<, _, Vs1, V2, N2, G2, SoFar, Comp) :- 416 !, 417 compose1(Vs1, [V2-N2|G2], SoFar, Comp). 418compose1(>, V1, Vs1, _, _, G2, SoFar, Comp) :- 419 !, 420 compose1([V1|Vs1], G2, SoFar, Comp). 421compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :- 422 ord_union(N2, SoFar, Next), 423 compose1(Vs1, G2, Next, Comp).
?- top_sort([1-[2], 2-[3], 3-[]], L). L = [1, 2, 3]
The predicate top_sort/3 is a difference list version of top_sort/2.
441top_sort(Graph, Sorted) :- 442 vertices_and_zeros(Graph, Vertices, Counts0), 443 count_edges(Graph, Vertices, Counts0, Counts1), 444 select_zeros(Counts1, Vertices, Zeros), 445 top_sort(Zeros, Sorted, Graph, Vertices, Counts1). 446 447top_sort(Graph, Sorted0, Sorted) :- 448 vertices_and_zeros(Graph, Vertices, Counts0), 449 count_edges(Graph, Vertices, Counts0, Counts1), 450 select_zeros(Counts1, Vertices, Zeros), 451 top_sort(Zeros, Sorted, Sorted0, Graph, Vertices, Counts1). 452 453 454vertices_and_zeros([], [], []) :- !. 455vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :- 456 vertices_and_zeros(Graph, Vertices, Zeros). 457 458 459count_edges([], _, Counts, Counts) :- !. 460count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :- 461 incr_list(Neibs, Vertices, Counts0, Counts1), 462 count_edges(Graph, Vertices, Counts1, Counts2). 463 464 465incr_list([], _, Counts, Counts) :- !. 466incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :- 467 V1 == V2, 468 !, 469 N is M+1, 470 incr_list(Neibs, Vertices, Counts0, Counts1). 471incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :- 472 incr_list(Neibs, Vertices, Counts0, Counts1). 473 474 475select_zeros([], [], []) :- !. 476select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :- 477 !, 478 select_zeros(Counts, Vertices, Zeros). 479select_zeros([_|Counts], [_|Vertices], Zeros) :- 480 select_zeros(Counts, Vertices, Zeros). 481 482 483 484top_sort([], [], Graph, _, Counts) :- 485 !, 486 vertices_and_zeros(Graph, _, Counts). 487top_sort([Zero|Zeros], [Zero|Sorted], Graph, Vertices, Counts1) :- 488 graph_memberchk(Zero-Neibs, Graph), 489 decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros), 490 top_sort(NewZeros, Sorted, Graph, Vertices, Counts2). 491 492top_sort([], Sorted0, Sorted0, Graph, _, Counts) :- 493 !, 494 vertices_and_zeros(Graph, _, Counts). 495top_sort([Zero|Zeros], [Zero|Sorted], Sorted0, Graph, Vertices, Counts1) :- 496 graph_memberchk(Zero-Neibs, Graph), 497 decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros), 498 top_sort(NewZeros, Sorted, Sorted0, Graph, Vertices, Counts2). 499 500graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :- 501 Element1 == Element2, 502 !, 503 Edges = Edges2. 504graph_memberchk(Element, [_|Rest]) :- 505 graph_memberchk(Element, Rest). 506 507 508decr_list([], _, Counts, Counts, Zeros, Zeros) :- !. 509decr_list([V1|Neibs], [V2|Vertices], [1|Counts1], [0|Counts2], Zi, Zo) :- 510 V1 == V2, 511 !, 512 decr_list(Neibs, Vertices, Counts1, Counts2, [V2|Zi], Zo). 513decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Zi, Zo) :- 514 V1 == V2, 515 !, 516 M is N-1, 517 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo). 518decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :- 519 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
527neighbors(Vertex, Graph, Neig) :- 528 neighbours(Vertex, Graph, Neig). 529 530neighbours(V,[V0-Neig|_],Neig) :- 531 V == V0, 532 !. 533neighbours(V,[_|G],Neig) :- 534 neighbours(V,G,Neig). 535 536 537% 538% Simple two-step algorithm. You could be smarter, I suppose. 539% 540complement(G, NG) :- 541 vertices(G,Vs), 542 complement(G,Vs,NG). 543 544complement([], _, []). 545complement([V-Ns|G], Vs, [V-INs|NG]) :- 546 ord_add_element(Ns,V,Ns1), 547 ord_subtract(Vs,Ns1,INs), 548 complement(G, Vs, NG). 549 550 551 552reachable(N, G, Rs) :- 553 reachable([N], G, [N], Rs). 554 555reachable([], _, Rs, Rs). 556reachable([N|Ns], G, Rs0, RsF) :- 557 neighbours(N, G, Nei), 558 ord_union(Rs0, Nei, Rs1, D), 559 append(Ns, D, Nsi), 560 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.