1%   File   : dgraphs.yap
2%   Author : Vitor Santos Costa
3%   Updated: 2006
4%   Purpose: Directed Graph Processing Utilities.
5
6:- module( dgraphs,
7	   [
8	    dgraph_vertices/2,
9	    dgraph_edge/3,
10	    dgraph_edges/2,
11	    dgraph_add_vertex/3,
12	    dgraph_add_vertices/3,
13	    dgraph_del_vertex/3,
14	    dgraph_del_vertices/3,
15	    dgraph_add_edge/4,
16	    dgraph_add_edges/3,
17	    dgraph_del_edge/4,
18	    dgraph_del_edges/3,
19	    dgraph_to_ugraph/2,
20	    ugraph_to_dgraph/2,
21	    dgraph_neighbors/3,
22	    dgraph_neighbours/3,
23	    dgraph_complement/2,
24	    dgraph_transpose/2,
25	    dgraph_compose/3,
26	    dgraph_transitive_closure/2,
27	    dgraph_symmetric_closure/2,
28	    dgraph_top_sort/2,
29	    dgraph_top_sort/3,
30	    dgraph_min_path/5,
31	    dgraph_max_path/5,
32	    dgraph_min_paths/3,
33	    dgraph_isomorphic/4,
34	    dgraph_path/3,
35	    dgraph_reachable/3
36	]).
37
38:- reexport(library(rbtrees),
39	[rb_new/1 as dgraph_new]).
40
41:- use_module(library(rbtrees),
42	[rb_empty/1,
43	 rb_lookup/3,
44	 rb_apply/4,
45	 rb_insert/4,
46	 rb_visit/2,
47	 rb_keys/2,
48	 rb_delete/3,
49	 rb_map/3,
50	 rb_clone/3,
51	 ord_list_to_rbtree/2]).
52
53:- use_module(library(ordsets),
54	[ord_insert/3,
55	 ord_union/3,
56	 ord_subtract/3,
57	 ord_del_element/3,
58	 ord_memberchk/2]).
59
60:- use_module(library(wdgraphs),
61	[dgraph_to_wdgraph/2,
62	 wdgraph_min_path/5,
63	 wdgraph_max_path/5,
64	 wdgraph_min_paths/3]).
65
66dgraph_add_edge(Vs0,V1,V2,Vs2) :-
67	dgraph_new_edge(V1,V2,Vs0,Vs1),
68	dgraph_add_vertex(Vs1,V2,Vs2).
69
70dgraph_add_edges(V0, Edges, VF) :-
71	rb_empty(V0), !,
72	sort(Edges,SortedEdges),
73	all_vertices_in_edges(SortedEdges,Vertices),
74	sort(Vertices,SortedVertices),
75	edges2graphl(SortedVertices, SortedEdges, GraphL),
76	ord_list_to_rbtree(GraphL, VF).
77dgraph_add_edges(G0, Edges, GF) :-
78	sort(Edges,SortedEdges),
79	all_vertices_in_edges(SortedEdges,Vertices),
80	sort(Vertices,SortedVertices),
81	dgraph_add_edges(SortedVertices,SortedEdges, G0, GF).
82
83all_vertices_in_edges([],[]).
84all_vertices_in_edges([V1-V2|Edges],[V1,V2|Vertices]) :-
85	all_vertices_in_edges(Edges,Vertices).
86
87edges2graphl([], [], []).
88edges2graphl([V|Vertices], [VV-V1|SortedEdges], [V-[V1|Children]|GraphL]) :-
89	V == VV, !,
90	get_extra_children(SortedEdges,VV,Children,RemEdges),
91	edges2graphl(Vertices, RemEdges, GraphL).
92edges2graphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :-
93	edges2graphl(Vertices, SortedEdges, GraphL).
94
95
96dgraph_add_edges([],[]) --> [].
97dgraph_add_edges([V|Vs],[V0-V1|Es]) --> { V == V0 }, !,
98	{ get_extra_children(Es,V,Children,REs) },
99	dgraph_update_vertex(V,[V1|Children]),
100	dgraph_add_edges(Vs,REs).
101dgraph_add_edges([V|Vs],Es) --> !,
102	dgraph_update_vertex(V,[]),
103	dgraph_add_edges(Vs,Es).
104
105get_extra_children([V-C|Es],VV,[C|Children],REs) :- V == VV, !,
106	get_extra_children(Es,VV,Children,REs).
107get_extra_children(Es,_,[],Es).
108
109dgraph_update_vertex(V,Children, Vs0, Vs) :-
110	rb_apply(Vs0, V, add_edges(Children), Vs), !.
111dgraph_update_vertex(V,Children, Vs0, Vs) :-
112	rb_insert(Vs0,V,Children,Vs).
113
114add_edges(E0,E1,E) :-
115	ord_union(E0,E1,E).
116
117dgraph_new_edge(V1,V2,Vs0,Vs) :-
118	rb_apply(Vs0, V1, insert_edge(V2), Vs), !.
119dgraph_new_edge(V1,V2,Vs0,Vs) :-
120	rb_insert(Vs0,V1,[V2],Vs).
121
122insert_edge(V2, Children0, Children) :-
123	ord_insert(Children0,V2,Children).
124
125dgraph_add_vertices(G, [], G).
126dgraph_add_vertices(G0, [V|Vs], GF) :-
127	dgraph_add_vertex(G0, V, G1),
128	dgraph_add_vertices(G1, Vs, GF).
129
130
131dgraph_add_vertex(Vs0, V, Vs0) :-
132	rb_lookup(V,_,Vs0), !.
133dgraph_add_vertex(Vs0, V, Vs) :-
134	rb_insert(Vs0, V, [], Vs).
135
136dgraph_edges(Vs,Edges) :-
137	rb_visit(Vs,L0),
138	cvt2edges(L0,Edges).
139
140dgraph_vertices(Vs,Vertices) :-
141	rb_keys(Vs,Vertices).
142
143cvt2edges([],[]).
144cvt2edges([V-Children|L0],Edges) :-
145	children2edges(Children,V,Edges,Edges0),
146	cvt2edges(L0,Edges0).
147
148children2edges([],_,Edges,Edges).
149children2edges([Child|L0],V,[V-Child|EdgesF],Edges0) :-
150	children2edges(L0,V,EdgesF,Edges0).
151
152dgraph_neighbours(V,Vertices,Children) :-
153	rb_lookup(V,Children,Vertices).
154dgraph_neighbors(V,Vertices,Children) :-
155	rb_lookup(V,Children,Vertices).
156
157add_vertices(Graph, [], Graph).
158add_vertices(Graph, [V|Vertices], NewGraph) :-
159	rb_insert(Graph, V, [], IntGraph),
160	add_vertices(IntGraph, Vertices, NewGraph).
161
162
163dgraph_complement(Vs0,VsF) :-
164	dgraph_vertices(Vs0,Vertices),
165	rb_map(Vs0,complement(Vertices),VsF).
166
167complement(Vs,Children,NewChildren) :-
168	ord_subtract(Vs,Children,NewChildren).
169
170dgraph_del_edge(Vs0,V1,V2,Vs1) :-
171	rb_apply(Vs0, V1, delete_edge(V2), Vs1).
172
173dgraph_del_edges(G0, Edges, Gf) :-
174	sort(Edges,SortedEdges),
175	continue_del_edges(SortedEdges, G0, Gf).
176
177continue_del_edges([]) --> [].
178continue_del_edges([V-V1|Es]) --> !,
179	{ get_extra_children(Es,V,Children,REs) },
180	contract_vertex(V,[V1|Children]),
181	continue_del_edges(REs).
182
183contract_vertex(V,Children, Vs0, Vs) :-
184	rb_apply(Vs0, V, del_edges(Children), Vs).
185
186del_edges(ToRemove,E0,E) :-
187	ord_subtract(E0,ToRemove,E).
188
189dgraph_del_vertex(Vs0, V, Vsf) :-
190	rb_delete(Vs0, V, Vs1),
191	rb_map(Vs1, delete_edge(V), Vsf).
192
193delete_edge(Edges0, V, Edges) :-
194	ord_del_element(Edges0, V, Edges).
195
196dgraph_del_vertices(G0, Vs, GF) :-
197	sort(Vs,SortedVs),
198	delete_all(SortedVs, G0, G1),
199	delete_remaining_edges(SortedVs, G1, GF).
200
201% it would be nice to be able to delete a set of elements from an RB tree
202% but I don't how to do it yet.
203delete_all([]) --> [].
204delete_all([V|Vs],Vs0,Vsf) :-
205	rb_delete(Vs0, V, Vsi),
206	delete_all(Vs,Vsi,Vsf).
207
208delete_remaining_edges(SortedVs,Vs0,Vsf) :-
209	rb_map(Vs0, del_edges(SortedVs), Vsf).
210
211dgraph_transpose(Graph, TGraph) :-
212	rb_visit(Graph, Edges),
213	rb_clone(Graph, TGraph, NewNodes),
214	tedges(Edges,UnsortedTEdges),
215	sort(UnsortedTEdges,TEdges),
216	fill_nodes(NewNodes,TEdges).
217
218tedges([],[]).
219tedges([V-Vs|Edges],TEdges) :-
220	fill_tedges(Vs, V, TEdges, TEdges0),
221	tedges(Edges,TEdges0).
222
223fill_tedges([], _, TEdges, TEdges).
224fill_tedges([V1|Vs], V, [V1-V|TEdges], TEdges0) :-
225	fill_tedges(Vs, V, TEdges, TEdges0).
226
227
228fill_nodes([],[]).
229fill_nodes([V-[Child|MoreChildren]|Nodes],[V-Child|Edges]) :- !,
230	get_extra_children(Edges,V,MoreChildren,REdges),
231	fill_nodes(Nodes,REdges).
232fill_nodes([_-[]|Edges],TEdges) :-
233	fill_nodes(Edges,TEdges).
234
235dgraph_compose(T1,T2,CT) :-
236	rb_visit(T1,Nodes),
237	compose(Nodes,T2,NewNodes),
238	dgraph_new(CT0),
239	dgraph_add_edges(CT0,NewNodes,CT).
240
241compose([],_,[]).
242compose([V-Children|Nodes],T2,NewNodes) :-
243	compose2(Children,V,T2,NewNodes,NewNodes0),
244	compose(Nodes,T2,NewNodes0).
245
246compose2([],_,_,NewNodes,NewNodes).
247compose2([C|Children],V,T2,NewNodes,NewNodes0) :-
248	rb_lookup(C, GrandChildren, T2),
249	compose3(GrandChildren, V, NewNodes,NewNodesI),
250	compose2(Children,V,T2,NewNodesI,NewNodes0).
251
252compose3([], _, NewNodes, NewNodes).
253compose3([GC|GrandChildren], V, [V-GC|NewNodes], NewNodes0) :-
254	compose3(GrandChildren, V, NewNodes, NewNodes0).
255
256dgraph_transitive_closure(G,Closure) :-
257	dgraph_edges(G,Edges),
258	continue_closure(Edges,G,Closure).
259
260continue_closure([], Closure, Closure) :- !.
261continue_closure(Edges, G, Closure) :-
262	transit_graph(Edges,G,NewEdges),
263	dgraph_add_edges(G, NewEdges, GN),
264	continue_closure(NewEdges, GN, Closure).
265
266transit_graph([],_,[]).
267transit_graph([V-V1|Edges],G,NewEdges) :-
268	rb_lookup(V1, GrandChildren, G),
269	transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges),
270	transit_graph(Edges, G, MoreEdges).
271
272transit_graph2([], _, _, NewEdges, NewEdges).
273transit_graph2([GC|GrandChildren], V, G, NewEdges, MoreEdges) :-
274	is_edge(V,GC,G), !,
275	transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges).
276transit_graph2([GC|GrandChildren], V, G, [V-GC|NewEdges], MoreEdges) :-
277	transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges).
278
279is_edge(V1,V2,G) :-
280	rb_lookup(V1,Children,G),
281	ord_memberchk(V2, Children).
282
283dgraph_symmetric_closure(G,S) :-
284	dgraph_edges(G, Edges),
285	invert_edges(Edges, InvertedEdges),
286	dgraph_add_edges(G, InvertedEdges, S).
287
288invert_edges([], []).
289invert_edges([V1-V2|Edges], [V2-V1|InvertedEdges]) :-
290	invert_edges(Edges, InvertedEdges).
291
292dgraph_top_sort(G, Q) :-
293	dgraph_top_sort(G, Q, []).
294
295dgraph_top_sort(G, Q, RQ0) :-
296	% O(E)
297	rb_visit(G, Vs),
298	% O(E)
299	invert_and_link(Vs, Links, UnsortedInvertedEdges, AllVs, Q),
300	% O(V)
301	rb_clone(G, LinkedG, Links),
302	% O(Elog(E))
303	sort(UnsortedInvertedEdges, InvertedEdges),
304	% O(E)
305	dgraph_vertices(G, AllVs),
306	start_queue(AllVs, InvertedEdges, Q, RQ),
307	continue_queue(Q, LinkedG, RQ, RQ0).
308
309invert_and_link([], [], [], [], []).
310invert_and_link([V-Vs|Edges], [V-NVs|ExtraEdges], UnsortedInvertedEdges, [V|AllVs],[_|Q]) :-
311	inv_links(Vs, NVs, V, UnsortedInvertedEdges, UnsortedInvertedEdges0),
312	invert_and_link(Edges, ExtraEdges, UnsortedInvertedEdges0, AllVs, Q).
313
314inv_links([],[],_,UnsortedInvertedEdges,UnsortedInvertedEdges).
315inv_links([V2|Vs],[l(V2,A,B,S,E)|VLnks],V1,[V2-e(A,B,S,E)|UnsortedInvertedEdges],UnsortedInvertedEdges0) :-
316	inv_links(Vs,VLnks,V1,UnsortedInvertedEdges,UnsortedInvertedEdges0).
317
318dup([], []).
319dup([_|AllVs], [_|Q]) :-
320	dup(AllVs, Q).
321
322start_queue([], [], RQ, RQ).
323start_queue([V|AllVs], [VV-e(S,B,S,E)|InvertedEdges], Q, RQ) :- V == VV, !,
324	link_edges(InvertedEdges, VV, B, S, E, RemainingEdges),
325	start_queue(AllVs, RemainingEdges, Q, RQ).
326start_queue([V|AllVs], InvertedEdges, [V|Q], RQ) :-
327	start_queue(AllVs, InvertedEdges, Q, RQ).
328
329link_edges([V-e(A,B,S,E)|InvertedEdges], VV, A, S, E, RemEdges) :- V == VV, !,
330	link_edges(InvertedEdges, VV, B, S, E, RemEdges).
331link_edges(RemEdges, _, A, _, A, RemEdges).
332
333continue_queue([], _, RQ0, RQ0).
334continue_queue([V|Q], LinkedG, RQ, RQ0) :-
335	rb_lookup(V, Links, LinkedG),
336	close_links(Links, RQ, RQI),
337	% not clear whether I should deleted V from LinkedG
338	continue_queue(Q, LinkedG, RQI, RQ0).
339
340close_links([], RQ, RQ).
341close_links([l(V,A,A,S,E)|Links], RQ, RQ0) :-
342	( S == E -> RQ = [V| RQ1] ; RQ = RQ1),
343	close_links(Links, RQ1, RQ0).
344
345
346ugraph_to_dgraph(UG, DG) :-
347	ord_list_to_rbtree(UG, DG).
348
349dgraph_to_ugraph(DG, UG) :-
350	rb_visit(DG, UG).
351
352
353dgraph_edge(N1, N2, G) :-
354	rb_lookup(N1, Ns, G),
355	ord_memberchk(N2, Ns).
356
357dgraph_min_path(V1, V2, Graph, Path, Cost) :-
358	dgraph_to_wdgraph(Graph, WGraph),
359	wdgraph_min_path(V1, V2, WGraph, Path, Cost).
360
361dgraph_max_path(V1, V2, Graph, Path, Cost) :-
362	dgraph_to_wdgraph(Graph, WGraph),
363	wdgraph_max_path(V1, V2, WGraph, Path, Cost).
364
365dgraph_min_paths(V1, Graph, Paths) :-
366	dgraph_to_wdgraph(Graph, WGraph),
367	wdgraph_min_paths(V1, WGraph, Paths).
368
369dgraph_path(V, G, [V|P]) :-
370	rb_lookup(V, Children, G),
371	ord_del_element(Children, V, Ch),
372	do_path(Ch, G, [V], P).
373
374do_path([], _, _, []).
375do_path([C|Children], G, SoFar, Path) :-
376	do_children([C|Children], G, SoFar, Path).
377
378do_children([V|_], G, SoFar, [V|Path]) :-
379	rb_lookup(V, Children, G),
380	ord_subtract(Children, SoFar, Ch),
381	ord_insert(SoFar, V, NextSoFar),
382	do_path(Ch, G, NextSoFar, Path).
383do_children([_|Children], G, SoFar, Path) :-
384	do_children(Children, G, SoFar, Path).
385
386
387dgraph_isomorphic(Vs, Vs2, G1, G2) :-
388	rb_new(Map0),
389	mapping(Vs,Vs2,Map0,Map),
390	dgraph_edges(G1,Edges),
391	translate_edges(Edges,Map,TEdges),
392	dgraph_new(G20),
393	dgraph_add_vertices(Vs2,G20,G21),
394	dgraph_add_edges(G21,TEdges,G2).
395
396mapping([],[],Map,Map).
397mapping([V1|Vs],[V2|Vs2],Map0,Map) :-
398	rb_insert(Map0,V1,V2,MapI),
399	mapping(Vs,Vs2,MapI,Map).
400
401
402
403translate_edges([],_,[]).
404translate_edges([V1-V2|Edges],Map,[NV1-NV2|TEdges]) :-
405	rb_lookup(V1,NV1,Map),
406	rb_lookup(V2,NV2,Map),
407	translate_edges(Edges,Map,TEdges).
408
409dgraph_reachable(V, G, Edges) :-
410	rb_lookup(V, Children, G),
411	ord_list_to_rbtree([V-[]],Done0),
412	reachable(Children, Done0, _, G, Edges, []).
413
414reachable([], Done, Done, _, Edges, Edges).
415reachable([V|Vertices], Done0, DoneF, G, EdgesF, Edges0) :-
416	rb_lookup(V,_, Done0), !,
417	reachable(Vertices, Done0, DoneF, G, EdgesF, Edges0).
418reachable([V|Vertices], Done0, DoneF, G, [V|EdgesF], Edges0) :-
419	rb_lookup(V, Kids, G),
420	rb_insert(Done0, V, [], Done1),
421	reachable(Kids, Done1, DoneI, G, EdgesF, EdgesI),
422	reachable(Vertices, DoneI, DoneF, G, EdgesI, Edges0).
423