36
37:- module(ugraphs,
38 [ add_edges/3, 39 add_vertices/3, 40 complement/2, 41 compose/3, 42 del_edges/3, 43 del_vertices/3, 44 edges/2, 45 neighbors/3, 46 neighbours/3, 47 reachable/3, 48 top_sort/2, 49 ugraph_layers/2, 50 transitive_closure/2, 51 transpose_ugraph/2, 52 vertices/2, 53 vertices_edges_to_ugraph/3, 54 ugraph_union/3, 55 connect_ugraph/3 56 ]). 57
78
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]). 83
90
91vertices([], []) :- !.
92vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
93 vertices(Graph, Vertices).
94
95
116
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).
123
124
134
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).
157
175
176del_vertices(Graph, Vertices, NewGraph) :-
177 sort(Vertices, V1), 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).
202
216
217add_edges(Graph, Edges, NewGraph) :-
218 p_to_s_graph(Edges, G1),
219 ugraph_union(Graph, G1, NewGraph).
220
229
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).
243
255
256del_edges(Graph, Edges, NewGraph) :-
257 p_to_s_graph(Edges, G1),
258 graph_subtract(Graph, G1, NewGraph).
259
263
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).
277
284
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).
322
332
333transitive_closure(Graph, Closure) :-
334 warshall(Graph, Graph, Closure).
335
336warshall([], Closure, Closure) :- !.
337warshall([V-_|G], E, Closure) :-
338 memberchk(V-Y, E), 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([], _, _, []).
352
370
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).
380
388
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).
421
457
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
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
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).
497
499
500top_sort([], Layers, Graph, _, Counts) :-
501 !,
502 vertices_and_zeros(Graph, _, Counts), 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).
534
535
547
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).
556
557
576
577connect_ugraph([], 0, []) :- !.
578connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
579 vertices(Graph, Vertices),
580 Vertices = [First|_],
581 before(First, Start).
582
589
590before(X, _) :-
591 var(X),
592 !,
593 instantiation_error(X).
594before(Number, Start) :-
595 number(Number),
596 !,
597 Start is Number - 1.
598before(_, 0).
599
600
616
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).
626
634
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)