/** * @file wdgraphs.yap * @author VITOR SANTOS COSTA * @date 2006 * * */ :- module( wdgraphs, [ wdgraph_new/1, wdgraph_add_edge/5, wdgraph_add_edges/3, wdgraph_add_vertices_and_edges/4, wdgraph_del_edge/5, wdgraph_del_edges/3, wdgraph_del_vertex/3, wdgraph_del_vertices/3, wdgraph_edge/4, wdgraph_to_dgraph/2, dgraph_to_wdgraph/2, wdgraph_neighbors/3, wdgraph_neighbours/3, wdgraph_wneighbors/3, wdgraph_wneighbours/3, wdgraph_transpose/2, wdgraph_transitive_closure/2, wdgraph_symmetric_closure/2, wdgraph_top_sort/2, wdgraph_min_path/5, wdgraph_min_paths/3, wdgraph_max_path/5, wdgraph_path/3, wdgraph_reachable/3]). /** * @defgroup wdgraphs Weighted Directed Graphs * @ingroup library * * @brief Weighted Directed Graph Processing Utilities. * * @{ * */ :- reexport(library(dgraphs), [dgraph_add_vertex/3 as wdgraph_add_vertex, dgraph_add_vertices/3 as wdgraph_add_vertices, dgraph_vertices/2 as wdgraph_vertices, dgraph_edges/2 as wdgraph_edges ]). :- use_module(library(dgraphs), [ dgraph_top_sort/2, dgraph_path/3 ] ). :- use_module(library(rbtrees), [rb_new/1, rb_empty/1, rb_lookup/3, rb_apply/4, rb_insert/4, rb_visit/2, rb_keys/2, rb_delete/3, rb_map/3, rb_clone/3, rb_clone/4, rb_update/5, ord_list_to_rbtree/2]). :- use_module(library(ordsets), [ord_insert/3]). :- use_module(library(heaps), [ empty_heap/1, add_to_heap/4, get_from_heap/4 ]). wdgraph_new(Vertices) :- rb_new(Vertices). wdgraph_add_vertices_and_edges(Vs0,Vertices,Edges,Vs2) :- wdgraph_add_vertices(Vs0, Vertices, Vs1), wdgraph_add_edges(Vs1, Edges, Vs2). wdgraph_add_edge(Vs0,V1,V2,Weight,Vs2) :- wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1), dgraph_add_vertex(Vs1,V2,Vs2). wdgraph_add_edges(V0, Edges, VF) :- rb_empty(V0), !, sort(Edges,SortedEdges), all_vertices_in_wedges(SortedEdges,Vertices), sort(Vertices,SortedVertices), edges2wgraphl(SortedVertices, SortedEdges, GraphL), ord_list_to_rbtree(GraphL, VF). wdgraph_add_edges(G0, Edges, GF) :- sort(Edges,SortedEdges), all_vertices_in_wedges(SortedEdges,Vertices), sort(Vertices,SortedVertices), add_edges(SortedVertices,SortedEdges, G0, GF). all_vertices_in_wedges([],[]). all_vertices_in_wedges([V1-(V2-_)|Edges],[V1,V2|Vertices]) :- all_vertices_in_wedges(Edges,Vertices). edges2wgraphl([], [], []). edges2wgraphl([V|Vertices], [V-(V1-W)|SortedEdges], [V-[V1-W|Children]|GraphL]) :- !, get_extra_children(SortedEdges,V,Children,RemEdges), edges2wgraphl(Vertices, RemEdges, GraphL). edges2wgraphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :- edges2wgraphl(Vertices, SortedEdges, GraphL). add_edges([],[]) --> []. add_edges([VA|Vs],[VB-(V1-W)|Es]) --> { VA == VB }, !, { get_extra_children(Es,VA,Children,REs) }, wdgraph_update_vertex(VA,[V1-W|Children]), add_edges(Vs,REs). add_edges([V|Vs],Es) --> !, wdgraph_update_vertex(V,[]), add_edges(Vs,Es). get_extra_children([VA-(C-W)|Es],VB,[C-W|Children],REs) :- VA == VB, !, get_extra_children(Es,VB,Children,REs). get_extra_children(Es,_,[],Es). wdgraph_update_vertex(V,Edges,WG0,WGF) :- rb_update(WG0, V, Edges0, EdgesF, WGF), !, key_union(Edges, Edges0, EdgesF). wdgraph_update_vertex(V,Edges,WG0,WGF) :- rb_insert(WG0, V, Edges, WGF). key_union([], [], []) :- !. key_union([], [C|Children], [C|Children]). key_union([C|Children], [], [C|Children]) :- !. key_union([K-W|ToAdd], [K1-W1|Children0], NewUnion) :- ( K == K1 -> NewUnion = [K-W|NewChildren], key_union(ToAdd, Children0, NewChildren) ; K1 @< K -> NewUnion = [K1-W1|NewChildren], key_union([K-W|ToAdd], Children0, NewChildren) ; NewUnion = [K-W|NewChildren], key_union(ToAdd, [K1-W1|Children0], NewChildren) ). wdgraph_new_edge(V1,V2,W,Vs0,Vs) :- rb_apply(Vs0, V1, insert_edge(V2,W), Vs), !. wdgraph_new_edge(V1,V2,W,Vs0,Vs) :- rb_insert(Vs0,V1,[V2-W],Vs). insert_edge(V2, W, Children0, Children) :- ord_insert(Children0,V2-W,Children). wdgraph_top_sort(WG,Q) :- wdgraph_to_dgraph(WG, G), dgraph_top_sort(G, Q). wgraph_to_wdgraph(UG, DG) :- ord_list_to_rbtree(UG, DG). wdgraph_to_wgraph(DG, UG) :- rb_visit(DG, UG). wdgraph_edge(N1, N2, W, G) :- rb_lookup(N1, Ns, G), find_edge(N2-W, Ns). find_edge(N-W,[N1-W|_]) :- N == N1, !. find_edge(El,[_|Edges]) :- find_edge(El,Edges). wdgraph_del_edge(Vs0, V1, V2, W, Vs) :- rb_update(Vs0, V1, Children0, NewChildren, Vs), del_edge(Children0, V2, W, NewChildren). % I assume first argument is subset of second. del_edge([K-W|Children], K1, W1, NewChildren) :- ( K == K1 -> W = W1, Children = NewChildren ; % K1 @< K NewChildren = [K-W|ChildrenLeft], del_edge(Children, K1, W1, ChildrenLeft) ). wdgraph_del_edges(G0, Edges, GF) :- sort(Edges,SortedEdges), continue_del_edges(SortedEdges, G0, GF). continue_del_edges([]) --> []. continue_del_edges([V-V1|Es]) --> !, { get_extra_children(Es,V,Children,REs) }, contract_vertex(V,[V1|Children]), continue_del_edges(REs). contract_vertex(V,Children, Vs0, Vs) :- rb_update(Vs0, V, Children0, NewChildren, Vs), del_vertices(Children, Children0, NewChildren). % I assume first argument is subset of second. del_vertices(Children, [], Children). del_vertices([K1-W1|Children0], [K-W|ToDel], NewChildren) :- ( K == K1 -> W = W1, del_vertices(Children0, ToDel, NewChildren) ; % K1 @< K NewChildren = [K1-W1|ChildrenLeft], del_vertices(Children0, [K-W|ToDel], ChildrenLeft) ). wdgraph_del_vertex(Vs0, V, Vsf) :- rb_delete(Vs0, V, Vs1), rb_map(Vs1, delete_wedge(V), Vsf). delete_wedge(_, [], []). delete_wedge(V, [K-W|Children], NewChildren) :- ( K == V -> NewChildren = Children ; K @< V -> NewChildren = [K-W|Children2], delete_wedge(V, Children, Children2) ; Children = NewChildren ). wdgraph_del_vertices(G0, Vs, GF) :- sort(Vs,SortedVs), delete_all(SortedVs, G0, G1), delete_remaining_edges(SortedVs, G1, GF). % it would be nice to be able to delete a set of elements from an RB tree % but I don't how to do it yet. delete_all([]) --> []. delete_all([V|Vs],Vs0,Vsf) :- rb_delete(Vs0, V, Vsi), delete_all(Vs,Vsi,Vsf). delete_remaining_edges(SortedVs,Vs0,Vsf) :- rb_map(Vs0, del_possible_edges(SortedVs), Vsf). del_possible_edges([], [], []). del_possible_edges([], [C|Children], [C|Children]). del_possible_edges([_|_], [], []). del_possible_edges([K|ToDel], [K1-W1|Children0], NewChildren) :- ( K == K1 -> del_possible_edges(ToDel, Children0, NewChildren) ; K1 @< K -> NewChildren = [K1-W1|ChildrenLeft], del_possible_edges([K|ToDel], Children0, ChildrenLeft) ; del_possible_edges(ToDel, [K1-W1|Children0], NewChildren) ). wdgraph_to_dgraph(WG, DG) :- rb_clone(WG, EdgesList0, DG, EdgeList), cvt_wedges(EdgesList0, EdgeList). cvt_wedges([], []). cvt_wedges([V-WEs|EdgesList0], [V-Es|EdgesList]) :- cvt_wneighbs(WEs, Es), cvt_wedges(EdgesList0, EdgesList). cvt_wneighbs([], []). cvt_wneighbs([V-_|WEs], [V|Es]) :- cvt_wneighbs(WEs, Es). dgraph_to_wdgraph(DG, WG) :- rb_clone(DG, EdgesList0, WG, EdgesList), cvt_edges(EdgesList0, EdgesList). cvt_edges([], []). cvt_edges([V-Es|EdgesList0], [V-WEs|WEdgeList]) :- cvt_neighbs(Es, WEs), cvt_edges(EdgesList0, WEdgeList). cvt_neighbs([], []). cvt_neighbs([V|WEs], [V-1|Es]) :- cvt_neighbs(WEs, Es). wdgraph_neighbors(V, WG, Neighbors) :- rb_lookup(V, EdgesList0, WG), cvt_wneighbs(EdgesList0, Neighbors). wdgraph_neighbours(V, WG, Neighbors) :- rb_lookup(V, EdgesList0, WG), cvt_wneighbs(EdgesList0, Neighbors). wdgraph_wneighbors(V, WG, Neighbors) :- rb_lookup(V, Neighbors, WG). wdgraph_wneighbours(V, WG, Neighbors) :- rb_lookup(V, Neighbors, WG). wdgraph_transpose(Graph, TGraph) :- rb_visit(Graph, Edges), rb_clone(Graph, TGraph, NewNodes), wtedges(Edges,UnsortedTEdges), sort(UnsortedTEdges,TEdges), fill_nodes(NewNodes,TEdges). wtedges([],[]). wtedges([V-Vs|Edges],TEdges) :- fill_wtedges(Vs, V, TEdges, TEdges0), wtedges(Edges,TEdges0). fill_wtedges([], _, TEdges, TEdges). fill_wtedges([V1-W|Vs], V, [V1-(V-W)|TEdges], TEdges0) :- fill_wtedges(Vs, V, TEdges, TEdges0). fill_nodes([],[]). fill_nodes([V-[Child|MoreChildren]|Nodes],[V-Child|Edges]) :- !, get_extra_children(Edges,V,MoreChildren,REdges), fill_nodes(Nodes,REdges). fill_nodes([_-[]|Edges],TEdges) :- fill_nodes(Edges,TEdges). wdgraph_transitive_closure(G,Closure) :- dgraph_edges(G,Edges), continue_closure(Edges,G,Closure). continue_closure([], Closure, Closure) :- !. continue_closure(Edges, G, Closure) :- transit_wgraph(Edges,G,NewEdges), wdgraph_add_edges(G, NewEdges, GN), continue_closure(NewEdges, GN, Closure). transit_wgraph([],_,[]). transit_wgraph([V-(V1-W)|Edges],G,NewEdges) :- rb_lookup(V1, GrandChildren, G), transit_wgraph2(GrandChildren, V, W, G, NewEdges, MoreEdges), transit_wgraph(Edges, G, MoreEdges). transit_wgraph2([], _, _, _, NewEdges, NewEdges). transit_wgraph2([GC|GrandChildren], V, W, G, NewEdges, MoreEdges) :- is_edge(V,GC,G), !, transit_wgraph2(GrandChildren, V, W, G, NewEdges, MoreEdges). transit_wgraph2([GC-W1|GrandChildren], V, W2, G, [V-(GC-W)|NewEdges], MoreEdges) :- W is W1+W2, transit_wgraph2(GrandChildren, V, W2, G, NewEdges, MoreEdges). is_edge(V1,V2,G) :- rb_lookup(V1,Children,G), find_edge(V2-_, Children). wdgraph_symmetric_closure(G,S) :- dgraph_edges(G, WEdges), invert_wedges(WEdges, InvertedWEdges), wdgraph_add_edges(G, InvertedWEdges, S). invert_wedges([], []). invert_wedges([V1-(V2-W)|WEdges], [V2-(V1-W)|InvertedWEdges]) :- invert_wedges(WEdges, InvertedWEdges). wdgraph_min_path(V1, V2, WGraph, Path, Cost) :- rb_new(Status0), rb_lookup(V1, Edges, WGraph), rb_insert(Status0, V1, V2, Status), empty_heap(H0), queue_edges(Edges, V1, 0, H0, H1), dijkstra(H1, V2, WGraph, Status, [], EPath), backtrace(EPath, V2, [V2], Path, 0, Cost). wdgraph_max_path(V1, V2, WGraph0, Path, Cost) :- rb_clone(WGraph0, Edges0, WGraph, Edges), inv_costs(Edges0, Edges), wdgraph_min_path(V1, V2, WGraph, Path, NCost), Cost is -NCost. inv_costs([], []). inv_costs([V-Es|Edges0], [V-NEs|Edges]) :- inv_costs2(Es,NEs), inv_costs(Edges0, Edges). inv_costs2([],[]). inv_costs2([V-E|Es],[V-NE|NEs]) :- NE is -E, inv_costs2(Es,NEs). queue_edges([], _, _, H, H). queue_edges([V-W|Edges], V0, D0, H, NH) :- D is W+D0, add_to_heap(H, D, e(V0,V,W), HI), queue_edges(Edges, V0, D0, HI, NH). dijkstra(H0, V2, WGraph, Status, Path0, PathF) :- get_from_heap(H0, D, e(V0, V, W), H1), continue_dijkstra(H1, V2, WGraph, Status, Path0, PathF, D, V0, V, W). continue_dijkstra(_, V2, _, _, Path0, [e(V0,V2,W)|Path0], _, V0, V, W) :- V == V2, !. continue_dijkstra(H1, V2, WGraph, Status, Path0, PathF, _, _, V, _) :- rb_lookup(V, _, Status), !, % pick some other node. dijkstra(H1, V2, WGraph, Status, Path0, PathF). continue_dijkstra(H1, V2, WGraph, Status0, Path0, PathF, D, V0, V, W) :- rb_insert(Status0, V, V0, Status), rb_lookup(V, Edges, WGraph), queue_edges(Edges, V, D, H1, H2), dijkstra(H2, V2, WGraph, Status, [e(V0,V,W)|Path0], PathF). backtrace([], _, Path, Path, Cost, Cost). backtrace([e(V0,V,C)|EPath], V1, Path0, Path, Cost0, Cost) :- V == V1, !, CostI is C+Cost0, backtrace(EPath, V0, [V0|Path0], Path, CostI, Cost). backtrace([_|EPath], V1, Path0, Path, Cost0, Cost) :- backtrace(EPath, V1, Path0, Path, Cost0, Cost). wdgraph_min_paths(V1, WGraph, T) :- rb_new(Status0), rb_lookup(V1, Edges, WGraph), rb_insert(Status0, V1, V1, Status), empty_heap(H0), queue_edges(Edges, V1, 0, H0, H1), dijkstra(H1, WGraph, Status, [], EPath), rb_empty(T0), wdgraph_add_edges(T0, EPath, T). dijkstra(H0, WGraph, Status, Path0, PathF) :- get_from_heap(H0, D, e(V0, V, W), H1), !, continue_dijkstra(H1, WGraph, Status, Path0, PathF, D, V0, V, W). dijkstra(_, _, _, Path, Path). continue_dijkstra(H1, WGraph, Status, Path0, PathF, _, _, V, _) :- rb_lookup(V, _, Status), !, % pick some other node. dijkstra(H1, WGraph, Status, Path0, PathF). continue_dijkstra(H1, WGraph, Status0, Path0, PathF, D, V0, V, W) :- rb_insert(Status0, V, V0, Status), rb_lookup(V, Edges, WGraph), queue_edges(Edges, V, D, H1, H2), dijkstra(H2, WGraph, Status, [V0-(V-W)|Path0], PathF). wdgraph_path(V, WG, P) :- wdgraph_to_dgraph(WG, G), dgraph_path(V, G, P). wdgraph_reachable(V, G, Edges) :- rb_lookup(V, Children, G), ord_list_to_rbtree([V-[]],Done0), reachable(Children, Done0, _, G, Edges, []). reachable([], Done, Done, _, Edges, Edges). reachable([V-_|Vertices], Done0, DoneF, G, EdgesF, Edges0) :- rb_lookup(V,_, Done0), !, reachable(Vertices, Done0, DoneF, G, EdgesF, Edges0). reachable([V-_|Vertices], Done0, DoneF, G, [V|EdgesF], Edges0) :- rb_lookup(V, Kids, G), rb_insert(Done0, V, [], Done1), reachable(Kids, Done1, DoneI, G, EdgesF, EdgesI), reachable(Vertices, DoneI, DoneF, G, EdgesI, Edges0). %% @}