34
35:- module(ugraphs,
36 [ add_edges/3, 37 add_vertices/3, 38 complement/2, 39 compose/3, 40 del_edges/3, 41 del_vertices/3, 42 edges/2, 43 neighbors/3, 44 neighbours/3, 45 reachable/3, 46 top_sort/2, 47 top_sort/3, 48 transitive_closure/2, 49 transpose_ugraph/2, 50 vertices/2, 51 vertices_edges_to_ugraph/3, 52 ugraph_union/3 53 ]). 54
75
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
136
137
145
146vertices([], []) :- !.
147vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
148 vertices(Graph, Vertices).
149
150
171
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).
202
220
221del_vertices(Graph, Vertices, NewGraph) :-
222 sort(Vertices, V1), 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).
251
256
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).
274
278
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).
292
297
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), 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([], _, _, []).
356
374
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).
384
385
390
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).
424
440
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).
520
521
526
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
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)