YAP 7.1.0
ugraphs.yap
Go to the documentation of this file.
1/**
2 * @file ugraphs.yap
3 * @author R.A.O'Keefe
4 * @author adapted to support some of the functionality of the SICStus ugraphs library
5by Vitor Santos Costa.
6 * @date 20 March 1984
7 * @brief
8 *
9 *
10*/
11% File : GRAPHS.PL
12% Author : R.A.O'Keefe
13% Updated:
14% Purpose: .
15
16%
17%
18%
19
21 [
22 ,
23 ,
24 ,
25 ,
26 ,
27 ,
28 ,
29 ,
30 ,
31 ,
32 ,
33 ,
34 ,
35 ,
36 ,
37 ,
38
39 ]).
40
41
42/** @defgroup ugraphs Unweighted Graphs
43@ingroup YAPLibrary
44@{
45
46The following graph manipulation routines are based in code originally
47written by Richard O'Keefe. The code was then extended to be compatible
48with the SICStus Prolog ugraphs library. The routines assume directed
49graphs, undirected graphs may be implemented by using two edges. Graphs
50are represented in one of two ways:
51
52+ The P-representation of a graph is a list of (from-to) vertex
53pairs, where the pairs can be in any old order. This form is
54convenient for input/output.
55
56The S-representation of a graph is a list of (vertex-neighbors)
57pairs, where the pairs are in standard order (as produced by keysort)
58and the neighbors of each vertex are also in standard order (as
59produced by sort). This form is convenient for many calculations.
60
61
62These built-ins are available once included with the
63`use_module(library(ugraphs))` command.
64
65*/
66
67/* The P-representation of a graph is a list of (from-to) vertex
68 pairs, where the pairs can be in any old order. This form is
69 convenient for input/output.
70
71 The S-representation of a graph is a list of (vertex-neighbours)
72 pairs, where the pairs are in standard order (as produced by
73 keysort) and the neighbours of each vertex are also in standard
74 order (as produced by sort). This form is convenient for many
75 calculations.
76
77 p_to_s_graph(Pform, Sform) converts a P- to an S- representation.
78 s_to_p_graph(Sform, Pform) converts an S- to a P- representation.
79
80 warshall(Graph, Closure) takes the transitive closure of a graph
81 in S-form. (NB: this is not the reflexive transitive closure).
82
83 s_to_p_trans(Sform, Pform) converts Sform to Pform, transposed.
84
85 p_transpose transposes a graph in P-form, cost O(|E|).
86 s_transpose transposes a graph in S-form, cost O(|V|^2).
87*/
88
89/** @pred vertices_edges_to_ugraph(+ _Vertices_, + _Edges_, - _Graph_)
90
91
92Given a graph with a set of vertices _Vertices_ and a set of edges
93 _Edges_, _Graph_ must unify with the corresponding
94s-representation. Note that the vertices without edges will appear in
95 _Vertices_ but not in _Edges_. Moreover, it is sufficient for a
96vertex to appear in _Edges_.
97
98```
99?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5],L).
100
101L = [1-[3,5],2-[4],3-[],4-[5],5-[]] ?
102
103```
104In this case all edges are defined implicitly. The next example shows
105three unconnected edges:
106
107```
108?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5],L).
109
110L = [1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]] ?
111
112```
113
114
115*/
116/** @pred add_edges(+ _Graph_, + _Edges_, - _NewGraph_)
117
118
119Unify _NewGraph_ with a new graph obtained by adding the list of
120edges _Edges_ to the graph _Graph_. In the next example:
121
122```
123?- add_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],
124 7-[],8-[]],[1-6,2-3,3-2,5-7,3-2,4-5],NL).
125
126NL = [1-[3,5,6],2-[3,4],3-[2],4-[5],5-[7],6-[],7-[],8-[]]
127```
128
129
130*/
131/** @pred add_vertices(+ _Graph_, + _Vertices_, - _NewGraph_)
132
133
134Unify _NewGraph_ with a new graph obtained by adding the list of
135vertices _Vertices_ to the graph _Graph_. In the next example:
136
137```
138?- add_vertices([1-[3,5],2-[4],3-[],4-[5],
139 5-[],6-[],7-[],8-[]],
140 [0,2,9,10,11],
141 NG).
142
143NG = [0-[],1-[3,5],2-[4],3-[],4-[5],5-[],
144 6-[],7-[],8-[],9-[],10-[],11-[]]
145```
146
147
148*/
149/** @pred complement(+ _Graph_, - _NewGraph_)
150
151
152Unify _NewGraph_ with the graph complementary to _Graph_.
153In the next example:
154
155```
156?- complement([1-[3,5],2-[4],3-[],
157 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
158
159NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
160 4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
161 7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
162```
163
164
165*/
166/** @pred compose(+ _LeftGraph_, + _RightGraph_, - _NewGraph_)
167
168
169Compose the graphs _LeftGraph_ and _RightGraph_ to form _NewGraph_.
170In the next example:
171
172```
173?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
174
175L = [1-[4],2-[1,2,4],3-[]]
176```
177
178
179*/
180/** @pred del_edges(+ _Graph_, + _Edges_, - _NewGraph_)
181
182
183Unify _NewGraph_ with a new graph obtained by removing the list of
184edges _Edges_ from the graph _Graph_. Notice that no vertices
185are deleted. In the next example:
186
187```
188?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],
189 6-[],7-[],8-[]],
190 [1-6,2-3,3-2,5-7,3-2,4-5,1-3],NL).
191
192NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
193```
194
195
196*/
197/** @pred del_vertices(+ _Graph_, + _Vertices_, - _NewGraph_)
198
199
200Unify _NewGraph_ with a new graph obtained by deleting the list of
201vertices _Vertices_ and all the edges that start from or go to a
202vertex in _Vertices_ to the graph _Graph_. In the next example:
203
204```
205?- del_vertices([2,1],[1-[3,5],2-[4],3-[],
206 4-[5],5-[],6-[],7-[2,6],8-[]],NL).
207
208NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
209```
210
211
212*/
213/** @pred edges(+ _Graph_, - _Edges_)
214
215
216Unify _Edges_ with all edges appearing in graph
217 _Graph_. In the next example:
218
219```
220?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], V).
221
222L = [1,2,3,4,5]
223```
224
225
226*/
227/** @pred neighbors(+ _Vertex_, + _Graph_, - _Vertices_)
228
229
230Unify _Vertices_ with the list of neighbors of vertex _Vertex_
231in _Graph_. If the vertice is not in the graph fail. In the next
232example:
233
234```
235?- neighbors(4,[1-[3,5],2-[4],3-[],
236 4-[1,2,7,5],5-[],6-[],7-[],8-[]],
237 NL).
238
239NL = [1,2,7,5]
240```
241
242
243*/
244/** @pred neighbours(+ _Vertex_, + _Graph_, - _Vertices_)
245
246
247Unify _Vertices_ with the list of neighbours of vertex _Vertex_
248in _Graph_. In the next example:
249
250```
251?- neighbours(4,[1-[3,5],2-[4],3-[],
252 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
253
254NL = [1,2,7,5]
255```
256
257
258*/
259/** @pred reachable(+ _Node_, + _Graph_, - _Vertices_)
260
261
262Unify _Vertices_ with the set of all vertices in graph
263 _Graph_ that are reachable from _Node_. In the next example:
264
265```
266?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
267
268V = [1,3,5]
269```
270
271
272
273
274 */
275/** @pred top_sort(+ _Graph_, - _Sort0_, - _Sort_)
276
277Generate the difference list _Sort_- _Sort0_ as a topological
278sorting of graph _Graph_, if one is possible.
279
280
281*/
282/** @pred top_sort(+ _Graph_, - _Sort_)
283
284
285Generate the set of nodes _Sort_ as a topological sorting of graph
286 _Graph_, if one is possible.
287In the next example we show how topological sorting works for a linear graph:
288
289```
290?- top_sort([_138-[_219],_219-[_139], _139-[]],L).
291
292L = [_138,_219,_139]
293```
294
295
296*/
297/** @pred transitive_closure(+ _Graph_, + _Closure_)
298
299
300Generate the graph _Closure_ as the transitive closure of graph
301 _Graph_.
302In the next example:
303
304```
305?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
306
307L = [1-[2,3,4,5,6],2-[4,5,6],4-[6]]
308```
309
310
311*/
312/** @pred vertices(+ _Graph_, - _Vertices_)
313
314
315Unify _Vertices_ with all vertices appearing in graph
316 _Graph_. In the next example:
317
318```
319?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], V).
320
321L = [1,2,3,4,5]
322```
323
324
325*/
326
327:- append/3member/2memberchk/2use_module(library(lists), [
328 ,
329 ,
330
331 ]).
332
334 ,
335 ,
336 ,
337
338 ]).
339
340
341/*
342
343:- public
344 p_to_s_graph/2,
345 s_to_p_graph/2, % edges
346 s_to_p_trans/2,
347 p_member/3,
348 s_member/3,
349 p_transpose/2,
350 s_transpose/2,
351 compose/3,
352 top_sort/2,
353 vertices/2,
354 warshall/2.
355
356:- mode
357 vertices(+, -),
358 p_to_s_graph(+, -),
359 p_to_s_vertices(+, -),
360 p_to_s_group(+, +, -),
361 p_to_s_group(+, +, -, -),
362 s_to_p_graph(+, -),
363 s_to_p_graph(+, +, -, -),
364 s_to_p_trans(+, -),
365 s_to_p_trans(+, +, -, -),
366 p_member(?, ?, +),
367 s_member(?, ?, +),
368 p_transpose(+, -),
369 s_transpose(+, -),
370 s_transpose(+, -, ?, -),
371 transpose_s(+, +, +, -),
372 compose(+, +, -),
373 compose(+, +, +, -),
374 compose1(+, +, +, -),
375 compose1(+, +, +, +, +, +, +, -),
376 top_sort(+, -),
377 vertices_and_zeros(+, -, ?),
378 count_edges(+, +, +, -),
379 incr_list(+, +, +, -),
380 select_zeros(+, +, -),
381 top_sort(+, -, +, +, +),
382 decr_list(+, +, +, -, +, -),
383 warshall(+, -),
384 warshall(+, +, -),
385 warshall(+, +, +, -).
386
387*/
388
389
390% vertices(S_Graph, Vertices)
391% strips off the neighbours lists of an S-representation to produce
392% a list of the vertices of the graph. (It is a characteristic of
393% S-representations that *every* vertex appears, even if it has no
394% neighbours.)
395
396vertices([], []) :- vertices.
397vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
398 vertices(Graph, Vertices).
399
400vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
401 sort(Edges, EdgeSet),
402 p_to_s_vertices(EdgeSet, IVertexBag),
403 append(Vertices, IVertexBag, VertexBag),
404 sort(VertexBag, VertexSet),
405 p_to_s_group(VertexSet, EdgeSet, Graph).
406
407
408add_vertices(Graph, Vertices, NewGraph) :-
409 msort(Vertices, V1),
410 add_vertices_to_s_graph(V1, Graph, NewGraph).
411
412add_vertices_to_s_graph(L, [], NL) :- add_vertices_to_s_graph, add_empty_vertices(L, NL).
413add_vertices_to_s_graph([], L, L) :- add_vertices_to_s_graph.
414add_vertices_to_s_graph([V1|VL], [V-Edges|G], NGL) :-
415 compare(Res, V1, V),
416 add_vertices_to_s_graph(Res, V1, VL, V, Edges, G, NGL).
417
418add_vertices_to_s_graph(=, _, VL, V, Edges, G, [V-Edges|NGL]) :-
419 add_vertices_to_s_graph(VL, G, NGL).
420add_vertices_to_s_graph(<, V1, VL, V, Edges, G, [V1-[]|NGL]) :-
421 add_vertices_to_s_graph(VL, [V-Edges|G], NGL).
422add_vertices_to_s_graph(>, V1, VL, V, Edges, G, [V-Edges|NGL]) :-
423 add_vertices_to_s_graph([V1|VL], G, NGL).
424
425add_empty_vertices([], []).
426add_empty_vertices([V|G], [V-[]|NG]) :-
427 add_empty_vertices(G, NG).
428
429%
430% unmark a set of vertices plus all edges leading to them.
431%
432del_vertices(Graph, Vertices, NewGraph) :-
433 msort(Vertices, V1),
434 (V1 = [] -> Graph = NewGraph ;
435 del_vertices(Graph, V1, V1, NewGraph) ).
436
437del_vertices(G, [], V1, NG) :- del_vertices,
438 del_remaining_edges_for_vertices(G, V1, NG).
439del_vertices([], _, _, []).
440del_vertices([V-Edges|G], [V0|Vs], V1, NG) :-
441 compare(Res, V, V0),
442 split_on_del_vertices(Res, V,Edges, [V0|Vs], NVs, V1, NG, NGr),
443 del_vertices(G, NVs, V1, NGr).
444
445del_remaining_edges_for_vertices([], _, []).
446del_remaining_edges_for_vertices([V0-Edges|G], V1, [V0-NEdges|NG]) :-
447 ord_subtract(Edges, V1, NEdges),
448 del_remaining_edges_for_vertices(G, V1, NG).
449
450split_on_del_vertices(<, V, Edges, Vs, Vs, V1, [V-NEdges|NG], NG) :-
451 ord_subtract(Edges, V1, NEdges).
452split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :-
453 ord_subtract(Edges, V1, NEdges).
454split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG).
455
456add_edges(Graph, Edges, NewGraph) :-
457 p_to_s_graph(Edges, G1),
458 graph_union(Graph, G1, NewGraph).
459
460% graph_union(+Set1, +Set2, ?Union)
461% is true when Union is the union of Set1 and Set2. This code is a copy
462% of set union
463
464graph_union(Set1, [], Set1) :- graph_union.
465graph_union([], Set2, Set2) :- graph_union.
466graph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :-
467 compare(Order, Head1, Head2),
468 graph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union).
469
470graph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :-
471 ord_union(E1, E2, Es),
472 graph_union(Tail1, Tail2, Union).
473graph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
474 graph_union(Tail1, [Head2|Tail2], Union).
475graph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
476 graph_union([Head1|Tail1], Tail2, Union).
477
478del_edges(Graph, Edges, NewGraph) :-
479 p_to_s_graph(Edges, G1),
480 graph_subtract(Graph, G1, NewGraph).
481
482% graph_subtract(+Set1, +Set2, ?Difference)
483% is based on ord_subtract
484%
485
486graph_subtract(Set1, [], Set1) :- graph_subtract.
487graph_subtract([], _, []).
488graph_subtract([Head1-E1|Tail1], [Head2-E2|Tail2], Difference) :-
489 compare(Order, Head1, Head2),
490 graph_subtract(Order, Head1-E1, Tail1, Head2-E2, Tail2, Difference).
491
492graph_subtract(=, H-E1, Tail1, _-E2, Tail2, [H-E|Difference]) :-
493 ord_subtract(E1,E2,E),
494 graph_subtract(Tail1, Tail2, Difference).
495graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
496 graph_subtract(Tail1, [Head2|Tail2], Difference).
497graph_subtract(>, Head1, Tail1, _, Tail2, Difference) :-
498 graph_subtract([Head1|Tail1], Tail2, Difference).
499
500
501
502edges(Graph, Edges) :-
503 s_to_p_graph(Graph, Edges).
504
505p_to_s_graph(P_Graph, S_Graph) :-
506 sort(P_Graph, EdgeSet),
507 p_to_s_vertices(EdgeSet, VertexBag),
508 sort(VertexBag, VertexSet),
509 p_to_s_group(VertexSet, EdgeSet, S_Graph).
510
511
512p_to_s_vertices([], []).
513p_to_s_vertices([A-Z|Edges], [A,Z|Vertices]) :-
514 p_to_s_vertices(Edges, Vertices).
515
516
517p_to_s_group([], _, []).
518p_to_s_group([Vertex|Vertices], EdgeSet, [Vertex-Neibs|G]) :-
519 p_to_s_group(EdgeSet, Vertex, Neibs, RestEdges),
520 p_to_s_group(Vertices, RestEdges, G).
521
522
523p_to_s_group([V1-X|Edges], V2, [X|Neibs], RestEdges) :- V1 == V2, p_to_s_group,
524 p_to_s_group(Edges, V2, Neibs, RestEdges).
525p_to_s_group(Edges, _, [], Edges).
526
527
528
529s_to_p_graph([], []) :- s_to_p_graph.
530s_to_p_graph([Vertex-Neibs|G], P_Graph) :-
531 s_to_p_graph(Neibs, Vertex, P_Graph, Rest_P_Graph),
532 s_to_p_graph(G, Rest_P_Graph).
533
534
535s_to_p_graph([], _, P_Graph, P_Graph) :- s_to_p_graph.
536s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :-
537 s_to_p_graph(Neibs, Vertex, P, Rest_P).
538
539
540
541s_to_p_trans([], []) :- s_to_p_trans.
542s_to_p_trans([Vertex-Neibs|G], P_Graph) :-
543 s_to_p_trans(Neibs, Vertex, P_Graph, Rest_P_Graph),
544 s_to_p_trans(G, Rest_P_Graph).
545
546
547s_to_p_trans([], _, P_Graph, P_Graph) :- s_to_p_trans.
548s_to_p_trans([Neib|Neibs], Vertex, [Neib-Vertex|P], Rest_P) :-
549 s_to_p_trans(Neibs, Vertex, P, Rest_P).
550
551
552
553transitive_closure(Graph, Closure) :-
554 warshall(Graph, Graph, Closure).
555
556warshall(Graph, Closure) :-
557 warshall(Graph, Graph, Closure).
558
559warshall([], Closure, Closure) :- warshall.
560warshall([V-_|G], E, Closure) :-
561 memberchk(V-Y, E), % Y := E(v)
562 warshall(E, V, Y, NewE),
563 warshall(G, NewE, Closure).
564
565
566warshall([X-Neibs|G], V, Y, [X-NewNeibs|NewG]) :-
567 memberchk(V, Neibs),
568 memberchk,
569 ord_union(Neibs, Y, NewNeibs),
570 warshall(G, V, Y, NewG).
571warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :- warshall,
572 warshall(G, V, Y, NewG).
573warshall([], _, _, []).
574
575
576
577p_transpose([], []) :- p_transpose.
578p_transpose([From-To|Edges], [To-From|Transpose]) :-
579 p_transpose(Edges, Transpose).
580
581
582/** @pred transpose(+ _Graph_, - _NewGraph_)
583
584
585Unify _NewGraph_ with a new graph obtained from _Graph_ by
586replacing all edges of the form _V1-V2_ by edges of the form
587 _V2-V1_. The cost is `O(|V|^2)`. In the next example:
588
589```
590?- transpose([1-[3,5],2-[4],3-[],
591 4-[5],5-[],6-[],7-[],8-[]], NL).
592
593NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
594```
595Notice that an undirected graph is its own transpose.
596
597
598*/
599transpose(S_Graph, Transpose) :-
600 s_transpose(S_Graph, Base, Base, Transpose).
601
602s_transpose(S_Graph, Transpose) :-
603 s_transpose(S_Graph, Base, Base, Transpose).
604
605s_transpose([], [], Base, Base) :- s_transpose.
606s_transpose([Vertex-Neibs|Graph], [Vertex-[]|RestBase], Base, Transpose) :-
607 s_transpose(Graph, RestBase, Base, SoFar),
608 transpose_s(SoFar, Neibs, Vertex, Transpose).
609
610transpose_s([Neib-Trans|SoFar], [Neib|Neibs], Vertex,
611 [Neib-[Vertex|Trans]|Transpose]) :- transpose_s,
612 transpose_s(SoFar, Neibs, Vertex, Transpose).
613transpose_s([Head|SoFar], Neibs, Vertex, [Head|Transpose]) :- transpose_s,
614 transpose_s(SoFar, Neibs, Vertex, Transpose).
615transpose_s([], [], _, []).
616
617
618
619% p_member(X, Y, P_Graph)
620% tests whether the edge (X,Y) occurs in the graph. This always
621% costs O(|E|) time. Here, as in all the operations in this file,
622% vertex labels are assumed to be ground terms, or at least to be
623% sufficiently instantiated that no two of them have a common instance.
624
625p_member(X, Y, P_Graph) :-
626 nonvar(X), nonvar(Y), nonvar,
627 memberchk(X-Y, P_Graph).
628p_member(X, Y, P_Graph) :-
629 member(X-Y, P_Graph).
630
631% s_member(X, Y, S_Graph)
632% tests whether the edge (X,Y) occurs in the graph. If either
633% X or Y is instantiated, the check is order |V| rather than
634% order |E|.
635
636s_member(X, Y, S_Graph) :-
637 var(X), var(Y), var,
638 member(X-Neibs, S_Graph),
639 member(Y, Neibs).
640s_member(X, Y, S_Graph) :-
641 var(X), var,
642 member(X-Neibs, S_Graph),
643 memberchk(Y, Neibs).
644s_member(X, Y, S_Graph) :-
645 var(Y), var,
646 memberchk(X-Neibs, S_Graph),
647 member(Y, Neibs).
648s_member(X, Y, S_Graph) :-
649 memberchk(X-Neibs, S_Graph),
650 memberchk(Y, Neibs).
651
652
653% compose(G1, G2, Composition)
654% calculates the composition of two S-form graphs, which need not
655% have the same set of vertices.
656
657compose(G1, G2, Composition) :-
658 vertices(G1, V1),
659 vertices(G2, V2),
660 ord_union(V1, V2, V),
661 compose(V, G1, G2, Composition).
662
663
664compose([], _, _, []) :- compose.
665compose([Vertex|Vertices], [Vertex-Neibs|G1], G2, [Vertex-Comp|Composition]) :- compose,
666 compose1(Neibs, G2, [], Comp),
667 compose(Vertices, G1, G2, Composition).
668compose([Vertex|Vertices], G1, G2, [Vertex-[]|Composition]) :-
669 compose(Vertices, G1, G2, Composition).
670
671
672compose1([V1|Vs1], [V2-N2|G2], SoFar, Comp) :-
673 compare(Rel, V1, V2), compare,
674 compose1(Rel, V1, Vs1, V2, N2, G2, SoFar, Comp).
675compose1(_, _, Comp, Comp).
676
677
678compose1(<, _, Vs1, V2, N2, G2, SoFar, Comp) :- compose1,
679 compose1(Vs1, [V2-N2|G2], SoFar, Comp).
680compose1(>, V1, Vs1, _, _, G2, SoFar, Comp) :- compose1,
681 compose1([V1|Vs1], G2, SoFar, Comp).
682compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :-
683 ord_union(N2, SoFar, Next),
684 compose1(Vs1, G2, Next, Comp).
685
686
687/**
688@pred raakau(Vertices, InitialValue, Tree)
689
690NOT USED AFTER ALL
691 takes an *ordered* list of verticies and an initial value, and
692 makes a very special sort of tree out of them, which represents
693 a function sending each vertex to the initial value. Note that
694 in the third clause for raakau/6 Z can never be 0, this means
695 that it doesn't matter *what* "greatest member" is reported for
696 empty trees.
697*/
698raakau(Vertices, InitialValue, Tree) :-
699 length(Vertices, N),
700 raakau(N, Vertices, _, _, InitialValue, Tree).
701
702
703raakau(0, Vs, Vs, 0, I, t) :- raakau.
704raakau(1, [V|Vs], Vs, V, I, t(V,I)) :- raakau.
705raakau(N, Vi, Vo, W, I, t(V,W,I,L,R)) :-
706 A is (N-1)/2,
707 Z is (N-1)-A, % Z >= 1
708 raakau(A, Vi, [V|Vm], _, I, L),
709 raakau(Z, Vm, Vo, W, I, R).
710
711
712% incdec(OldTree, Labels, Incr, NewTree)
713% adds Incr to the value associated with each element of Labels
714% in OldTree, producing a new tree. OldTree must have been produced
715% either by raakau or by incdec, Labels must be in ascedning order,
716% and must be a subset of the labels of the tree.
717
718incdec(OldTree, Labels, Incr, NewTree) :-
719 incdec(OldTree, NewTree, Labels, _, Incr).
720
721
722incdec(t(V,M), t(V,N), [V|L], L, I) :- incdec,
723 N is M+I.
724incdec(t(V,W,M,L1,R1), t(V,W,N,L2,R2), Li, Lo, I) :-
725 ( Li = [Hi|_], Hi @< V, !,
726 incdec(L1, L2, Li, Lm, I)
727 ; L2 = L1, Lm = Li
728 ),
729 ( Lm = [V|Lr], ,
730 N is M+I
731 ; Lr = Lm, N = M
732 ),
733 ( Lr = [Hr|_], Hr @=< W, ,
734 incdec(R1, R2, Lr, Lo, I)
735 ; R2 = R1, Lo = Lr
736 ).
737/* END UNUSED CODE */
738
739
740
741top_sort(Graph, Sorted) :-
742 vertices_and_zeros(Graph, Vertices, Counts0),
743 count_edges(Graph, Vertices, Counts0, Counts1),
744 select_zeros(Counts1, Vertices, Zeros),
745 top_sort(Zeros, Sorted, Graph, Vertices, Counts1).
746
747top_sort(Graph, Sorted0, Sorted) :-
748 vertices_and_zeros(Graph, Vertices, Counts0),
749 count_edges(Graph, Vertices, Counts0, Counts1),
750 select_zeros(Counts1, Vertices, Zeros),
751 top_sort(Zeros, Sorted, Sorted0, Graph, Vertices, Counts1).
752
753
754vertices_and_zeros([], [], []) :- vertices_and_zeros.
755vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :-
756 vertices_and_zeros(Graph, Vertices, Zeros).
757
758
759count_edges([], _, Counts, Counts) :- count_edges.
760count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :-
761 incr_list(Neibs, Vertices, Counts0, Counts1),
762 count_edges(Graph, Vertices, Counts1, Counts2).
763
764
765incr_list([], _, Counts, Counts) :- incr_list.
766incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :- V1 == V2, incr_list,
767 N is M+1,
768 incr_list(Neibs, Vertices, Counts0, Counts1).
769incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :-
770 incr_list(Neibs, Vertices, Counts0, Counts1).
771
772
773select_zeros([], [], []) :- select_zeros.
774select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :- select_zeros,
775 select_zeros(Counts, Vertices, Zeros).
776select_zeros([_|Counts], [_|Vertices], Zeros) :-
777 select_zeros(Counts, Vertices, Zeros).
778
779
780
781top_sort([], [], Graph, _, Counts) :- top_sort,
782 vertices_and_zeros(Graph, _, Counts).
783top_sort([Zero|Zeros], [Zero|Sorted], Graph, Vertices, Counts1) :-
784 graph_memberchk(Zero-Neibs, Graph),
785 decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
786 top_sort(NewZeros, Sorted, Graph, Vertices, Counts2).
787
788top_sort([], Sorted0, Sorted0, Graph, _, Counts) :- top_sort,
789 vertices_and_zeros(Graph, _, Counts).
790top_sort([Zero|Zeros], [Zero|Sorted], Sorted0, Graph, Vertices, Counts1) :-
791 graph_memberchk(Zero-Neibs, Graph),
792 decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
793 top_sort(NewZeros, Sorted, Sorted0, Graph, Vertices, Counts2).
794
795graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :- Element1 == Element2, graph_memberchk,
796 Edges = Edges2.
797graph_memberchk(Element, [_|Rest]) :-
798 graph_memberchk(Element, Rest).
799
800
801decr_list([], _, Counts, Counts, Zeros, Zeros) :- decr_list.
802decr_list([V1|Neibs], [V2|Vertices], [1|Counts1], [0|Counts2], Zi, Zo) :- V1 == V2, decr_list,
803 decr_list(Neibs, Vertices, Counts1, Counts2, [V2|Zi], Zo).
804decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Zi, Zo) :- V1 == V2, decr_list,
805 M is N-1,
806 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
807decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :-
808 decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
809
810
811
812neighbors(V,[V0-Neig|_],Neig) :- V == V0, neighbors.
813neighbors(V,[_|G],Neig) :-
814 neighbors(V,G,Neig).
815
816neighbours(V,[V0-Neig|_],Neig) :- V == V0, neighbours.
817neighbours(V,[_|G],Neig) :-
818 neighbours(V,G,Neig).
819
820
821%
822% Simple two-step algorithm. You could be smarter, I suppose.
823%
824complement(G, NG) :-
825 vertices(G,Vs),
826 complement(G,Vs,NG).
827
828complement([], _, []).
829complement([V-Ns|G], Vs, [V-INs|NG]) :-
830 ord_add_element(Ns,V,Ns1),
831 ord_subtract(Vs,Ns1,INs),
832 complement(G, Vs, NG).
833
834
835
836reachable(N, G, Rs) :-
837 reachable([N], G, [N], Rs).
838
839reachable([], _, Rs, Rs).
840reachable([N|Ns], G, Rs0, RsF) :-
841 neighbours(N, G, Nei),
842 ord_union(Rs0, Nei, Rs1, D),
843 append(Ns, D, Nsi),
844 reachable(Nsi, G, Rs1, RsF).
845
846%% ugraph_union(+Set1, +Set2, ?Union)
847%
848% Is true when Union is the union of Set1 and Set2. This code is a
849% copy of set union
850
851ugraph_union(Set1, [], Set1) :- ugraph_union.
852ugraph_union([], Set2, Set2) :- ugraph_union.
853ugraph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :-
854 compare(Order, Head1, Head2),
855 ugraph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union).
856
857ugraph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :-
858 ord_union(E1, E2, Es),
859 ugraph_union(Tail1, Tail2, Union).
860ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
861 ugraph_union(Tail1, [Head2|Tail2], Union).
862ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
863 ugraph_union([Head1|Tail1], Tail2, Union).
864
865%% @}
866
867
module(+M)
sort(+ L,- S)
use_module( +Files )
nonvar( T)
var( T)
append(? List1,? List2,? List3)
length(? L,? S)
member(?Element, ?Set) is true when Set is a list, and Element occurs in it
memberchk(+ Element, + Set)
ord_add_element(+ Set1, + Element, ? Set2)
ord_subtract(+ Set1, + Set2, ? Difference)
ord_union(+ Set1, + Set2, ? Union)
ord_union(+ Set1, + Set2, ? Union, ? Diff)
add_edges(+ Graph, + Edges, - NewGraph)
add_vertices(+ Graph, + Vertices, - NewGraph)
complement(+ Graph, - NewGraph)
compose(+ LeftGraph, + RightGraph, - NewGraph)
del_edges(+ Graph, + Edges, - NewGraph)
del_vertices(+ Graph, + Vertices, - NewGraph)
edges(+ Graph, - Edges)
neighbors(+ Vertex, + Graph, - Vertices)
neighbours(+ Vertex, + Graph, - Vertices)
raakau(Vertices, InitialValue, Tree)
reachable(+ Node, + Graph, - Vertices)
top_sort(+ Graph, - Sort)
top_sort(+ Graph, - Sort0, - Sort)
transitive_closure(+ Graph, + Closure)
transpose(+ Graph, - NewGraph)
vertices(+ Graph, - Vertices)
vertices_edges_to_ugraph(+ Vertices, + Edges, - Graph)