diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more graph stuff.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1603 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-04-20 15:28:08 +00:00
parent 6d704a6675
commit 5198ba1077
9 changed files with 960 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
C/index.c
View File

@ -11,8 +11,12 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2006-04-12 18:56:50 $,$Author: vsc $ *
* Last rev: $Date: 2006-04-20 15:28:08 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.162 2006/04/12 18:56:50 vsc
* fix bug in clause: a trust_me followed by a try should be implemented by
* reusing the choice-point.
*
* Revision 1.161 2006/04/05 00:16:54 vsc
* Lots of fixes (check logfile for details
*
@ -8013,6 +8017,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
store_clause_choice_point(Terms[0], Terms[1], Terms[2], NEXTOP(ipc,ld), ap, ap_pc, cp_pc);
else {
B = b0;
b0 = NULL;
update_clause_choice_point(NEXTOP(ipc,ld), ap_pc);
}
if (lu_pred)
@ -8026,6 +8031,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
store_clause_choice_point(Terms[0], Terms[1], Terms[2], NEXTOP(ipc,l), ap, ap_pc, cp_pc);
else {
B = b0;
b0 = NULL;
update_clause_choice_point(NEXTOP(ipc,l), ap_pc);
}
if (lu_pred)
@ -8037,6 +8043,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
store_clause_choice_point(Terms[0], Terms[1], Terms[2], ipc->u.ld.d, ap, ap_pc, cp_pc);
else {
B = b0;
b0 = NULL;
update_clause_choice_point(ipc->u.ld.d, ap_pc);
}
ipc = NEXTOP(ipc,ld);

31
changes-5.1.html
View File

@ -14,22 +14,33 @@
<h1>Changes in YAP-5.1</h1>
<h2>Yap-5.1.2:</h2>
<ul>
<li> FIXED: rb_partial_map was broken.</li>
<li> NEW: wdgraph and wundgraph libraries, for weighted graphs.</li>
</ul>
<h2>Yap-5.1.1:</h2>
<ul>
<li> FIXED: compatibility fixes .</li>
</ul>
<h2>Yap-5.1.0:</h2>
<ul> NEW: new implementation of association list, based on red-black
<ul>
<li> NEW: new implementation of association lists, based on red-black
trees. </li>
<ul> NEW: undgraph library, based on dgraphs. </li>
<ul> NEW: undgraph library, based on dgraphs. </li>
<ul> NEW: dgraphs library, towards a more efficient implementation of
<li> NEW: undgraph library, based on dgraphs. </li>
<li> NEW: dgraphs library, towards a more efficient implementation of
directed graphs. </li>
<ul> NEW: rb_update, rb_apply, rb_visit, rb_keys and rb_map. </li>
<ul> FIXED: use rb_ prefix for all red black predicates. </li>
<ul> FIXED: got confused about position of syntax error (obs Mark
<li> NEW: rb_update, rb_apply, rb_visit, rb_keys and rb_map. </li>
<li> FIXED: use rb_ prefix for all red black predicates. </li>
<li> FIXED: got confused about position of syntax error (obs Mark
Goadrich). </li>
<ul> FIXED: compiling inline lists would compile the lists and then
<li> FIXED: compiling inline lists would compile the lists and then
some more (obs Nicos Angelopoulos). </li>
<ul> FIXED: message queue ops should not fail silently (obs Paulo
<li> FIXED: message queue ops should not fail silently (obs Paulo
Moura). </li>
<ul> FIXED: stream bugs in iopreds.c (Takeyuki SHIRAMOTO). </li>
<li> FIXED: stream bugs in iopreds.c (Takeyuki SHIRAMOTO). </li>
<li> FIXED: extra backtrack in informational_messages (obs Nicos
Angelopoulos).</li>
<li> NEW: abolish_module/1 at the request of Nicos Angelopoulos.</li>

133
docs/yap.tex
View File

@ -5687,17 +5687,26 @@ Set the current value of mutable term @var{M} to term @var{D}.
@section Profiling Prolog Programs
@cindex profiling
Predicates compiled with YAP's flag @code{profiling} set to
@code{on}, keep information on the number of times the predicate was
called. This information can be used to detect what are the most
commonly called predicates in the program.
The YAP profiling sub-system is currently
under-development. Functionality for this sub-system will increase with
newer implementation.
YAP includes two profiler. The count profiler keeps information on the
number of times a predicate was called. This information can be used to
detect what are the most commonly called predicates in the program. The
count profiler can be compiled by setting YAP's flag @code{profiling}
to @code{on}. The time-profiler is a @code{gprof} profiler, and counts
how many ticks are being spent on specific predicates, or on other
system functions such as internal data-base accesses or garbage collects.
The YAP profiling sub-system is currently under
development. Functionality for this sub-system will increase with newer
implementation.
@subsection The Count Profiler
@strong{Notes:}
The count profiler works by incrementing counters at procedure entry or
backtracking. It provides exact information:
@itemize @bullet
@item Profiling works for both static and dynamic predicates.
@item Currently only information on entries and retries to a predicate
@ -5759,6 +5768,52 @@ Reset all profiling information.
@end table
@subsection{Tick Profiler}
The tick profiler works by interrupting the Prolog code every so often
and checking at each point the code was. The profiler must be able to
retrace the state of the abstract machine at every moment. The major
advantage of this approach is that it gives the actual amount of time
being spent per procedure, or whether garbage collection dominates
execution time. The major drawback is that tracking down the state of
the abstract machine may take significant time, and in the worst case
may slow down the whole execution.
The following procedures are available:
@table @code
@item profinit
@findex profinit/0
@snindex profinit/0
@cnindex profinit/0
Initialise the data-structures for the profiler.
@item profon
@findex profon/0
@snindex profon/0
@cnindex profon/0
Start profiling.
@item profoff
@findex profoff/0
@snindex profoff/0
@cnindex profoff/0
Stop profiling.
@item showprofres
@findex showprofres/0
@snindex showprofres/0
@cnindex showprofres/0
Show profiling info.
@item showprofres(@var{N})
@findex showprofres/1
@snindex showprofres/1
@cnindex showprofres/1
Show profiling info for the top-most @var{N} predicates.
@end table
@node Call Counting, Arrays, Profiling, Top
@section Counting Calls
@ -9021,6 +9076,12 @@ trying to use the graph.
Unify @var{Vertices} with all vertices appearing in graph
@var{Graph}.
@item dgraph_edge(+@var{N1}, +@var{N2}, +@var{Graph})
@findex dgraph_edge/2
@snindex dgraph_edge/2
@cnindex dgraph_edge/2
Edge @var{N1}-@var{N2} is an edge in directed graph @var{Graph}.
@item dgraph_edges(+@var{Graph}, -@var{Edges})
@findex dgraph_edges/2
@snindex dgraph_edges/2
@ -9115,6 +9176,22 @@ contain the edge @var{V-U}.
@cnindex dgraph_top_sort/2
Unify @var{Vertices} with the topological sort of graph @var{Graph}.
@item dgraph_to_ugraph(+@var{Graph}, -@var{UGraph})
@findex dgraph_to_ugraph/2
@snindex dgraph_to_ugraph/2
@cnindex dgraph_to_ugraph/2
Unify @var{UGraph} with the representation used by the @var{ugraphs}
unweighted graphs library, that is, a list of the form
@var{V-Neighbors}, where @var{V} is a node and @var{Neighbors} the nodes
children.
@item ugraph_to_dgraph( +@var{UGraph}, -@var{Graph})
@findex ugraph_to_dgraph/2
@snindex ugraph_to_dgraph/2
@cnindex ugraph_to_dgraph/2
Unify @var{Graph} with the directed graph obtain from @var{UGraph},
represented in the form used in the @var{ugraphs} unweighted graphs
library.
@end table
@node UnDGraphs, , DGraphs, Library
@ -9141,6 +9218,12 @@ trying to use the graph.
Unify @var{Vertices} with all vertices appearing in graph
@var{Graph}.
@item undgraph_edge(+@var{N1}, +@var{N2}, +@var{Graph})
@findex undgraph_edge/2
@snindex undgraph_edge/2
@cnindex undgraph_edge/2
Edge @var{N1}-@var{N2} is an edge in undirected graph @var{Graph}.
@item undgraph_edges(+@var{Graph}, -@var{Edges})
@findex undgraph_edges/2
@snindex undgraph_edges/2
@ -9197,6 +9280,14 @@ in @var{Graph}.
@snindex undgraph_complement/2
@cnindex undgraph_complement/2
Unify @var{NewGraph} with the graph complementary to @var{Graph}.
@item dgraph_to_undgraph( +@var{DGraph}, -@var{UndGraph})
@findex dgraph_to_undgraph/2
@snindex dgraph_to_undgraph/2
@cnindex dgraph_to_undgraph/2
Unify @var{UndGraph} with teh undirected graph obtained from the
directed graph @var{DGraph}.
@end table
@ -10815,7 +10906,33 @@ The debugging information, when fast-skip @code{quasi-leap} is used, will
be lost.
@node Efficiency, C-Interface, Debugging, Top
@chapter Indexing
@chapter Efficiency Considerations
We next discuss several issues on trying to make Prolog programs run
fast in YAP. We assume two different programming styles:
@table @bullet
@item Execution of @item{deterministic} programs often
boils down to a recursive loop of the form:
@example
loop(Env) :-
do_something(Env,NewEnv),
loop(NewEnv).
@end example
@end table
@section Deterministic Programs
@section Non-Deterministic Programs
@section Data-Base Operations
@section Indexing
@section Profiling
The indexation mechanism restricts the set of clauses to be tried in a
procedure by using information about the status of a selected argument of
the goal (in YAP, as in most compilers, the first argument).

2
library/Makefile.in
View File

@ -51,6 +51,8 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/trees.yap \
$(srcdir)/ugraphs.yap \
$(srcdir)/undgraphs.yap \
$(srcdir)/wdgraphs.yap \
$(srcdir)/wundgraphs.yap \
$(srcdir)/ypp.yap
MYDDAS_PROGRAMS= $(srcdir)/MYDDAS/myddas.ypp \

41
library/dgraphs.yap
View File

@ -26,7 +26,11 @@
dgraph_compose/3,
dgraph_transitive_closure/2,
dgraph_symmetric_closure/2,
dgraph_top_sort/2]).
dgraph_top_sort/2,
dgraph_min_path/5,
dgraph_max_path/5,
dgraph_min_paths/3,
dgraph_path/3]).
:- use_module(library(rbtrees),
[rb_new/1,
@ -48,6 +52,12 @@
ord_del_element/3,
ord_memberchk/2]).
:- use_module(library(wdgraphs),
[dgraph_to_wdgraph/2,
wdgraph_min_path/5,
wdgraph_max_path/5,
wdgraph_min_paths/3]).
dgraph_new(Vertices) :-
rb_new(Vertices).
@ -342,4 +352,33 @@ dgraph_edge(N1, N2, G) :-
rb_lookup(N1, Ns, G),
ord_memberchk(N2, Ns).
dgraph_min_path(V1, V2, Graph, Path, Cost) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_min_path(V1, V2, WGraph, Path, Cost).
dgraph_max_path(V1, V2, Graph, Path, Cost) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_max_path(V1, V2, WGraph, Path, Cost).
dgraph_min_paths(V1, Graph, Paths) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_min_path(V1, WGraph, Paths).
dgraph_path(V, G, [V|P]) :-
rb_lookup(V, Children, G),
ord_del_element(Children, V, Ch),
do_path(Ch, G, [V], P).
do_path([], _, _, []).
do_path([C|Children], G, SoFar, Path) :-
do_children([C|Children], G, SoFar, Path).
do_children([V|_], G, SoFar, [V|Path]) :-
rb_lookup(V, Children, G),
ord_subtract(Children, SoFar, Ch),
ord_insert(SoFar, V, NextSoFar),
do_path(Ch, G, NextSoFar, Path).
do_children([_|Children], G, SoFar, Path) :-
do_children(Children, G, SoFar, Path).

21
library/rbtrees.yap
View File

@ -30,6 +30,7 @@
rb_map/3,
rb_partial_map/4,
rb_clone/3,
rb_clone/4,
rb_min/3,
rb_max/3,
rb_del_min/4,
@ -627,9 +628,6 @@ map(black(L,_,V,R),Goal) :-
rb_clone(t(Nil,T),t(Nil,NT),Ns) :-
clone(T,NT,Ns,[]).
rb_clone(t(Nil,T),t(Nil,NT),Ns,Ns0) :-
clone(T,NT,Ns,Ns0).
clone(black([],[],[],[]),black([],[],[],[]),Ns,Ns) :- !.
clone(red(L,K,_,R),red(NL,K,NV,NR),NsF,Ns0) :-
clone(L,NL,NsF,[K-NV|Ns1]),
@ -638,6 +636,17 @@ clone(black(L,K,_,R),black(NL,K,NV,NR),NsF,Ns0) :-
clone(L,NL,NsF,[K-NV|Ns1]),
clone(R,NR,Ns1,Ns0).
rb_clone(t(Nil,T),ONs,t(Nil,NT),Ns) :-
clone(T,ONs,[],NT,Ns,[]).
clone(black([],[],[],[]),ONs,ONs,black([],[],[],[]),Ns,Ns) :- !.
clone(red(L,K,V,R),ONsF,ONs0,red(NL,K,NV,NR),NsF,Ns0) :-
clone(L,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]),
clone(R,ONs1,ONs0,NR,Ns1,Ns0).
clone(black(L,K,V,R),ONsF,ONs0,black(NL,K,NV,NR),NsF,Ns0) :-
clone(L,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]),
clone(R,ONs1,ONs0,NR,Ns1,Ns0).
rb_partial_map(t(Nil,T0), Map, Goal, t(Nil,TF)) :-
partial_map(T0, Map, [], Nil, Goal, TF).
@ -649,7 +658,7 @@ partial_map(black([],_,_,_),Map,Map,Nil,_,Nil) :- !.
partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :-
partial_map(L,Map,MapI,Nil,Goal,NL),
(
Map == [] ->
MapI == [] ->
NR = R, NV = V
;
MapI = [K1|MapR],
@ -658,7 +667,7 @@ partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :-
once(call(Goal,V,NV)),
Map2 = MapR
;
Map2 = [K1|MapR], NV = V
Map2 = MapI, NV = V
),
partial_map(R,Map2,MapF,Nil,Goal,NR)
).
@ -674,7 +683,7 @@ partial_map(black(L,K,V,R),Map,MapF,Nil,Goal,black(NL,K,NV,NR)) :-
once(call(Goal,V,NV)),
Map2 = MapR
;
Map2 = [K1|MapR], NV = V
Map2 = MapI, NV = V
),
partial_map(R,Map2,MapF,Nil,Goal,NR)
).

22
library/undgraphs.yap
View File

@ -20,7 +20,8 @@
undgraph_neighbors/3,
undgraph_neighbours/3,
undgraph_complement/2,
dgraph_to_undgraph/2]).
dgraph_to_undgraph/2,
undgraph_min_tree/2]).
:- use_module( library(dgraphs),
[
@ -41,6 +42,12 @@
dgraph_complement/2,
dgraph_symmetric_closure/2]).
:- use_module(library(wundgraphs), [
undgraph_to_wundgraph/2,
wundgraph_min_tree/3,
wundgraph_max_tree/3,
wundgraph_to_undgraph/2]).
:- use_module(library(ordsets),
[ ord_del_element/3,
ord_union/3,
@ -135,7 +142,7 @@ undgraph_del_vertices(Vs) -->
{ sort(Vs,SortedVs) },
delete_all(SortedVs, [], BackEdges),
{ ord_subtract(BackEdges, SortedVs, TrueBackEdges) },
delete_remaining_edges(Vs, TrueBackEdges, SortedVs).
delete_remaining_edges(SortedVs, TrueBackEdges).
% 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.
@ -161,3 +168,14 @@ undgraph_edge(N1, N2, G) :-
dgraph_edge(N1, N2, G).
undgraph_min_tree(G, T) :-
undgraph_to_wundgraph(G, WG),
wundgraph_min_tree(WG, WT, _),
wundgraph_to_undgraph(WT, T).
undgraph_max_tree(G, T) :-
undgraph_to_wundgraph(G, WG),
wundgraph_max_tree(WG, WT, _),
wundgraph_to_undgraph(WT, T).

445
library/wdgraphs.yap Normal file
View File

@ -0,0 +1,445 @@
% File : wdgraphs.yap
% Author : Vitor Santos Costa
% Updated: 2006
% Purpose: Weighted Directed Graph Processing Utilities.
:- module( wdgraphs,
[
wdgraph_new/1,
wdgraph_add_edge/5,
wdgraph_add_edges/3,
wdgraph_add_vertex/3,
wdgraph_add_vertices/3,
wdgraph_del_edge/5,
wdgraph_del_edges/3,
wdgraph_del_vertex/3,
wdgraph_del_vertices/3,
wdgraph_edge/4,
wdgraph_edges/2,
wdgraph_vertices/2,
wdgraph_to_dgraph/2,
dgraph_to_wdgraph/2,
wdgraph_neighbors/3,
wdgraph_neighbours/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]).
:- use_module(library(dgraphs),
[
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_top_sort/2,
dgraph_edges/2,
dgraph_vertices/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_edge(V1,V2,Weight,Vs0,Vs2) :-
wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1),
dgraph_add_vertex(V2,Vs1,Vs2).
wdgraph_add_edges(Edges, V0, 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(Edges) -->
{
sort(Edges,SortedEdges),
all_vertices_in_wedges(SortedEdges,Vertices),
sort(Vertices,SortedVertices)
},
wdgraph_add_edges(SortedVertices,SortedEdges).
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).
wdgraph_add_edges([],[]) --> [].
wdgraph_add_edges([V|Vs],[V-(V1-W)|Es]) --> !,
{ get_extra_children(Es,V,Children,REs) },
wdgraph_update_vertex(V,[V1-W|Children]),
wdgraph_add_edges(Vs,REs).
wdgraph_add_edges([V|Vs],Es) --> !,
wdgraph_update_vertex(V,[]),
wdgraph_add_edges(Vs,Es).
get_extra_children([V-(C-W)|Es],V,[C-W|Children],REs) :- !,
get_extra_children(Es,V,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_add_vertex(V) -->
dgraph_add_vertex(V).
wdgraph_add_vertices(V) -->
dgraph_add_vertices(V).
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(V1, V2, W, Vs0, 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(Edges) -->
{
sort(Edges,SortedEdges)
},
continue_del_edges(SortedEdges).
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([K-W|ToDel], [K1-W1|Children0], NewChildren) :-
( K == K1 ->
W = W1,
del_vertices(ToDel, Children0, NewChildren)
;
% K1 @< K
NewChildren = [K1-W1|ChildrenLeft],
del_vertices([K-W|ToDel], Children0, ChildrenLeft)
).
wdgraph_del_vertex(V,Vs0,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(Vs) -->
{ sort(Vs,SortedVs) },
delete_all(SortedVs),
delete_remaining_edges(SortedVs).
% 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_edges(G,Edges) :-
dgraph_edges(G,Edges).
wdgraph_vertices(G,Edges) :-
dgraph_vertices(G,Edges).
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, WG, EdgesList0),
cvt_wneighbs(EdgesList0, Neighbors).
wdgraph_neighbours(V, WG, Neighbors) :-
rb_lookup(V, WG, EdgesList0),
cvt_wneighbs(EdgesList0, Neighbors).
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(NewEdges, G, 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(InvertedWEdges, G, 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(EPath, T0, 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).

284
library/wundgraphs.yap Normal file
View File

@ -0,0 +1,284 @@
% File : dgraphs.yap
% Author : Vitor Santos Costa
% Updated: 2006
% Purpose: Directed Graph Processing Utilities.
:- module( wundgraphs,
[
wundgraph_new/1,
wundgraph_add_edge/5,
wundgraph_add_edges/3,
wundgraph_add_vertex/3,
wundgraph_add_vertices/3,
wundgraph_del_edge/5,
wundgraph_del_edges/3,
wundgraph_del_vertex/3,
wundgraph_del_vertices/3,
wundgraph_edge/4,
wundgraph_edges/2,
wundgraph_vertices/2,
wundgraph_neighbors/3,
wundgraph_neighbours/3,
wdgraph_to_wundgraph/2,
wundgraph_to_wdgraph/2,
undgraph_to_wundgraph/2,
wundgraph_to_undgraph/2,
wundgraph_min_tree/3,
wundgraph_max_tree/3,
wundgraph_min_path/5,
wundgraph_min_paths/3,
wundgraph_max_path/5,
wundgraph_path/3]).
:- use_module( library(wdgraphs),
[
wdgraph_new/1,
wdgraph_add_edge/5,
wdgraph_add_edges/3,
wdgraph_add_vertex/3,
wdgraph_add_vertices/3,
wdgraph_del_edge/5,
wdgraph_del_edges/3,
wdgraph_del_vertex/3,
wdgraph_del_vertices/3,
wdgraph_edge/4,
wdgraph_edges/2,
wdgraph_to_dgraph/2,
dgraph_to_wdgraph/2,
wdgraph_symmetric_closure/2,
wdgraph_min_path/5,
wdgraph_min_paths/3,
wdgraph_max_path/5,
wdgraph_path/3]).
:- use_module( library(dgraphs),
[
dgraph_vertices/2,
dgraph_neighbors/3
]).
:- use_module(library(rbtrees),
[
rb_new/1,
rb_delete/4,
rb_partial_map/4,
rb_visit/2,
rb_insert/4,
rb_lookup/3
]).
:- use_module(library(lists),
[
reverse/2
]).
wundgraph_new(Vertices) :-
wdgraph_new(Vertices).
wundgraph_add_edge(V1,V2,K,Vs0,Vs2) :-
wdgraphs:wdgraph_new_edge(V1,V2,K,Vs0,Vs1),
wdgraphs:wdgraph_new_edge(V2,V1,K,Vs1,Vs2).
wundgraph_add_edges(Edges) -->
{ dup_edges(Edges, DupEdges) },
wdgraph_add_edges(DupEdges).
dup_edges([],[]).
dup_edges([E1-(E2-K)|Edges], [E1-(E2-K),E2-(E1-K)|DupEdges]) :-
dup_edges(Edges, DupEdges).
wundgraph_add_vertices(Vs) -->
wdgraph_add_vertices(Vs).
wundgraph_add_vertex(V) -->
wdgraph_add_vertex(V).
wundgraph_edges(Vs,Edges) :-
wdgraph_edges(Vs,DupEdges),
remove_dups(DupEdges,Edges).
remove_dups([],[]).
remove_dups([V1-(V2-K)|DupEdges],NEdges) :- V1 @< V2, !,
NEdges = [V1-(V2-K)|Edges],
remove_dups(DupEdges,Edges).
remove_dups([_|DupEdges],Edges) :-
remove_dups(DupEdges,Edges).
wundgraph_vertices(Vs,Vertices) :-
dgraph_vertices(Vs,Vertices).
wundgraph_neighbours(V,Vertices,Children) :-
dgraph_neighbours(V,Vertices,Children0),
(
del_me(Children0,V,Children)
->
true
;
Children = Children0
).
wundgraph_neighbors(V,Vertices,Children) :-
dgraph_neighbors(V,Vertices,Children0),
(
del_me(Children0,V,Children)
->
true
;
Children = Children0
).
del_me([], _, []).
del_me([K-_|Children], K1, NewChildren) :-
( K == K1 ->
Children = NewChildren
;
K @< K1 ->
NewChildren = [K|ChildrenLeft],
del_me(Children, K1, ChildrenLeft)
;
NewChildren = [K|MoreChildren],
compact(Children, MoreChildren)
).
wundgraph_del_edge(V1,V2,K,Vs0,VsF) :-
wdgraph_del_edge(V1,V2,K,Vs0,Vs1),
wdgraph_del_edge(V2,V1,K,Vs1,VsF).
wundgraph_del_edges(Edges) -->
{
dup_edges(Edges,DupEdges)
},
wdgraph_del_edges(DupEdges).
wundgraph_del_vertex(V, Vs0, Vsf) :-
rb_delete(Vs0, V, BackEdges, Vsi),
del_and_compact(BackEdges,V,BackVertices),
rb_partial_map(Vsi, BackVertices, del_edge(V), Vsf).
del_and_compact([], _, []).
del_and_compact([K-_|Children], K1, NewChildren) :-
( K == K1 ->
compact(Children, NewChildren)
;
K @< K1 ->
NewChildren = [K|ChildrenLeft],
del_and_compact(Children, K1, ChildrenLeft)
;
NewChildren = [K|CompactChildren],
compact(Children, CompactChildren)
).
compact([], []).
compact([K-_|Children], [K|CompactChildren]) :-
compact(Children, CompactChildren).
wundgraph_del_vertices(Vs) -->
wdgraph_del_vertices(Vs).
del_edge(_, [], []).
del_edge(K1, [K-W|Children], NewChildren) :-
( K == K1 ->
Children = NewChildren
;
K @< K1 ->
NewChildren = [K-W|ChildrenLeft],
del_edge(K1, Children, ChildrenLeft)
;
NewChildren = [K-W|Children]
).
wundgraph_edge(N1, N2, K, G) :-
wdgraph_edge(N1, N2, K, G).
wdgraph_to_wundgraph(G, U) :-
wdgraph_symmetric_closure(G, U).
wundgraph_to_wdgraph(G, G).
wundgraph_min_path(V1, V2, WGraph, Path, Cost) :-
wdgraph_min_path(V1, V2, WGraph, Path, Cost).
wundgraph_max_path(V1, V2, WGraph, Path, Cost) :-
wdgraph_max_path(V1, V2, WGraph, Path, Cost).
wundgraph_min_paths(V1, WGraph, T) :-
wdgraph_min_paths(V1, WGraph, T).
wundgraph_path(V, WG, P) :-
wdgraph_path(V, WG, P).
undgraph_to_wundgraph(G1, G2) :-
dgraph_to_wdgraph(G1, G2).
wundgraph_to_undgraph(G1, G2) :-
wdgraph_to_dgraph(G1, G2).
% simplistic algorithm to build a minimal spanning tree.
% Just sort edges and then walk over each one.
wundgraph_min_tree(G, T, C) :-
rb_visit(G, Els0),
mk_list_of_edges(Els0, Edges),
keysort(Edges, SortedEdges),
rb_new(V0),
rb_new(T0),
add_sorted_edges(SortedEdges, V0, TreeEdges, 0, C),
wundgraph_add_edges(TreeEdges, T0, T).
wundgraph_max_tree(G, T, C) :-
rb_visit(G, Els0),
mk_list_of_edges(Els0, Edges),
keysort(Edges, SortedEdges),
reverse(SortedEdges, ReversedEdges),
rb_new(V0),
rb_new(T0),
add_sorted_edges(ReversedEdges, V0, TreeEdges, 0, C),
wundgraph_add_edges(TreeEdges, T0, T).
mk_list_of_edges([], []).
mk_list_of_edges([V-Els|Els0], Edges) :-
add_neighbs(Els, V, Edges, Edges0),
mk_list_of_edges(Els0, Edges0).
add_neighbs([], _, Edges, Edges).
add_neighbs([V-W|Els], V0, [W-(V0-V)|Edges], Edges0) :-
V0 @< V, !,
add_neighbs(Els, V0, Edges, Edges0).
add_neighbs([_|Els], V0, Edges, Edges0) :-
add_neighbs(Els, V0, Edges, Edges0).
add_sorted_edges([], _, [], C, C).
add_sorted_edges([W-(V0-V)|SortedEdges], T0, NewTreeEdges, C0, C) :-
( rb_lookup(V0, Component, T0) ->
( rb_lookup(V, Component1, T0) ->
( Component \== Component1 ->
/* edge that links two separate sub-trees (components) */
Component = Component1,
Ti = T0
;
/* same component, can't add edge */
fail
)
;
/* V is new */
rb_insert(T0, V, Component, Ti)
)
;
( rb_lookup(V, Component1, T0) ->
/* V0 is new */
rb_insert(T0, V0, Component1, Ti)
;
/* new edges, new tree */
rb_insert(T0, V0, NewComponent, T1),
rb_insert(T1, V, NewComponent, Ti)
)
),
!,
NewTreeEdges = [(V0-(V-W)),(V-(V0-W))|TreeEdges],
Ci is C0+W,
add_sorted_edges(SortedEdges, Ti, TreeEdges, Ci, C).
add_sorted_edges([_|SortedEdges], T0, NewTreeEdges, C0, C) :-
add_sorted_edges(SortedEdges, T0, NewTreeEdges, C0, C).