YAP 7.1.0
wdgraphs.yap
Go to the documentation of this file.
1/**
2 * @file wdgraphs.yap
3 * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
4 * @date 2006
5 *
6 *
7*/
8
9/**
10 * @defgroup wdgraphs Weighted Directed Graphs
11 * @ingroup YAPLibrary
12 *
13 * @brief Weighted Directed Graph Processing Utilities.
14 *
15 * @{
16 *
17 */
18
19
20:- module( wdgraphs,
21 [
22 wdgraph_new/1,
23 wdgraph_add_edge/5,
24 wdgraph_add_edges/3,
25 wdgraph_add_vertices_and_edges/4,
26 wdgraph_del_edge/5,
27 wdgraph_del_edges/3,
28 wdgraph_del_vertex/3,
29 wdgraph_del_vertices/3,
30 wdgraph_edge/4,
31 wdgraph_to_dgraph/2,
32 dgraph_to_wdgraph/2,
33 wdgraph_neighbors/3,
34 wdgraph_neighbours/3,
35 wdgraph_wneighbors/3,
36 wdgraph_wneighbours/3,
37 wdgraph_transpose/2,
38 wdgraph_transitive_closure/2,
39 wdgraph_symmetric_closure/2,
40 wdgraph_top_sort/2,
41 wdgraph_min_path/5,
42 wdgraph_min_paths/3,
43 wdgraph_max_path/5,
44 wdgraph_path/3,
45 wdgraph_reachable/3]).
46
47
48:- dgraph_add_vertex/3dgraph_add_vertices/3dgraph_vertices/2dgraph_edges/2reexport(library(dgraphs),
49 [ as wdgraph_add_vertex,
50 as wdgraph_add_vertices,
51 as wdgraph_vertices,
52 as wdgraph_edges
53 ]).
54
55
56:- dgraph_top_sort/2dgraph_path/3use_module(library(dgraphs),
57 [
58 ,
59
60 ]
61 ).
62
63:- rb_new/1rb_empty/1rb_lookup/3rb_apply/4rb_insert/4rb_visit/2rb_keys/2rb_delete/3rb_map/3rb_clone/3rb_clone/4rb_update/5ord_list_to_rbtree/2use_module(library(rbtrees),
64 [,
65 ,
66 ,
67 ,
68 ,
69 ,
70 ,
71 ,
72 ,
73 ,
74 ,
75 ,
76 ]).
77
78:- ord_insert/3use_module(library(ordsets),
79 []).
80
81:- empty_heap/1add_to_heap/4get_from_heap/4use_module(library(heaps),
82 [
83 ,
84 ,
85
86 ]).
87
88wdgraph_new(Vertices) :-
89 rb_new(Vertices).
90
91wdgraph_add_vertices_and_edges(Vs0,Vertices,Edges,Vs2) :-
92 wdgraph_add_vertices(Vs0, Vertices, Vs1),
93 wdgraph_add_edges(Vs1, Edges, Vs2).
94
95
96wdgraph_add_edge(Vs0,V1,V2,Weight,Vs2) :-
97 wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1),
98 dgraph_add_vertex(Vs1,V2,Vs2).
99
100wdgraph_add_edges(V0, Edges, VF) :-
101 rb_empty(V0), rb_empty,
102 sort(Edges,SortedEdges),
103 all_vertices_in_wedges(SortedEdges,Vertices),
104 sort(Vertices,SortedVertices),
105 edges2wgraphl(SortedVertices, SortedEdges, GraphL),
106 ord_list_to_rbtree(GraphL, VF).
107wdgraph_add_edges(G0, Edges, GF) :-
108 sort(Edges,SortedEdges),
109 all_vertices_in_wedges(SortedEdges,Vertices),
110 sort(Vertices,SortedVertices),
111 add_edges(SortedVertices,SortedEdges, G0, GF).
112
113all_vertices_in_wedges([],[]).
114all_vertices_in_wedges([V1-(V2-_)|Edges],[V1,V2|Vertices]) :-
115 all_vertices_in_wedges(Edges,Vertices).
116
117edges2wgraphl([], [], []).
118edges2wgraphl([V|Vertices], [V-(V1-W)|SortedEdges], [V-[V1-W|Children]|GraphL]) :- edges2wgraphl,
119 get_extra_children(SortedEdges,V,Children,RemEdges),
120 edges2wgraphl(Vertices, RemEdges, GraphL).
121edges2wgraphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :-
122 edges2wgraphl(Vertices, SortedEdges, GraphL).
123
124
125add_edges([],[]) --> [].
126add_edges([VA|Vs],[VB-(V1-W)|Es]) --> { VA == VB }, ,
127 { get_extra_children(Es,VA,Children,REs) },
128 wdgraph_update_vertex(VA,[V1-W|Children]),
129 add_edges(Vs,REs).
130add_edges([V|Vs],Es) --> add_edges,
131 wdgraph_update_vertex(V,[]),
132 add_edges(Vs,Es).
133
134get_extra_children([VA-(C-W)|Es],VB,[C-W|Children],REs) :- VA == VB, get_extra_children,
135 get_extra_children(Es,VB,Children,REs).
136get_extra_children(Es,_,[],Es).
137
138
139wdgraph_update_vertex(V,Edges,WG0,WGF) :-
140 rb_update(WG0, V, Edges0, EdgesF, WGF), rb_update,
141 key_union(Edges, Edges0, EdgesF).
142wdgraph_update_vertex(V,Edges,WG0,WGF) :-
143 rb_insert(WG0, V, Edges, WGF).
144
145key_union([], [], []) :- key_union.
146key_union([], [C|Children], [C|Children]).
147key_union([C|Children], [], [C|Children]) :- key_union.
148key_union([K-W|ToAdd], [K1-W1|Children0], NewUnion) :-
149 ( K == K1 ->
150 NewUnion = [K-W|NewChildren],
151 key_union(ToAdd, Children0, NewChildren)
152 ;
153 K1 @< K ->
154 NewUnion = [K1-W1|NewChildren],
155 key_union([K-W|ToAdd], Children0, NewChildren)
156 ;
157 NewUnion = [K-W|NewChildren],
158 key_union(ToAdd, [K1-W1|Children0], NewChildren)
159 ).
160
161wdgraph_new_edge(V1,V2,W,Vs0,Vs) :-
162 rb_apply(Vs0, V1, insert_edge(V2,W), Vs), rb_apply.
163wdgraph_new_edge(V1,V2,W,Vs0,Vs) :-
164 rb_insert(Vs0,V1,[V2-W],Vs).
165
166insert_edge(V2, W, Children0, Children) :-
167 ord_insert(Children0,V2-W,Children).
168
169wdgraph_top_sort(WG,Q) :-
170 wdgraph_to_dgraph(WG, G),
171 dgraph_top_sort(G, Q).
172
173wgraph_to_wdgraph(UG, DG) :-
174 ord_list_to_rbtree(UG, DG).
175
176wdgraph_to_wgraph(DG, UG) :-
177 rb_visit(DG, UG).
178
179wdgraph_edge(N1, N2, W, G) :-
180 rb_lookup(N1, Ns, G),
181 find_edge(N2-W, Ns).
182
183find_edge(N-W,[N1-W|_]) :- N == N1, find_edge.
184find_edge(El,[_|Edges]) :-
185 find_edge(El,Edges).
186
187wdgraph_del_edge(Vs0, V1, V2, W, Vs) :-
188 rb_update(Vs0, V1, Children0, NewChildren, Vs),
189 del_edge(Children0, V2, W, NewChildren).
190
191% I assume first argument is subset of second.
192del_edge([K-W|Children], K1, W1, NewChildren) :-
193 ( K == K1 ->
194 W = W1,
195 Children = NewChildren
196 ;
197 % K1 @< K
198 NewChildren = [K-W|ChildrenLeft],
199 del_edge(Children, K1, W1, ChildrenLeft)
200 ).
201
202wdgraph_del_edges(G0, Edges, GF) :-
203 sort(Edges,SortedEdges),
204 continue_del_edges(SortedEdges, G0, GF).
205
206continue_del_edges([]) --> [].
207continue_del_edges([V-V1|Es]) --> continue_del_edges,
208 { get_extra_children(Es,V,Children,REs) },
209 contract_vertex(V,[V1|Children]),
210 continue_del_edges(REs).
211
212contract_vertex(V,Children, Vs0, Vs) :-
213 rb_update(Vs0, V, Children0, NewChildren, Vs),
214 del_vertices(Children, Children0, NewChildren).
215
216% I assume first argument is subset of second.
217del_vertices(Children, [], Children).
218del_vertices([K1-W1|Children0], [K-W|ToDel], NewChildren) :-
219 ( K == K1 ->
220 W = W1,
221 del_vertices(Children0, ToDel, NewChildren)
222 ;
223 % K1 @< K
224 NewChildren = [K1-W1|ChildrenLeft],
225 del_vertices(Children0, [K-W|ToDel], ChildrenLeft)
226 ).
227
228wdgraph_del_vertex(Vs0, V, Vsf) :-
229 rb_delete(Vs0, V, Vs1),
230 rb_map(Vs1, delete_wedge(V), Vsf).
231
232delete_wedge(_, [], []).
233delete_wedge(V, [K-W|Children], NewChildren) :-
234 ( K == V ->
235 NewChildren = Children
236 ;
237 K @< V ->
238 NewChildren = [K-W|Children2],
239 delete_wedge(V, Children, Children2)
240 ;
241 Children = NewChildren
242 ).
243
244wdgraph_del_vertices(G0, Vs, GF) :-
245 sort(Vs,SortedVs),
246 delete_all(SortedVs, G0, G1),
247 delete_remaining_edges(SortedVs, G1, GF).
248
249% it would be nice to be able to delete a set of elements from an RB tree
250% but I don't how to do it yet.
251delete_all([]) --> [].
252delete_all([V|Vs],Vs0,Vsf) :-
253 rb_delete(Vs0, V, Vsi),
254 delete_all(Vs,Vsi,Vsf).
255
256delete_remaining_edges(SortedVs,Vs0,Vsf) :-
257 rb_map(Vs0, del_possible_edges(SortedVs), Vsf).
258
259del_possible_edges([], [], []).
260del_possible_edges([], [C|Children], [C|Children]).
261del_possible_edges([_|_], [], []).
262del_possible_edges([K|ToDel], [K1-W1|Children0], NewChildren) :-
263 ( K == K1 ->
264 del_possible_edges(ToDel, Children0, NewChildren)
265 ;
266 K1 @< K ->
267 NewChildren = [K1-W1|ChildrenLeft],
268 del_possible_edges([K|ToDel], Children0, ChildrenLeft)
269 ;
270 del_possible_edges(ToDel, [K1-W1|Children0], NewChildren)
271 ).
272
273wdgraph_to_dgraph(WG, DG) :-
274 rb_clone(WG, EdgesList0, DG, EdgeList),
275 cvt_wedges(EdgesList0, EdgeList).
276
277cvt_wedges([], []).
278cvt_wedges([V-WEs|EdgesList0], [V-Es|EdgesList]) :-
279 cvt_wneighbs(WEs, Es),
280 cvt_wedges(EdgesList0, EdgesList).
281
282cvt_wneighbs([], []).
283cvt_wneighbs([V-_|WEs], [V|Es]) :-
284 cvt_wneighbs(WEs, Es).
285
286dgraph_to_wdgraph(DG, WG) :-
287 rb_clone(DG, EdgesList0, WG, EdgesList),
288 cvt_edges(EdgesList0, EdgesList).
289
290cvt_edges([], []).
291cvt_edges([V-Es|EdgesList0], [V-WEs|WEdgeList]) :-
292 cvt_neighbs(Es, WEs),
293 cvt_edges(EdgesList0, WEdgeList).
294
295cvt_neighbs([], []).
296cvt_neighbs([V|WEs], [V-1|Es]) :-
297 cvt_neighbs(WEs, Es).
298
299wdgraph_neighbors(V, WG, Neighbors) :-
300 rb_lookup(V, EdgesList0, WG),
301 cvt_wneighbs(EdgesList0, Neighbors).
302
303wdgraph_neighbours(V, WG, Neighbors) :-
304 rb_lookup(V, EdgesList0, WG),
305 cvt_wneighbs(EdgesList0, Neighbors).
306
307wdgraph_wneighbors(V, WG, Neighbors) :-
308 rb_lookup(V, Neighbors, WG).
309
310wdgraph_wneighbours(V, WG, Neighbors) :-
311 rb_lookup(V, Neighbors, WG).
312
313wdgraph_transpose(Graph, TGraph) :-
314 rb_visit(Graph, Edges),
315 rb_clone(Graph, TGraph, NewNodes),
316 wtedges(Edges,UnsortedTEdges),
317 sort(UnsortedTEdges,TEdges),
318 fill_nodes(NewNodes,TEdges).
319
320wtedges([],[]).
321wtedges([V-Vs|Edges],TEdges) :-
322 fill_wtedges(Vs, V, TEdges, TEdges0),
323 wtedges(Edges,TEdges0).
324
325fill_wtedges([], _, TEdges, TEdges).
326fill_wtedges([V1-W|Vs], V, [V1-(V-W)|TEdges], TEdges0) :-
327 fill_wtedges(Vs, V, TEdges, TEdges0).
328
329
330fill_nodes([],[]).
331fill_nodes([V-[Child|MoreChildren]|Nodes],[V-Child|Edges]) :- fill_nodes,
332 get_extra_children(Edges,V,MoreChildren,REdges),
333 fill_nodes(Nodes,REdges).
334fill_nodes([_-[]|Edges],TEdges) :-
335 fill_nodes(Edges,TEdges).
336
337wdgraph_transitive_closure(G,Closure) :-
338 dgraph_edges(G,Edges),
339 continue_closure(Edges,G,Closure).
340
341continue_closure([], Closure, Closure) :- continue_closure.
342continue_closure(Edges, G, Closure) :-
343 transit_wgraph(Edges,G,NewEdges),
344 wdgraph_add_edges(G, NewEdges, GN),
345 continue_closure(NewEdges, GN, Closure).
346
347transit_wgraph([],_,[]).
348transit_wgraph([V-(V1-W)|Edges],G,NewEdges) :-
349 rb_lookup(V1, GrandChildren, G),
350 transit_wgraph2(GrandChildren, V, W, G, NewEdges, MoreEdges),
351 transit_wgraph(Edges, G, MoreEdges).
352
353transit_wgraph2([], _, _, _, NewEdges, NewEdges).
354transit_wgraph2([GC|GrandChildren], V, W, G, NewEdges, MoreEdges) :-
355 is_edge(V,GC,G), is_edge,
356 transit_wgraph2(GrandChildren, V, W, G, NewEdges, MoreEdges).
357transit_wgraph2([GC-W1|GrandChildren], V, W2, G, [V-(GC-W)|NewEdges], MoreEdges) :-
358 W is W1+W2,
359 transit_wgraph2(GrandChildren, V, W2, G, NewEdges, MoreEdges).
360
361is_edge(V1,V2,G) :-
362 rb_lookup(V1,Children,G),
363 find_edge(V2-_, Children).
364
365wdgraph_symmetric_closure(G,S) :-
366 dgraph_edges(G, WEdges),
367 invert_wedges(WEdges, InvertedWEdges),
368 wdgraph_add_edges(G, InvertedWEdges, S).
369
370invert_wedges([], []).
371invert_wedges([V1-(V2-W)|WEdges], [V2-(V1-W)|InvertedWEdges]) :-
372 invert_wedges(WEdges, InvertedWEdges).
373
374wdgraph_min_path(V1, V2, WGraph, Path, Cost) :-
375 rb_new(Status0),
376 rb_lookup(V1, Edges, WGraph),
377 rb_insert(Status0, V1, V2, Status),
378 empty_heap(H0),
379 queue_edges(Edges, V1, 0, H0, H1),
380 dijkstra(H1, V2, WGraph, Status, [], EPath),
381 backtrace(EPath, V2, [V2], Path, 0, Cost).
382
383wdgraph_max_path(V1, V2, WGraph0, Path, Cost) :-
384 rb_clone(WGraph0, Edges0, WGraph, Edges),
385 inv_costs(Edges0, Edges),
386 wdgraph_min_path(V1, V2, WGraph, Path, NCost),
387 Cost is -NCost.
388
389inv_costs([], []).
390inv_costs([V-Es|Edges0], [V-NEs|Edges]) :-
391 inv_costs2(Es,NEs),
392 inv_costs(Edges0, Edges).
393
394inv_costs2([],[]).
395inv_costs2([V-E|Es],[V-NE|NEs]) :-
396 NE is -E,
397 inv_costs2(Es,NEs).
398
399queue_edges([], _, _, H, H).
400queue_edges([V-W|Edges], V0, D0, H, NH) :-
401 D is W+D0,
402 add_to_heap(H, D, e(V0,V,W), HI),
403 queue_edges(Edges, V0, D0, HI, NH).
404
405dijkstra(H0, V2, WGraph, Status, Path0, PathF) :-
406 get_from_heap(H0, D, e(V0, V, W), H1),
407 continue_dijkstra(H1, V2, WGraph, Status, Path0, PathF, D, V0, V, W).
408
409continue_dijkstra(_, V2, _, _, Path0, [e(V0,V2,W)|Path0], _, V0, V, W) :- V == V2, continue_dijkstra.
410continue_dijkstra(H1, V2, WGraph, Status, Path0, PathF, _, _, V, _) :-
411 rb_lookup(V, _, Status), rb_lookup,
412 % pick some other node.
413 dijkstra(H1, V2, WGraph, Status, Path0, PathF).
414continue_dijkstra(H1, V2, WGraph, Status0, Path0, PathF, D, V0, V, W) :-
415 rb_insert(Status0, V, V0, Status),
416 rb_lookup(V, Edges, WGraph),
417 queue_edges(Edges, V, D, H1, H2),
418 dijkstra(H2, V2, WGraph, Status, [e(V0,V,W)|Path0], PathF).
419
420
421backtrace([], _, Path, Path, Cost, Cost).
422backtrace([e(V0,V,C)|EPath], V1, Path0, Path, Cost0, Cost) :-
423 V == V1, backtrace,
424 CostI is C+Cost0,
425 backtrace(EPath, V0, [V0|Path0], Path, CostI, Cost).
426backtrace([_|EPath], V1, Path0, Path, Cost0, Cost) :-
427 backtrace(EPath, V1, Path0, Path, Cost0, Cost).
428
429
430wdgraph_min_paths(V1, WGraph, T) :-
431 rb_new(Status0),
432 rb_lookup(V1, Edges, WGraph),
433 rb_insert(Status0, V1, V1, Status),
434 empty_heap(H0),
435 queue_edges(Edges, V1, 0, H0, H1),
436 dijkstra(H1, WGraph, Status, [], EPath),
437 rb_empty(T0),
438 wdgraph_add_edges(T0, EPath, T).
439
440
441dijkstra(H0, WGraph, Status, Path0, PathF) :-
442 get_from_heap(H0, D, e(V0, V, W), H1), get_from_heap,
443 continue_dijkstra(H1, WGraph, Status, Path0, PathF, D, V0, V, W).
444dijkstra(_, _, _, Path, Path).
445
446continue_dijkstra(H1, WGraph, Status, Path0, PathF, _, _, V, _) :-
447 rb_lookup(V, _, Status), rb_lookup,
448 % pick some other node.
449 dijkstra(H1, WGraph, Status, Path0, PathF).
450continue_dijkstra(H1, WGraph, Status0, Path0, PathF, D, V0, V, W) :-
451 rb_insert(Status0, V, V0, Status),
452 rb_lookup(V, Edges, WGraph),
453 queue_edges(Edges, V, D, H1, H2),
454 dijkstra(H2, WGraph, Status, [V0-(V-W)|Path0], PathF).
455
456wdgraph_path(V, WG, P) :-
457 wdgraph_to_dgraph(WG, G),
458 dgraph_path(V, G, P).
459
460wdgraph_reachable(V, G, Edges) :-
461 rb_lookup(V, Children, G),
462 ord_list_to_rbtree([V-[]],Done0),
463 reachable(Children, Done0, _, G, Edges, []).
464
465reachable([], Done, Done, _, Edges, Edges).
466reachable([V-_|Vertices], Done0, DoneF, G, EdgesF, Edges0) :-
467 rb_lookup(V,_, Done0), rb_lookup,
468 reachable(Vertices, Done0, DoneF, G, EdgesF, Edges0).
469reachable([V-_|Vertices], Done0, DoneF, G, [V|EdgesF], Edges0) :-
470 rb_lookup(V, Kids, G),
471 rb_insert(Done0, V, [], Done1),
472 reachable(Kids, Done1, DoneI, G, EdgesF, EdgesI),
473 reachable(Vertices, DoneI, DoneF, G, EdgesI, Edges0).
474
475%% @}
476
sort/2
sort(+ L,- S)
reexport/1
reexport(+F)
use_module/1
use_module( +Files )
dgraph_add_vertex/3
dgraph_add_vertex(+ Graph, + Vertex, - NewGraph)
dgraph_add_vertices/3
dgraph_add_vertices(+ Graph, + Vertices, - NewGraph)
dgraph_edges/2
dgraph_edges(+ Graph, - Edges)
dgraph_path/3
dgraph_path(+ Vertex, + Graph, ? Path)
dgraph_top_sort/2
dgraph_top_sort(+ Graph, - Vertices)
dgraph_vertices/2
dgraph_vertices(+ Graph, - Vertices)
add_to_heap/4
add_to_heap(OldHeap, Key, Datum, NewHeap)
empty_heap/1
empty_heap(? Heap)
ord_insert/3
ord_insert(+ Set1, + Element, ? Set2)
rb_apply/4
rb_apply(+T, +Key, :G, -TN)
rb_clone/3
rb_clone(+ T,+ NT,+ Nodes)
rb_delete/3
rb_delete(+T, +Key, -TN)
rb_empty/1
rb_empty(?T)
rb_insert/4
rb_insert(+ T0,+ Key,? Value,+ TF)
rb_keys/2
rb_keys(+ T,+ Keys)
rb_lookup/3
rb_lookup(+Key, -Value, +T)
rb_map/3
rb_map(+ T,+ G,- TN)
rb_new/1
rb_new(-T)
rb_update/5
rb_update(+T, +Key, ?OldVal, +NewVal, -TN)
rb_visit/2
rb_visit(+ T,- Pairs)
del_vertices/3
del_vertices(+ Graph, + Vertices, - NewGraph)