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 top_sort/3, 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
437
438top_sort(Graph, Sorted) :-
439 vertices_and_zeros(Graph, Vertices, Counts0),
440 count_edges(Graph, Vertices, Counts0, Counts1),
441 select_zeros(Counts1, Vertices, Zeros),
442 top_sort(Zeros, Sorted, Graph, Vertices, Counts1).
443
444top_sort(Graph, Sorted0, Sorted) :-
445 vertices_and_zeros(Graph, Vertices, Counts0),
446 count_edges(Graph, Vertices, Counts0, Counts1),
447 select_zeros(Counts1, Vertices, Zeros),
448 top_sort(Zeros, Sorted, Sorted0, Graph, Vertices, Counts1).
449
450
451vertices_and_zeros([], [], []) :- !.
452vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :-
453 vertices_and_zeros(Graph, Vertices, Zeros).
454
455
456count_edges([], _, Counts, Counts) :- !.
457count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :-
458 incr_list(Neibs, Vertices, Counts0, Counts1),
459 count_edges(Graph, Vertices, Counts1, Counts2).
460
461
462incr_list([], _, Counts, Counts) :- !.
463incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :-
464 V1 == V2,
465 !,
466 N is M+1,
467 incr_list(Neibs, Vertices, Counts0, Counts1).
468incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :-
469 incr_list(Neibs, Vertices, Counts0, Counts1).
470
471
472select_zeros([], [], []) :- !.
473select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :-
474 !,
475 select_zeros(Counts, Vertices, Zeros).
476select_zeros([_|Counts], [_|Vertices], Zeros) :-
477 select_zeros(Counts, Vertices, Zeros).
478
479
480
481top_sort([], [], Graph, _, Counts) :-
482 !,
483 vertices_and_zeros(Graph, _, Counts).
484top_sort([Zero|Zeros], [Zero|Sorted], Graph, Vertices, Counts1) :-
485 graph_memberchk(Zero-Neibs, Graph),
486 decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
487 top_sort(NewZeros, Sorted, Graph, Vertices, Counts2).
488
489top_sort([], Sorted0, Sorted0, Graph, _, Counts) :-
490 !,
491 vertices_and_zeros(Graph, _, Counts).
492top_sort([Zero|Zeros], [Zero|Sorted], Sorted0, Graph, Vertices, Counts1) :-
493 graph_memberchk(Zero-Neibs, Graph),
494 decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
495 top_sort(NewZeros, Sorted, Sorted0, Graph, Vertices, Counts2).
496
497graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :-
498 Element1 == Element2,
499 !,
500 Edges = Edges2.
501graph_memberchk(Element, [_|Rest]) :-
502 graph_memberchk(Element, Rest).
503
504
505decr_list([], _, Counts, Counts, Zeros, Zeros) :- !.
506decr_list([V1|Neibs], [V2|Vertices], [1|Counts1], [0|Counts2], Zi, Zo) :-
507 V1 == V2,
508 !,
509 decr_list(Neibs, Vertices, Counts1, Counts2, [V2|Zi], Zo).
510decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Zi, Zo) :-
511 V1 == V2,
512 !,
513 M is N-1,
514 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
515decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :-
516 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
517
518
530
531neighbors(Vertex, Graph, Neig) :-
532 neighbours(Vertex, Graph, Neig).
533
534neighbours(V,[V0-Neig|_],Neig) :-
535 V == V0,
536 !.
537neighbours(V,[_|G],Neig) :-
538 neighbours(V,G,Neig).
539
540
559
560connect_ugraph([], 0, []) :- !.
561connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
562 vertices(Graph, Vertices),
563 Vertices = [First|_],
564 before(First, Start).
565
572
573before(X, _) :-
574 var(X),
575 !,
576 instantiation_error(X).
577before(Number, Start) :-
578 number(Number),
579 !,
580 Start is Number - 1.
581before(_, 0).
582
583
599
600complement(G, NG) :-
601 vertices(G,Vs),
602 complement(G,Vs,NG).
603
604complement([], _, []).
605complement([V-Ns|G], Vs, [V-INs|NG]) :-
606 ord_add_element(Ns,V,Ns1),
607 ord_subtract(Vs,Ns1,INs),
608 complement(G, Vs, NG).
609
617
618reachable(N, G, Rs) :-
619 reachable([N], G, [N], Rs).
620
621reachable([], _, Rs, Rs).
622reachable([N|Ns], G, Rs0, RsF) :-
623 neighbours(N, G, Nei),
624 ord_union(Rs0, Nei, Rs1, D),
625 append(Ns, D, Nsi),
626 reachable(Nsi, G, Rs1, RsF)