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