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

fix syntax error message handling

Browse Source 
improve redblack trees and use it to reimplement association lists and
to have better implementation of several graph algorithms.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1591 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-04-10 19:24:52 +00:00
parent 39daac182e
commit 783ae4b9a0
11 changed files with 1496 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
CLPBN/clpbn/evidence.yap
View File

@ -17,9 +17,9 @@
]).
:- use_module(library(rbtrees), [
new/1,
lookup/3,
insert/4
rb_new/1,
rb_lookup/3,
rb_insert/4
]).
:- meta_predicate store_evidence(:).
@ -68,7 +68,7 @@ add_links([K0|TVs],K) :-
incorporate_evidence(Vs,AllVs) :-
new(Cache0),
rb_new(Cache0),
create_open_list(Vs, OL, FL, Cache0, CacheI),
do_variables(OL, FL, CacheI),
extract_vars(OL, AllVs).
@ -77,7 +77,7 @@ create_open_list([], L, L, C, C).
create_open_list([V|Vs], [K-V|OL], FL, C0, CF) :-
clpbn:get_atts(V,[key(K)]),
add_evidence(K, V),
insert(C0, K, V, CI),
rb_insert(C0, K, V, CI),
create_open_list(Vs, OL, FL, CI, CF).
do_variables([], [], _) :- !.
@ -94,10 +94,10 @@ create_new_variable(K, V, Vf0, Vff, C0, Cf) :-
add_variables([], [], Vf, Vf, C, C).
add_variables([K|TVs], [V|NTVs], Vf0, Vff, C0, Cf) :-
lookup(K, V, C0), !,
rb_lookup(K, V, C0), !,
add_variables(TVs, NTVs, Vf0, Vff, C0, Cf).
add_variables([K|TVs], [V|NTVs], [K-V|Vf0], Vff, C0, Cf) :-
insert(C0, K, V, C1),
rb_insert(C0, K, V, C1),
create_new_variable(K, V, Vf0, Vf1, C1, C2),
add_variables(TVs, NTVs, Vf1, Vff, C2, Cf).

18
CLPBN/clpbn/gibbs.yap
View File

@ -11,9 +11,9 @@
check_if_gibbs_done/1]).
:- use_module(library(rbtrees),
[new/1,
insert/4,
lookup/3]).
[rb_new/1,
rb_insert/4,
rb_lookup/3]).
:- use_module(library(lists),
[member/2,
@ -62,7 +62,7 @@ initialise(LVs, Graph, GVs, OutputVars, VarOrder) :-
add_output_vars(GVs, Keys, OutputVars).
init_keys(Keys0) :-
new(Keys0).
rb_new(Keys0).
gen_keys([], I, I, Keys, Keys).
gen_keys([V|Vs], I0, If, Keys0, Keys) :-
@ -70,7 +70,7 @@ gen_keys([V|Vs], I0, If, Keys0, Keys) :-
gen_keys(Vs, I0, If, Keys0, Keys).
gen_keys([V|Vs], I0, If, Keys0, Keys) :-
I is I0+1,
insert(Keys0,V,I,KeysI),
rb_insert(Keys0,V,I,KeysI),
gen_keys(Vs, I, If, KeysI, Keys).
graph_representation([],_,_,_,[]).
@ -112,7 +112,7 @@ get_sizes([V|Parents], [Sz|Szs]) :-
parent_indices([], _, []).
parent_indices([V|Parents], Keys, [I|IParents]) :-
lookup(V, I, Keys),
rb_lookup(V, I, Keys),
parent_indices(Parents, Keys, IParents).
@ -139,7 +139,7 @@ propagate2parents([V|NewParents], Table, Variables, Graph, Keys) :-
propagate2parents(NewParents,Table, Variables, Graph, Keys).
add2graph(V, Vals, Table, IParents, Graph, Keys) :-
lookup(V, Index, Keys),
rb_lookup(V, Index, Keys),
(var(Vals) -> true ; length(Vals,Sz)),
arg(Index, Graph, var(V,Index,_,Vals,Sz,VarSlot,_,_,_)),
member(tabular(Table,Index,IParents), VarSlot), !.
@ -156,7 +156,7 @@ split_parents([I-V|Sorted], [V|SortedNVs],[I|SortedIndices]) :-
vars2indices([],_,[]).
vars2indices([V|Parents],Keys,[I-V|IParents]) :-
lookup(V, I, Keys),
rb_lookup(V, I, Keys),
vars2indices(Parents,Keys,IParents).
compact_table(NewTable, RepTable) :-
@ -297,7 +297,7 @@ store_mblanket(I,Values,Probs) :-
add_output_vars([], _, []).
add_output_vars([V|LVs], Keys, [I|OutputVars]) :-
lookup(V, I, Keys),
rb_lookup(V, I, Keys),
add_output_vars(LVs, Keys, OutputVars).
process(VarOrder, Graph, OutputVars, Estimates) :-

16
CLPBN/clpbn/topsort.yap
View File

@ -4,9 +4,9 @@
reversed_topsort/2]).
:- use_module(library(rbtrees),
[new/1,
lookup/3,
insert/4]).
[rb_new/1,
rb_lookup/3,
rb_insert/4]).
:- use_module(library(lists),
[reverse/2]).
@ -15,18 +15,18 @@
/* graph is as Node-[Parents] */
topsort(Graph0, Sorted) :-
new(RB),
rb_new(RB),
topsort(Graph0, [], RB, Sorted).
topsort(Graph0, Sorted0, Sorted) :-
new(RB),
rb_new(RB),
topsort(Graph0, Sorted0, RB, Sorted).
%
% Have children first in the list
%
reversed_topsort(Graph0, RSorted) :-
new(RB),
rb_new(RB),
topsort(Graph0, [], RB, Sorted),
reverse(Sorted, RSorted).
@ -42,7 +42,7 @@ add_nodes([N-Ns|Graph0], Found0, SortI, NewGraph, Found, NSort) :-
( NNs == [] ->
NewGraph = IGraph,
NSort = [N|Sort],
insert(Found0, N, '$', FoundI)
rb_insert(Found0, N, '$', FoundI)
;
NewGraph = [N-NNs|IGraph],
NSort = Sort,
@ -52,7 +52,7 @@ add_nodes([N-Ns|Graph0], Found0, SortI, NewGraph, Found, NSort) :-
delete_nodes([], _, []).
delete_nodes([N|Ns], Found, NNs) :-
lookup(N,'$',Found), !,
rb_lookup(N,'$',Found), !,
delete_nodes(Ns, Found, NNs).
delete_nodes([N|Ns], Found, [N|NNs]) :-
delete_nodes(Ns, Found, NNs).

14
changes-5.1.html
View File

@ -15,8 +15,18 @@
<h1>Changes in YAP-5.1</h1>
<h2>Yap-5.1.0:</h2>
<ul> FIXED: compiling inline lists would compile the lists and more
(obs Nicos Angelopoulos). </li>
<ul> NEW: new implementation of association list, 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
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
Goadrich). </li>
<ul> 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
Moura). </li>
<ul> FIXED: stream bugs in iopreds.c (Takeyuki SHIRAMOTO). </li>

493
docs/yap.tex
View File

@ -200,6 +200,8 @@ Subnodes of Library
* Timeout:: Call With Timeout
* Trees:: Updatable Binary Trees
* UGraphs:: Unweighted Graphs
* DGraphs:: Directed Graphs Implemented With Red-Black Trees
* UnDGraphs:: Undirected Graphs Using DGraphs
Subnodes of Debugging
* Deb Preds:: Debugging Predicates
@ -6739,6 +6741,8 @@ Library, Extensions, Builtins, Top
* Timeout:: Call With Timeout
* Trees:: Updatable Binary Trees
* UGraphs:: Unweighted Graphs
* DGraphs:: Directed Graphs Implemented With Red-Black Trees
* UnDGraphs:: Undirected Graphs Using DGraphs
@end menu
@ -6866,7 +6870,10 @@ maplist(mapargs(number_atom),[c(1),s(1,2,3)],[c('1'),s('1','2','3')]).
@cindex association list
The following association list manipulation predicates are available
once included with the @code{use_module(library(assoc))} command.
once included with the @code{use_module(library(assoc))} command. The
original library used Richard O'Keefe's implementation, on top of
unbalanced binary trees. The current code utilises code from the
red-black trees library and emulates the SICStus Prolog interface.
@table @code
@item assoc_to_list(+@var{Assoc},?@var{List})
@ -6877,6 +6884,29 @@ Given an association list @var{Assoc} unify @var{List} with a list of
the form @var{Key-Val}, where the elements @var{Key} are in ascending
order.
@item del_assoc(+@var{Key}, +@var{Assoc}, ?@var{Val}, ?@var{NewAssoc})
@findex del_assoc/4
@syindex del_assoc/4
@cnindex del_assoc/4
Succeeds if @var{NewAssoc} is an association list, obtained by removing
the element with @var{Key} and @var{Val} from the list @var{Assoc}.
@item del_max_assoc(+@var{Assoc}, ?@var{Key}, ?@var{Val}, ?@var{NewAssoc})
@findex del_max_assoc/4
@syindex del_max_assoc/4
@cnindex del_max_assoc/4
Succeeds if @var{NewAssoc} is an association list, obtained by removing
the largest element of the list, with @var{Key} and @var{Val} from the
list @var{Assoc}.
@item del_min_assoc(+@var{Assoc}, ?@var{Key}, ?@var{Val}, ?@var{NewAssoc})
@findex del_min_assoc/4
@syindex del_min_assoc/4
@cnindex del_min_assoc/4
Succeeds if @var{NewAssoc} is an association list, obtained by removing
the smallest element of the list, with @var{Key} and @var{Val}
from the list @var{Assoc}.
@item empty_assoc(+@var{Assoc})
@findex empty_assoc/1
@syindex empty_assoc/1
@ -6892,9 +6922,9 @@ with two associated elements. It can be used to enumerate all elements
in the association list.
@item get_assoc(+@var{Key},+@var{Assoc},?@var{Value})
@findex get_assoc/3
@syindex get_assoc/3
@cnindex get_assoc/3
@findex get_next_assoc/4
@syindex get_next_assoc/4
@cnindex get_next_assoc/4
If @var{Key} is one of the elements in the association list @var{Assoc},
return the associated value.
@ -6906,6 +6936,27 @@ If @var{Key} is one of the elements in the association list @var{Assoc},
return the associated value @var{Value} and a new association list
@var{NAssoc} where @var{Key} is associated with @var{NValue}.
@item get_prev_assoc(+@var{Key},+@var{Assoc},?@var{Next},?@var{Value})
@findex get_prev_assoc/4
@syindex get_prev_assoc/4
@cnindex get_prev_assoc/4
If @var{Key} is one of the elements in the association list @var{Assoc},
return the previous key, @var{Next}, and its value, @var{Value}.
@item get_next_assoc(+@var{Key},+@var{Assoc},?@var{Next},?@var{Value})
@findex get_assoc/3
@syindex get_assoc/3
@cnindex get_assoc/3
If @var{Key} is one of the elements in the association list @var{Assoc},
return the next key, @var{Next}, and its value, @var{Value}.
@item is_assoc(+@var{Assoc})
@findex is_assoc/1
@syindex is_assoc/1
@cnindex is_assoc/1
Succeeds if @var{Assoc} is an association list, that is, if it is a
red-black tree.
@item list_to_assoc(+@var{List},?@var{Assoc})
@findex list_to_assoc/2
@syindex list_to_assoc/2
@ -6914,6 +6965,13 @@ Given a list @var{List} such that each element of @var{List} is of the
form @var{Key-Val}, and all the @var{Keys} are unique, @var{Assoc} is
the corresponding association list.
@item map_assoc(+@var{Pred},+@var{Assoc})
@findex map_assoc/2
@syindex map_assoc/2
@cnindex map_assoc/2
Succeeds if the unary predicate name @var{Pred}(@var{Val}) holds for every
element in the association list.
@item map_assoc(+@var{Pred},+@var{Assoc},?@var{New})
@findex map_assoc/3
@syindex map_assoc/3
@ -6923,6 +6981,22 @@ Given the binary predicate name @var{Pred} and the association list
and such that if @var{Key-Val} is in @var{Assoc}, and @var{Key-Ans} is in
@var{New}, then @var{Pred}(@var{Val},@var{Ans}) holds.
@item max_assoc(+@var{Assoc},-@var{Key},?@var{Value})
@findex max_assoc/3
@syindex max_assoc/3
@cnindex max_assoc/3
Given the association list
@var{Assoc}, @var{Key} in the largest key in the list, and @var{Value}
the associated value.
@item min_assoc(+@var{Assoc},-@var{Key},?@var{Value})
@findex min_assoc/3
@syindex min_assoc/3
@cnindex min_assoc/3
Given the association list
@var{Assoc}, @var{Key} in the smallest key in the list, and @var{Value}
the associated value.
@item ord_list_to_assoc(+@var{List},?@var{Assoc})
@findex ord_list_to_assoc/2
@syindex ord_list_to_assoc/2
@ -7580,41 +7654,179 @@ Leiserson, Rivest and Stein. The library includes routines to insert,
lookup and delete elements in the tree.
@table @code
@item insert(+@var{T0},+@var{Key},?@var{Value},+@var{TF})
@findex insert/4
@snindex insert/4
@cnindex insert/4
@item rb_new(?@var{T})
@findex rb_new/1
@snindex rb_new/1
@cnindex rb_new/1
Create a new tree.
@item rb_empty(?@var{T})
@findex rb_empty/1
@snindex rb_empty/1
@cnindex rb_empty/1
Succeeds if tree @var{T} is empty.
@item is_rbtree(+@var{T})
@findex is_rbtree/1
@snindex is_rbtree/1
@cnindex is_rbtree/1
Check whether @var{T} is a valid red-black tree.
@item rb_insert(+@var{T0},+@var{Key},?@var{Value},+@var{TF})
@findex rb_insert/4
@snindex rb_insert/4
@cnindex rb_insert/4
Add an element with key @var{Key} and @var{Value} to the tree
@var{T0} creating a new AVL tree @var{TF}. Duplicated elements are not
@var{T0} creating a new red-black tree @var{TF}. Duplicated elements are not
allowed.
@item lookup(+@var{Key},-@var{Value},+@var{T})
@findex lookup/3
@snindex lookup/3
@cnindex lookup/3
Lookup an element with key @var{Key} in the red-black tree
@var{T}, returning the value @var{Value}.
@item rb_lookup(+@var{Key},-@var{Value},+@var{T})
@findex rb_lookup/3
@snindex rb_lookup/3
@cnindex rb_lookup/3
Backtrack through all elements with key @var{Key} in the red-black tree
@var{T}, returning for each the value @var{Value}.
@item lookupall(+@var{Key},-@var{Value},+@var{T})
@findex lookupall/3
@snindex lookupall/3
@cnindex lookupall/3
@item rb_lookupall(+@var{Key},-@var{Value},+@var{T})
@findex rb_lookupall/3
@snindex rb_lookupall/3
@cnindex rb_lookupall/3
Lookup all elements with key @var{Key} in the red-black tree
@var{T}, returning the value @var{Value}.
@item new(?@var{T})
@findex new/1
@snindex new/1
@cnindex new/1
Create a new tree.
@item delete(+@var{T},+@var{Key},-@var{TN})
@findex delete/3
@snindex delete/3
@cnindex delete/3
@item rb_delete(+@var{T},+@var{Key},-@var{TN})
@findex rb_delete/3
@snindex rb_delete/3
@cnindex rb_delete/3
Delete element with key @var{Key} from the tree @var{T}, returning a new
tree @var{TN}.
@item rb_delete(+@var{T},+@var{Key},-@var{Val},-@var{TN})
@findex rb_delete/4
@snindex rb_delete/4
@cnindex rb_delete/4
Delete element with key @var{Key} from the tree @var{T}, returning the
value @var{Val} associated with the key and a new tree @var{TN}.
@item rb_del_min(+@var{T},-@var{Key},-@var{Val},-@var{TN})
@findex rb_del_min/4
@snindex rb_del_min/4
@cnindex rb_del_min/4
Delete the least element from the tree @var{T}, returning the key
@var{Key}, the value @var{Val} associated with the key and a new tree
@var{TN}.
@item rb_del_max(+@var{T},-@var{Key},-@var{Val},-@var{TN})
@findex rb_del_max/4
@snindex rb_del_max/4
@cnindex rb_del_max/4
Delete the largest element from the tree @var{T}, returning the key
@var{Key}, the value @var{Val} associated with the key and a new tree
@var{TN}.
@item rb_update(+@var{T},+@var{Key},+@var{NewVal},-@var{TN})
@findex rb_update/4
@snindex rb_update/4
@cnindex rb_update/4
Tree @var{TN} is tree @var{T}, but with value for @var{Key} associated
with @var{NewVal}. Fails if it cannot find @var{Key} in @var{T}.
@item rb_apply(+@var{T},+@var{Key},+@var{G},-@var{TN})
@findex rb_apply/4
@snindex rb_apply/4
@cnindex rb_apply/4
If the value associated with key @var{Key} is @var{Val0} in @var{T}, and
if @var{call(G,Val0,ValF)} holds, then @var{TN} differs from @var{T}
only in that @var{Key} is associated with value @var{ValF} in tree
@var{TN}. Fails if it cannot find @var{Key} in @var{T}, or if
@var{call(G,Val0,ValF)} is not satisfiable.
@item rb_visit(+@var{T},-@var{Pairs})
@findex rb_visit/2
@snindex rb_visit/2
@cnindex rb_visit/2
@var{Pairs} is an infix visit of tree @var{T}, where each element of
@var{Pairs} is of the form @var{K-Val}.
@item rb_size(+@var{T},-@var{Size})
@findex rb_size/2
@snindex rb_size/2
@cnindex rb_size/2
@var{Size} is the number of elements in @var{T}.
@item rb_keys(+@var{T},+@var{Keys})
@findex rb_keys/2
@snindex rb_keys/2
@cnindex rb_keys/2
@var{Keys} is an infix visit with all keys in tree @var{T}. Keys will be
sorted, but may be duplicate.
@item rb_map(+@var{T},+@var{G},-@var{TN})
@findex rb_map/3
@snindex rb_map/3
@cnindex rb_map/3
For all nodes @var{Key} in the tree @var{T}, if the value associated with
key @var{Key} is @var{Val0} in tree @var{T}, and if
@var{call(G,Val0,ValF)} holds, then the value associated with @var{Key}
in @var{TN} is @var{ValF}. Fails if or if @var{call(G,Val0,ValF)} is not
satisfiable for all @var{Var0}.
@item rb_partial_map(+@var{T},+@var{Keys},+@var{G},-@var{TN})
@findex rb_partial_map/4
@snindex rb_partial_map/4
@cnindex rb_partial_map/4
For all nodes @var{Key} in @var{Keys}, if the value associated with key
@var{Key} is @var{Val0} in tree @var{T}, and if @var{call(G,Val0,ValF)}
holds, then the value associated with @var{Key} in @var{TN} is
@var{ValF}. Fails if or if @var{call(G,Val0,ValF)} is not satisfiable
for all @var{Var0}. Assumes keys are not repeated.
@item rb_clone(+@var{T},+@var{NT},+@var{Nodes})
@findex rb_clone/3
@snindex rb_clone/3
@cnindex rb_clone/3
``Clone'' the red-back tree into a new tree with the same keys as the
original but with all values set to unbound values. Nodes is a list
containing all new nodes as pairs @var{K-V}.
@item rb_min(+@var{T},-@var{Key},-@var{Value})
@findex rb_min/3
@snindex rb_min/3
@cnindex rb_min/3
@var{Key} is the minimum key in @var{T}, and is associated with @var{Val}.
@item rb_max(+@var{T},-@var{Key},-@var{Value})
@findex rb_max/3
@snindex rb_max/3
@cnindex rb_max/3
@var{Key} is the maximal key in @var{T}, and is associated with @var{Val}.
@item rb_next(+@var{T}, +@var{Key},-@var{Next},-@var{Value})
@findex rb_next/4
@snindex rb_next/4
@cnindex rb_next/4
@var{Next} is the next element after @var{Key} in @var{T}, and is
associated with @var{Val}.
@item rb_previous(+@var{T}, +@var{Key},-@var{Previous},-@var{Value})
@findex rb_previous/4
@snindex rb_previous/4
@cnindex rb_previous/4
@var{Previous} is the previous element after @var{Key} in @var{T}, and is
associated with @var{Val}.
@item list_to_rbtree(+@var{L}, -@var{T})
@findex list_to_rbtree/2
@snindex list_to_rbtree/2
@cnindex list_to_rbtree/2
@var{T} is the red-black tree corresponding to the mapping in list @var{L}.
@item ord_list_to_rbtree(+@var{L}, -@var{T})
@findex list_to_rbtree/2
@snindex list_to_rbtree/2
@cnindex list_to_rbtree/2
@var{T} is the red-black tree corresponding to the mapping in ordered
list @var{L}.
@end table
@node RegExp, Splay Trees, Red-Black Trees, Library
@ -8534,11 +8746,11 @@ Is the converse operation to list_to_tree.
@end table
@node UGraphs, , Trees, Library
@node UGraphs, DGraphs, Trees, Library
@section Unweighted Graphs
@cindex unweighted graphs
The following graph manipulation routines are based from code originally
The following graph manipulation routines are based in code originally
written by Richard O'Keefe. The code was then extended to be compatible
with the SICStus Prolog ugraphs library. The routines assume directed
graphs, undirected graphs may be implemented by using two edges. Graphs
@ -8597,9 +8809,9 @@ L = [1,2,3,4,5]
@end example
@item edges(+@var{Graph}, -@var{Edges})
@findex vertices/2
@syindex vertices/2
@cnindex vertices/2
@findex edges/2
@syindex edges/2
@cnindex edges/2
Unify @var{Edges} with all edges appearing in graph
@var{Graph}. In the next example:
@example
@ -8651,10 +8863,10 @@ edges @var{Edges} to the graph @var{Graph}. In the next example:
NL = [1-[3,5,6],2-[3,4],3-[2],4-[5],5-[7],6-[],7-[],8-[]]
@end example
@item sub_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph})
@findex sub_edges/3
@syindex sub_edges/3
@cnindex sub_edges/3
@item del_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph})
@findex del_edges/3
@syindex del_edges/3
@cnindex del_edges/3
Unify @var{NewGraph} with a new graph obtained by removing the list of
edges @var{Edges} from the graph @var{Graph}. Notice that no vertices
are deleted. In the next example:
@ -8783,6 +8995,211 @@ V = [1,3,5]
@end table
@node DGraphs, UnDGraphs, UGraphs, Library
@section Directed Graphs
@cindex Efficient Directed Graphs
The following graph manipulation routines use the red-black tree library
to try to avoid linear-time scans of the graph for all graph
operations. Graphs are represented as a red-black tree, where the key is
the vertex, and the associated value is a list of vertices reachable
from that vertex through an edge (ie, a list of edges).
@table @code
@item dgraph_new(+@var{Graph})
@findex dgraph_new/1
@snindex dgraph_new/1
@cnindex dgraph_new/1
Create a new directed graph. This operation must be performed before
trying to use the graph.
@item dgraph_vertices(+@var{Graph}, -@var{Vertices})
@findex dgraph_vertices/2
@snindex dgraph_vertices/2
@cnindex dgraph_vertices/2
Unify @var{Vertices} with all vertices appearing in graph
@var{Graph}.
@item dgraph_edges(+@var{Graph}, -@var{Edges})
@findex dgraph_edges/2
@snindex dgraph_edges/2
@cnindex dgraph_edges/2
Unify @var{Edges} with all edges appearing in graph
@var{Graph}.
@item dgraph_add_vertices(+@var{Graph}, +@var{Vertices}, -@var{NewGraph})
@findex dgraph_add_vertices/3
@snindex dgraph_add_vertices/3
@cnindex dgraph_add_vertices/3
Unify @var{NewGraph} with a new graph obtained by adding the list of
vertices @var{Vertices} to the graph @var{Graph}.
@item dgraph_del_vertices(+@var{Vertices}, +@var{Graph}, -@var{NewGraph})
@findex dgraph_del_vertices/3
@syindex dgraph_del_vertices/3
@cnindex dgraph_del_vertices/3
Unify @var{NewGraph} with a new graph obtained by deleting the list of
vertices @var{Vertices} and all the edges that start from or go to a
vertex in @var{Vertices} to the graph @var{Graph}.
@item dgraph_add_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph})
@findex dgraph_add_edges/3
@snindex dgraph_add_edges/3
@cnindex dgraph_add_edges/3
Unify @var{NewGraph} with a new graph obtained by adding the list of
edges @var{Edges} to the graph @var{Graph}.
@item dgraph_del_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph})
@findex dgraph_del_edges/3
@snindex dgraph_del_edges/3
@cnindex dgraph_del_edges/3
Unify @var{NewGraph} with a new graph obtained by removing the list of
edges @var{Edges} from the graph @var{Graph}. Notice that no vertices
are deleted.
@item dgraph_neighbors(+@var{Vertex}, +@var{Graph}, -@var{Vertices})
@findex dgraph_neighbors/3
@snindex dgraph_neighbors/3
@cnindex dgraph_neighbors/3
Unify @var{Vertices} with the list of neighbors of vertex @var{Vertex}
in @var{Graph}. If the vertice is not in the graph fail.
@item dgraph_neighbours(+@var{Vertex}, +@var{Graph}, -@var{Vertices})
@findex dgraph_neighbours/3
@snindex dgraph_neighbours/3
@cnindex dgraph_neighbours/3
Unify @var{Vertices} with the list of neighbours of vertex @var{Vertex}
in @var{Graph}.
@item dgraph_complement(+@var{Graph}, -@var{NewGraph})
@findex dgraph_complement/2
@snindex dgraph_complement/2
@cnindex dgraph_complement/2
Unify @var{NewGraph} with the graph complementary to @var{Graph}.
@item dgraph_transpose(+@var{Graph}, -@var{Transpose})
@findex dgraph_transpose/2
@snindex dgraph_transpose/2
@cnindex dgraph_transpose/2
Unify @var{NewGraph} with a new graph obtained from @var{Graph} by
replacing all edges of the form @var{V1-V2} by edges of the form
@var{V2-V1}.
@item dgraph_close(+@var{Graph1}, +@var{Graph2}, -@var{ComposedGraph})
@findex dgraph_compose/3
@snindex dgraph_compose/3
@cnindex dgraph_compose/3
Unify @var{ComposedGraph} with a new graph obtained by composing
@var{Graph1} and @var{Graph2}, ie, @var{ComposedGraph} has an edge
@var{V1-V2} iff there is a @var{V} such that @var{V1-V} in @var{Graph1}
and @var{V-V2} in @var{Graph2}.
@item dgraph_transitive_closure(+@var{Graph}, -@var{Closure})
@findex dgraph_transitive_closure/2
@snindex dgraph_transitive_closure/2
@cnindex dgraph_transitive_closure/2
Unify @var{Closure} with the transitive closure of graph @var{Graph}.
@item dgraph_symmetric_closure(+@var{Graph}, -@var{Closure})
@findex dgraph_symmetric_closure/2
@snindex dgraph_symmetric_closure/2
@cnindex dgraph_symmetric_closure/2
Unify @var{Closure} with the symmetric closure of graph @var{Graph},
that is, if @var{Closure} contains an edge @var{U-V} it must also
contain the edge @var{V-U}.
@item dgraph_top_sort(+@var{Graph}, -@var{Vertices})
@findex dgraph_top_sort/2
@snindex dgraph_top_sort/2
@cnindex dgraph_top_sort/2
Unify @var{Vertices} with the topological sort of graph @var{Graph}.
@end table
@node UnDGraphs, , DGraphs, Library
@section Undirected Graphs
@cindex undrected graphs
The following graph manipulation routines use the red-black tree graph
library to implement undirected graphs. Mostly, this is done by having
two directed edges per undirected edge.
@table @code
@item undgraph_new(+@var{Graph})
@findex undgraph_new/1
@snindex undgraph_new/1
@cnindex undgraph_new/1
Create a new directed graph. This operation must be performed before
trying to use the graph.
@item undgraph_vertices(+@var{Graph}, -@var{Vertices})
@findex undgraph_vertices/2
@snindex undgraph_vertices/2
@cnindex undgraph_vertices/2
Unify @var{Vertices} with all vertices appearing in graph
@var{Graph}.
@item undgraph_edges(+@var{Graph}, -@var{Edges})
@findex undgraph_edges/2
@snindex undgraph_edges/2
@cnindex undgraph_edges/2
Unify @var{Edges} with all edges appearing in graph
@var{Graph}.
@item undgraph_add_vertices(+@var{Graph}, +@var{Vertices}, -@var{NewGraph})
@findex undgraph_add_vertices/3
@snindex undgraph_add_vertices/3
@cnindex undgraph_add_vertices/3
Unify @var{NewGraph} with a new graph obtained by adding the list of
vertices @var{Vertices} to the graph @var{Graph}.
@item undgraph_del_vertices(+@var{Vertices}, +@var{Graph}, -@var{NewGraph})
@findex undgraph_del_vertices/3
@syindex undgraph_del_vertices/3
@cnindex undgraph_del_vertices/3
Unify @var{NewGraph} with a new graph obtained by deleting the list of
vertices @var{Vertices} and all the edges that start from or go to a
vertex in @var{Vertices} to the graph @var{Graph}.
@item undgraph_add_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph})
@findex undgraph_add_edges/3
@snindex undgraph_add_edges/3
@cnindex undgraph_add_edges/3
Unify @var{NewGraph} with a new graph obtained by adding the list of
edges @var{Edges} to the graph @var{Graph}.
@item undgraph_del_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph})
@findex undgraph_del_edges/3
@snindex undgraph_del_edges/3
@cnindex undgraph_del_edges/3
Unify @var{NewGraph} with a new graph obtained by removing the list of
edges @var{Edges} from the graph @var{Graph}. Notice that no vertices
are deleted.
@item undgraph_neighbors(+@var{Vertex}, +@var{Graph}, -@var{Vertices})
@findex undgraph_neighbors/3
@snindex undgraph_neighbors/3
@cnindex undgraph_neighbors/3
Unify @var{Vertices} with the list of neighbors of vertex @var{Vertex}
in @var{Graph}. If the vertice is not in the graph fail.
@item undgraph_neighbours(+@var{Vertex}, +@var{Graph}, -@var{Vertices})
@findex undgraph_neighbours/3
@snindex undgraph_neighbours/3
@cnindex undgraph_neighbours/3
Unify @var{Vertices} with the list of neighbours of vertex @var{Vertex}
in @var{Graph}.
@item undgraph_complement(+@var{Graph}, -@var{NewGraph})
@findex undgraph_complement/2
@snindex undgraph_complement/2
@cnindex undgraph_complement/2
Unify @var{NewGraph} with the graph complementary to @var{Graph}.
@end table
@node SWI-Prolog, Extensions, Library, Top
@cindex SWI-Prolog

2
library/Makefile.in
View File

@ -30,6 +30,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/avl.yap \
$(srcdir)/charsio.yap \
$(srcdir)/cleanup.yap \
$(srcdir)/dgraphs.yap \
$(srcdir)/gensym.yap \
$(srcdir)/heaps.yap \
$(srcdir)/listing.yap \
@ -49,6 +50,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/timeout.yap \
$(srcdir)/trees.yap \
$(srcdir)/ugraphs.yap \
$(srcdir)/undgraphs.yap \
$(srcdir)/ypp.yap
MYDDAS_PROGRAMS= $(srcdir)/MYDDAS/myddas.ypp \

204
library/assoc.yap
View File

@ -1,129 +1,121 @@
% This file has been included as an YAP library by Vitor Santos Costa, 1999
% File : ASSOC.PL
% Author : R.A.O'Keefe
% Updated: 9 November 1983
% Purpose: Binary tree implementation of "association lists".
% Red-Black Implementation of Association Lists.
% Note : the keys should be ground, the associated values need not be.
% Note : the keys should be bound, the associated values need not be.
:- module(assoc, [
empty_assoc/1,
assoc_to_list/2,
is_assoc/1,
min_assoc/3,
max_assoc/3,
gen_assoc/3,
get_assoc/3,
get_assoc/5,
get_next_assoc/4,
get_prev_assoc/4,
list_to_assoc/2,
map_assoc/3,
ord_list_to_assoc/2,
map_assoc/2,
map_assoc/3,
put_assoc/4,
empty_assoc/1
del_assoc/4,
del_min_assoc/4,
del_max_assoc/4
]).
:- meta_predicate map_assoc(:, ?, ?).
:- meta_predicate map_assoc(:, +, -), map_assoc(:, +).
/*
:- mode
assoc_to_list(+, -),
assoc_to_list(+, -, +),
gen_assoc(+, ?, ?),
get_assoc(+, +, ?),
get_assoc(+, +, +, +, +, ?),
list_to_assoc(+, -),
list_to_assoc(+, +, -, +),
map_assoc(+, +, -),
put_assoc(+, +, +, -),
put_assoc(+, +, +,+,+,+, +, -).
*/
:- use_module(library(rbtrees), [
rb_empty/1,
rb_visit/2,
is_rbtree/1,
rb_min/3,
rb_max/3,
rb_in/3,
rb_lookup/3,
rb_update/5,
rb_next/4,
rb_previous/4,
list_to_rbtree/2,
ord_list_to_rbtree/2,
rb_map/2,
rb_map/3,
rb_update/4,
rb_insert/4,
rb_delete/4,
rb_del_min/4,
rb_del_max/4
]).
empty_assoc(T) :-
rb_empty(T).
assoc_to_list(T, L) :-
rb_visit(T, L).
is_assoc(T) :-
is_rbtree(T).
min_assoc(T,K,V) :-
rb_min(T,K,V).
max_assoc(T,K,V) :-
rb_max(T,K,V).
gen_assoc(K,T,V) :-
rb_in(K,V,T).
get_assoc(K,T,V) :-
rb_lookup(K,V,T).
get_assoc(K,T,V,NT,NV) :-
rb_update(T,K,V,NV,NT).
get_next_assoc(K,T,KN,VN) :-
rb_next(T,K,KN,VN).
get_prev_assoc(K,T,KP,VP) :-
rb_previous(T,K,KP,VP).
list_to_assoc(L, T) :-
list_to_rbtree(L, T).
ord_list_to_assoc(L, T) :-
ord_list_to_rbtree(L, T).
map_assoc(P, T) :-
yap_flag(typein_module, M0),
extract_mod(P, M0, M, G),
functor(G, Name, 1),
rb_map(T, M:Name).
map_assoc(P, T, NT) :-
yap_flag(typein_module, M0),
extract_mod(P, M0, M, G),
functor(G, Name, 2),
rb_map(T, M:Name, NT).
empty_assoc(t).
extract_mod(G,_,_) :- var(G), !, fail.
extract_mod(M:G, _, FM, FG ) :- !,
extract_mod(G, M, FM, FG ).
extract_mod(G, M, M, G ).
assoc_to_list(Assoc, List) :-
assoc_to_list(Assoc, List, []).
put_assoc(K, T, V, NT) :-
rb_update(T, K, V, NT), !.
put_assoc(K, T, V, NT) :-
rb_insert(T, K, V, NT).
del_assoc(K, T, V, NT) :-
rb_delete(T, K, V, NT).
assoc_to_list(t(Key,Val,L,R), List, Rest) :-
assoc_to_list(L, List, [Key-Val|More]),
assoc_to_list(R, More, Rest).
assoc_to_list(t, List, List).
del_min_assoc(T, K, V, NT) :-
rb_del_min(T, K, V, NT).
del_max_assoc(T, K, V, NT) :-
rb_del_max(T, K, V, NT).
gen_assoc(t(_,_,L,_), Key, Val) :-
gen_assoc(L, Key, Val).
gen_assoc(t(Key,Val,_,_), Key, Val).
gen_assoc(t(_,_,_,R), Key, Val) :-
gen_assoc(R, Key, Val).
get_assoc(Key, t(K,V,L,R), Val) :-
compare(Rel, Key, K),
get_assoc(Rel, Key, V, L, R, Val).
get_assoc(=, _, Val, _, _, Val).
get_assoc(<, Key, _, Tree, _, Val) :-
get_assoc(Key, Tree, Val).
get_assoc(>, Key, _, _, Tree, Val) :-
get_assoc(Key, Tree, Val).
get_assoc(Key, t(K,V,L,R), Val, t(K,NV,NL,NR), NVal) :-
compare(Rel, Key, K),
get_assoc(Rel, Key, V, L, R, Val, NV, NL, NR, NVal).
get_assoc(=, _, Val, L, R, Val, NVal, L, R, NVal).
get_assoc(<, Key, V, L, R, Val, V, NL, R, NVal) :-
get_assoc(Key, L, Val, NL, NVal).
get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
get_assoc(Key, R, Val, NR, NVal).
list_to_assoc(List, Assoc) :-
list_to_assoc(List, t, Assoc).
list_to_assoc([], Assoc, Assoc).
list_to_assoc([Key-Val|List], Assoc0, Assoc) :-
put_assoc(Key, Assoc0, Val, AssocI),
list_to_assoc(List, AssocI, Assoc).
ord_list_to_assoc(Keys, Assoc) :-
list_to_assoc(Keys, Assoc).
/*
length(Keys,L),
list_to_assoc(N, Keys, Assoc, []).
ord_list_to_assoc(0, List, t, List).
ord_list_to_assoc(N, List, t(Key,Val,L,R), Rest) :-
A is (N-1)//2,
Z is (N-1)-A,
ord_list_to_assoc(A, List, L, [Key-Val|More]),
ord_list_to_assoc(Z, More, R, Rest).
*/
map_assoc(Pred, t(Key,Val,L0,R0), t(Key,Ans,L1,R1)) :- !,
map_assoc(Pred, L0, L1),
assoc_apply(Pred, [Val,Ans]),
map_assoc(Pred, R0, R1).
map_assoc(_, t, t).
assoc_apply(Pred,Args) :-
G =.. [Pred,Args],
call(G), !.
put_assoc(Key, t(K,V,L,R), Val, New) :-
compare(Rel, Key, K),
put_assoc(Rel, Key, K, V, L, R, Val, New).
put_assoc(Key, t, Val, t(Key,Val,t,t)).
put_assoc(=, Key, _, _, L, R, Val, t(Key,Val,L,R)).
put_assoc(<, Key, K, V, L, R, Val, t(K,V,Tree,R)) :-
put_assoc(Key, L, Val, Tree).
put_assoc(>, Key, K, V, L, R, Val, t(K,V,L,Tree)) :-
put_assoc(Key, R, Val, Tree).

330
library/dgraphs.yap Normal file
View File

@ -0,0 +1,330 @@
% File : dgraphs.yap
% Author : Vitor Santos Costa
% Updated: 2006
% Purpose: Directed Graph Processing Utilities.
:- module( dgraphs,
[
dgraph_new/1,
dgraph_add_edge/4,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_del_edge/4,
dgraph_del_edges/3,
dgraph_del_vertex/3,
dgraph_del_vertices/3,
dgraph_edges/2,
dgraph_vertices/2,
dgraph_neighbors/2,
dgraph_neighbours/2,
dgraph_complement/2,
dgraph_transpose/2,
dgraph_compose/3,
dgraph_transitive_closure/2,
dgraph_symmetric_closure/2,
dgraph_top_sort/2]).
:- 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,
ord_list_to_rbtree/2]).
:- use_module(library(ordsets),
[ord_insert/3,
ord_union/3,
ord_subtract/3,
ord_del_element/3,
ord_member/2]).
dgraph_new(Vertices) :-
rb_new(Vertices).
dgraph_add_edge(V1,V2,Vs0,Vs2) :-
dgraph_new_edge(V1,V2,Vs0,Vs1),
dgraph_add_vertex(V2,Vs1,Vs2).
dgraph_add_edges(Edges, V0, VF) :-
rb_empty(V0), !,
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
edges2graphl(SortedVertices, SortedEdges, GraphL),
ord_list_to_rbtree(GraphL, VF).
dgraph_add_edges(Edges) -->
{
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices)
},
dgraph_add_egdes(SortedVertices,SortedEdges).
all_vertices_in_edges([],[]).
all_vertices_in_edges([V1-V2|Edges],[V1,V2|Vertices]) :-
all_vertices_in_edges(Edges,Vertices).
edges2graphl([], [], []).
edges2graphl([V|Vertices], [V-V1|SortedEdges], [V-[V1|Children]|GraphL]) :- !,
get_extra_children(SortedEdges,V,Children,RemEdges),
edges2graphl(Vertices, RemEdges, GraphL).
edges2graphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :-
edges2graphl(Vertices, SortedEdges, GraphL).
dgraph_add_egdes([],[]) --> [].
dgraph_add_egdes([V|Vs],[V-V1|Es]) --> !,
{ get_extra_children(Es,V,Children,REs) },
dgraph_update_vertex(V,[V1|Children]),
dgraph_add_egdes(Vs,REs).
dgraph_add_egdes([V|Vs],Es) --> !,
dgraph_update_vertex(V,[]),
dgraph_add_egdes(Vs,Es).
get_extra_children([V-C|Es],V,[C|Children],REs) :- !,
get_extra_children(Es,V,Children,REs).
get_extra_children(Es,_,[],Es).
dgraph_update_vertex(V,Children, Vs0, Vs) :-
rb_apply(Vs0, V, add_edges(Children), Vs), !.
dgraph_update_vertex(V,Children, Vs0, Vs) :-
rb_insert(Vs0,V,Children,Vs).
add_edges(E0,E1,E) :-
ord_union(E0,E1,E).
dgraph_new_edge(V1,V2,Vs0,Vs) :-
rb_apply(Vs0, V1, insert_edge(V2), Vs), !.
dgraph_new_edge(V1,V2,Vs0,Vs) :-
rb_insert(Vs0,V1,[V2],Vs).
insert_edge(V2, Children0, Children) :-
ord_insert(Children0,V2,Children).
dgraph_add_vertices([]) --> [].
dgraph_add_vertices([V|Vs]) -->
dgraph_add_vertex(V),
dgraph_add_vertices(Vs).
dgraph_add_vertex(V,Vs0,Vs0) :-
rb_lookup(V,_,Vs0), !.
dgraph_add_vertex(V, Vs0, Vs) :-
rb_insert(Vs0, V, [], Vs).
dgraph_edges(Vs,Edges) :-
rb_visit(Vs,L0),
cvt2edges(L0,Edges).
dgraph_vertices(Vs,Vertices) :-
rb_keys(Vs,Vertices).
cvt2edges([],[]).
cvt2edges([V-Children|L0],Edges) :-
children2edges(Children,V,Edges,Edges0),
cvt2edges(L0,Edges0).
children2edges([],_,Edges,Edges).
children2edges([Child|L0],V,[V-Child|EdgesF],Edges0) :-
children2edges(L0,V,EdgesF,Edges0).
dgraph_neighbours(V,Vertices,Children) :-
rb_lookup(V,Children,Vertices).
dgraph_neighbors(V,Vertices,Children) :-
rb_lookup(V,Children,Vertices).
add_vertices(Graph, [], Graph).
add_vertices(Graph, [V|Vertices], NewGraph) :-
rb_insert(Graph, V, [], IntGraph),
add_vertices(IntGraph, Vertices, NewGraph).
dgraph_complement(Vs0,VsF) :-
dgraph_vertices(Vs0,Vertices),
rb_map(Vs0,complement(Vertices),VsF).
complement(Vs,Children,NewChildren) :-
ord_subtract(Vs,Children,NewChildren).
dgraph_del_edge(V1,V2,Vs0,Vs1) :-
rb_apply(Vs0, V1, delete_edge(V2), Vs1).
dgraph_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_apply(Vs0, V, del_edges(Children), Vs).
del_edges(ToRemove,E0,E) :-
ord_subtract(E0,ToRemove,E).
dgraph_del_vertex(V,Vs0,Vsf) :-
rb_delete(Vs0, V, Vs1),
rb_map(Vs1, delete_edge(V), Vsf).
delete_edge(V, Edges0, Edges) :-
ord_del_element(Edges0, V, Edges).
dgraph_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_edges(SortedVs), Vsf).
dgraph_transpose(Graph, TGraph) :-
rb_visit(Graph, Edges),
rb_clone(Graph, TGraph, NewNodes),
tedges(Edges,UnsortedTEdges),
sort(UnsortedTEdges,TEdges),
fill_nodes(NewNodes,TEdges).
tedges([],[]).
tedges([V-Vs|Edges],TEdges) :-
fill_tedges(Vs, V, TEdges, TEdges0),
tedges(Edges,TEdges0).
fill_tedges([], _, TEdges, TEdges).
fill_tedges([V1|Vs], V, [V1-V|TEdges], TEdges0) :-
fill_tedges(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).
dgraph_compose(T1,T2,CT) :-
rb_visit(T1,Nodes),
compose(Nodes,T2,NewNodes),
dgraph_new(CT0),
dgraph_add_edges(NewNodes,CT0,CT).
compose([],_,[]).
compose([V-Children|Nodes],T2,NewNodes) :-
compose2(Children,V,T2,NewNodes,NewNodes0),
compose(Nodes,T2,NewNodes0).
compose2([],_,_,NewNodes,NewNodes).
compose2([C|Children],V,T2,NewNodes,NewNodes0) :-
rb_lookup(C, GrandChildren, T2),
compose3(GrandChildren, V, NewNodes,NewNodesI),
compose2(Children,V,T2,NewNodesI,NewNodes0).
compose3([], _, NewNodes, NewNodes).
compose3([GC|GrandChildren], V, [V-GC|NewNodes], NewNodes0) :-
compose3(GrandChildren, V, NewNodes, NewNodes0).
dgraph_transitive_closure(G,Closure) :-
dgraph_edges(G,Edges),
continue_closure(Edges,G,Closure).
continue_closure([], Closure, Closure) :- !.
continue_closure(Edges, G, Closure) :-
transit_graph(Edges,G,NewEdges),
dgraph_add_edges(NewEdges, G, GN),
continue_closure(NewEdges, GN, Closure).
transit_graph([],_,[]).
transit_graph([V-V1|Edges],G,NewEdges) :-
rb_lookup(V1, GrandChildren, G),
transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges),
transit_graph(Edges, G, MoreEdges).
transit_graph2([], _, _, NewEdges, NewEdges).
transit_graph2([GC|GrandChildren], V, G, NewEdges, MoreEdges) :-
is_edge(V,GC,G), !,
transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges).
transit_graph2([GC|GrandChildren], V, G, [V-GC|NewEdges], MoreEdges) :-
transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges).
is_edge(V1,V2,G) :-
rb_lookup(V1,Children,G),
ord_member(Children, V2).
dgraph_symmetric_closure(G,S) :-
dgraph_edges(G, Edges),
invert_edges(Edges, InvertedEdges),
dgraph_add_edges(InvertedEdges, G, S).
invert_edges([], []).
invert_edges([V1-V2|Edges], [V2-V1|InvertedEdges]) :-
invert_edges(Edges, InvertedEdges).
dgraph_top_sort(G,Q) :-
% O(E)
rb_visit(G, Vs),
% O(E)
invert_and_link(Vs, Links, UnsortedInvertedEdges, AllVs, Q),
% O(V)
rb_clone(G, LinkedG, Links),
% O(Elog(E))
sort(UnsortedInvertedEdges, InvertedEdges),
% O(E)
dgraph_vertices(G, AllVs),
start_queue(AllVs, InvertedEdges, Q, RQ),
continue_queue(Q, LinkedG, RQ).
invert_and_link([], [], [], [], []).
invert_and_link([V-Vs|Edges], [V-NVs|ExtraEdges], UnsortedInvertedEdges, [V|AllVs],[_|Q]) :-
inv_links(Vs, NVs, V, UnsortedInvertedEdges, UnsortedInvertedEdges0),
invert_and_link(Edges, ExtraEdges, UnsortedInvertedEdges0, AllVs, Q).
inv_links([],[],_,UnsortedInvertedEdges,UnsortedInvertedEdges).
inv_links([V2|Vs],[l(V2,A,B,S,E)|VLnks],V1,[V2-e(A,B,S,E)|UnsortedInvertedEdges],UnsortedInvertedEdges0) :-
inv_links(Vs,VLnks,V1,UnsortedInvertedEdges,UnsortedInvertedEdges0).
dup([], []).
dup([_|AllVs], [_|Q]) :-
dup(AllVs, Q).
start_queue([], [], RQ, RQ).
start_queue([V|AllVs], [V-e(S,B,S,E)|InvertedEdges], Q, RQ) :- !,
link_edges(InvertedEdges, V, B, S, E, RemainingEdges),
start_queue(AllVs, RemainingEdges, Q, RQ).
start_queue([V|AllVs], InvertedEdges, [V|Q], RQ) :-
start_queue(AllVs, InvertedEdges, Q, RQ).
link_edges([V-e(A,B,S,E)|InvertedEdges], V, A, S, E, RemEdges) :- !,
link_edges(InvertedEdges, V, B, S, E, RemEdges).
link_edges(RemEdges, _, A, _, A, RemEdges).
continue_queue([], _, []).
continue_queue([V|Q], LinkedG, RQ) :-
rb_lookup(V, Links, LinkedG),
close_links(Links, RQ, RQ0),
% not clear whether I should deleted V from LinkedG
continue_queue(Q, LinkedG, RQ0).
close_links([], RQ, RQ).
close_links([l(V,A,A,S,E)|Links], RQ, RQ0) :-
( S == E -> RQ = [V| RQ1] ; RQ = RQ1),
close_links(Links, RQ1, RQ0).

473
library/rbtrees.yap
View File

@ -12,17 +12,48 @@
:- module(rbtrees,
[new/1,
lookup/3,
lookupall/3,
insert/4,
delete/3]).
[rb_new/1,
rb_empty/1,
rb_lookup/3,
rb_update/4,
rb_update/5,
rb_apply/4,
rb_lookupall/3,
rb_insert/4,
rb_delete/3,
rb_delete/4,
rb_visit/2,
rb_visit/3,
rb_keys/2,
rb_keys/3,
rb_map/2,
rb_map/3,
rb_partial_map/4,
rb_clone/3,
rb_min/3,
rb_max/3,
rb_del_min/4,
rb_del_max/4,
rb_next/4,
rb_previous/4,
list_to_rbtree/2,
ord_list_to_rbtree/2,
is_rbtree/1,
rb_size/2,
rb_in/3
]).
:- meta_predicate rb_map(+,:,-), rb_apply(+,+,:,-).
% create an empty tree.
new(black([],[],[],[])).
rb_new(t(Nil,Nil)) :- Nil = black([],[],[],[]).
new(K,V,black(Nil,K,V,Nil)) :-
Nil = black([],[],[],[]).
rb_empty(t(Nil,Nil)) :- Nil = black([],[],[],[]).
rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black([],[],[],[]).
rb_lookup(Key, Val, t(_,Tree)) :-
lookup(Key, Val, Tree).
lookup(_, _, black([],_,_,[])) :- !, fail.
lookup(Key, Val, Tree) :-
@ -39,6 +70,168 @@ lookup(<, K, V, Tree) :-
lookup(=, _, V, Tree) :-
arg(3,Tree,V).
rb_min(t(_,Tree), Key, Val) :-
min(Tree, Key, Val).
min(red(black([],_,_,_),Key,Val,_), Key, Val) :- !.
min(black(black([],_,_,_),Key,Val,_), Key, Val) :- !.
min(red(Right,_,_,_), Key, Val) :-
min(Right,Key,Val).
min(black(Right,_,_,_), Key, Val) :-
min(Right,Key,Val).
rb_max(t(_,Tree), Key, Val) :-
max(Tree, Key, Val).
max(red(_,Key,Val,black([],_,_,_)), Key, Val) :- !.
max(black(_,Key,Val,black([],_,_,_)), Key, Val) :- !.
max(red(_,_,_,Left), Key, Val) :-
max(Left,Key,Val).
max(black(_,_,_,Left), Key, Val) :-
max(Left,Key,Val).
rb_next(t(_,Tree), Key, Next, Val) :-
next(Tree, Key, Next, Val, []).
next(black([],_,_,[]), _, _, _, _) :- !, fail.
next(Tree, Key, Next, Val, Candidate) :-
arg(2,Tree,KA),
arg(3,Tree,VA),
compare(Cmp,KA,Key),
next(Cmp, Key, KA, VA, Next, Val, Tree, Candidate).
next(>, K, KA, VA, NK, V, Tree, _) :-
arg(1,Tree,NTree),
next(NTree,K,NK,V,KA-VA).
next(<, K, _, _, NK, V, Tree, Candidate) :-
arg(4,Tree,NTree),
next(NTree,K,NK,V,Candidate).
next(=, _, _, _, NK, Val, Tree, Candidate) :-
arg(4,Tree,NTree),
(
min(NTree, NK, Val) ->
true
;
Candidate = NK-Val
).
rb_previous(t(_,Tree), Key, Previous, Val) :-
previous(Tree, Key, Previous, Val, []).
previous(black([],_,_,[]), _, _, _, _) :- !, fail.
previous(Tree, Key, Previous, Val, Candidate) :-
arg(2,Tree,KA),
arg(3,Tree,VA),
compare(Cmp,KA,Key),
previous(Cmp, Key, KA, VA, Previous, Val, Tree, Candidate).
previous(>, K, _, _, NK, V, Tree, Candidate) :-
arg(1,Tree,NTree),
previous(NTree,K,NK,V,Candidate).
previous(<, K, KA, VA, NK, V, Tree, _) :-
arg(4,Tree,NTree),
previous(NTree,K,NK,V,KA-VA).
previous(=, _, _, _, K, Val, Tree, Candidate) :-
arg(1,Tree,NTree),
(
max(NTree, K, Val) ->
true
;
Candidate = K-Val
).
rb_update(t(Nil,OldTree), Key, OldVal, Val, t(Nil,NewTree)) :-
update(OldTree, Key, OldVal, Val, NewTree).
rb_update(t(Nil,OldTree), Key, Val, t(Nil,NewTree)) :-
update(OldTree, Key, _, Val, NewTree).
update(black(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
Left \= [],
compare(Cmp,Key0,Key),
(Cmp == = ->
OldVal = Val0,
NewTree = black(Left,Key0,Val,Right)
;
Cmp == > ->
NewTree = black(NewLeft,Key0,Val0,Right),
update(Left, Key, OldVal, Val, NewLeft)
;
NewTree = black(Left,Key0,Val0,NewRight),
update(Right, Key, OldVal, Val, NewRight)
).
update(red(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
compare(Cmp,Key0,Key),
(Cmp == = ->
OldVal = Val0,
NewTree = red(Left,Key0,Val,Right)
;
Cmp == > ->
NewTree = red(NewLeft,Key0,Val0,Right),
update(Left, Key, OldVal, Val, NewLeft)
;
NewTree = red(Left,Key0,Val0,NewRight),
update(Right, Key, OldVal, Val, NewRight)
).
rb_apply(t(Nil,OldTree), Key, Goal, t(Nil,NewTree)) :-
apply(OldTree, Key, Goal, NewTree).
%apply(black([],_,_,[]), _, _, _) :- !, fail.
apply(black(Left,Key0,Val0,Right), Key, Goal, black(NewLeft,Key0,Val,NewRight)) :-
Left \= [],
compare(Cmp,Key0,Key),
(Cmp == (=) ->
NewLeft = Left,
NewRight = Right,
call(Goal,Val0,Val)
;
Cmp == (>) ->
NewRight = Right,
apply(Left, Key, Goal, NewLeft)
;
NewLeft = Left,
apply(Right, Key, Goal, NewRight)
).
apply(red(Left,Key0,Val0,Right), Key, Goal, red(NewLeft,Key0,Val,NewRight)) :-
compare(Cmp,Key0,Key),
(Cmp == (=) ->
NewLeft = Left,
NewRight = Right,
call(Goal,Val0,Val)
;
Cmp == (>) ->
NewRight = Right,
apply(Left, Key, Goal, NewLeft)
;
NewLeft = Left,
apply(Right, Key, Goal, NewRight)
).
rb_in(Key, Val, t(_,T)) :-
var(Key), !,
enum(Key, Val, T).
rb_in(Key, Val, t(_,T)) :-
lookup(Key, Val, T).
enum(Key, Val, black(L,K,V,R)) :-
L \= [],
enum_cases(Key, Val, L, K, V, R).
enum(Key, Val, red(L,K,V,R)) :-
enum_cases(Key, Val, L, K, V, R).
enum_cases(Key, Val, L, _, _, _) :-
enum(Key, Val, L).
enum_cases(Key, Val, _, Key, Val, _).
enum_cases(Key, Val, _, _, _, R) :-
enum(Key, Val, R).
rb_lookupall(Key, Val, t(_,Tree)) :-
lookupall(Key, Val, Tree).
lookupall(_, _, black([],_,_,[])) :- !, fail.
lookupall(Key, Val, Tree) :-
arg(2,Tree,KA),
@ -47,7 +240,7 @@ lookupall(Key, Val, Tree) :-
lookupall(>, K, V, Tree) :-
arg(4,Tree,NTree),
lookupall(K, V, NTree).
rb_lookupall(K, V, NTree).
lookupall(=, _, V, Tree) :-
arg(3,Tree,V).
lookupall(=, K, V, Tree) :-
@ -62,8 +255,12 @@ lookupall(<, K, V, Tree) :-
%
% We don't use parent nodes, so we may have to fix the root.
%
insert(Tree0,Key,Val,Tree) :-
insert2(Tree0,Key,Val,TreeI,_),
rb_insert(t(Nil,Tree0),Key,Val,t(Nil,Tree)) :-
insert(Tree0,Key,Val,Nil,Tree).
insert(Tree0,Key,Val,Nil,Tree) :-
insert2(Tree0,Key,Val,Nil,TreeI,_),
fix_root(TreeI,Tree).
%
@ -96,22 +293,25 @@ fix_root(red(L,K,V,R),black(L,K,V,R)).
%
% actual insertion
%
insert2(black([],[],[],[]), K, V, T, Status) :- !,
Nil = black([],[],[],[]),
insert2(black([],[],[],[]), K, V, Nil, T, Status) :- !,
T = red(Nil,K,V,Nil),
Status = not_done.
insert2(red(L,K0,V0,R), K, V, red(NL,K0,V0,R), Flag) :-
K @< K0, !,
insert2(L, K, V, NL, Flag).
insert2(red(L,K0,V0,R), K, V, red(L,K0,V0,NR), Flag) :-
insert2(R, K, V, NR, Flag).
insert2(black(L,K0,V0,R), K, V, NT, Flag) :-
K @< K0, !,
insert2(L, K, V, IL, Flag0),
fix_left(Flag0, black(IL,K0,V0,R), NT, Flag).
insert2(black(L,K0,V0,R), K, V, NT, Flag) :-
insert2(R, K, V, IR, Flag0),
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag).
insert2(red(L,K0,V0,R), K, V, Nil, red(NL,K0,V0,NR), Flag) :-
( K @< K0 ->
NR = R,
insert2(L, K, V, Nil, NL, Flag)
;
NL = L,
insert2(R, K, V, Nil, NR, Flag)
).
insert2(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
( K @< K0 ->
insert2(L, K, V, Nil, IL, Flag0),
fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
;
insert2(R, K, V, Nil, IR, Flag0),
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
).
%
% How to fix if we have inserted on the left
@ -199,35 +399,69 @@ pretty_print(black(L,K,_,R),D) :-
pretty_print(R,DN).
delete(T, K, NT) :-
delete(T, K, NT, _).
rb_delete(t(Nil,T), K, t(Nil,NT)) :-
delete(T, K, _, NT, _).
rb_delete(t(Nil,T), K, V, t(Nil,NT)) :-
delete(T, K, V, NT, _).
%
% I am afraid our representation is not as nice for delete
%
delete(red(L,K0,V0,R), K, NT, Flag) :-
delete(red(L,K0,V0,R), K, V, NT, Flag) :-
K @< K0, !,
delete(L, K, NL, Flag0),
delete(L, K, V, NL, Flag0),
fixup_left(Flag0,red(NL,K0,V0,R),NT, Flag).
delete(red(L,K0,V0,R), K, NT, Flag) :-
delete(red(L,K0,V0,R), K, V, NT, Flag) :-
K @> K0, !,
delete(R, K, NR, Flag0),
delete(R, K, V, NR, Flag0),
fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
delete(red(L,_,_,R), _, OUT, Flag) :-
delete(red(L,_,V,R), _, V, OUT, Flag) :-
% K == K0,
delete_red_node(L,R,OUT,Flag).
delete(black(L,K0,V0,R), K, NT, Flag) :-
delete(black(L,K0,V0,R), K, V, NT, Flag) :-
K @< K0, !,
delete(L, K, NL, Flag0),
delete(L, K, V, NL, Flag0),
fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
delete(black(L,K0,V0,R), K, NT, Flag) :-
delete(black(L,K0,V0,R), K, V, NT, Flag) :-
K @> K0, !,
delete(R, K, NR, Flag0),
delete(R, K, V, NR, Flag0),
fixup_right(Flag0,black(L,K0,V0,NR),NT, Flag).
delete(black(L,_,_,R), _, OUT, Flag) :-
delete(black(L,_,V,R), _, V, OUT, Flag) :-
% K == K0,
delete_black_node(L,R,OUT,Flag).
rb_del_min(t(Nil,T), K, Val, t(Nil,NT)) :-
del_min(T, K, Val, Nil, NT, _).
del_min(red(black([],_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !,
delete_red_node(Nil,R,OUT,Flag).
del_min(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
del_min(L, K, V, Nil, NL, Flag0),
fixup_left(Flag0,red(NL,K0,V0,R), NT, Flag).
del_min(black(black([],_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !,
delete_black_node(Nil,R,OUT,Flag).
del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
del_min(L, K, V, Nil, NL, Flag0),
fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
rb_del_max(t(Nil,T), K, Val, t(Nil,NT)) :-
del_max(T, K, Val, Nil, NT, _).
del_max(red(L,K,V,black([],_,_,_)), K, V, Nil, OUT, Flag) :- !,
delete_red_node(L,Nil,OUT,Flag).
del_max(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
del_max(R, K, V, Nil, NR, Flag0),
fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
del_max(black(L,K,V,black([],_,_,_)), K, V, Nil, OUT, Flag) :- !,
delete_black_node(L,Nil,OUT,Flag).
del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
del_max(R, K, V, Nil, NR, Flag0),
fixup_right(Flag0,black(L,K0,V0,NR), NT, Flag).
delete_red_node(L,L,L,done) :- !.
delete_red_node(black([],[],[],[]),R,R,done) :- !.
delete_red_node(L,black([],[],[],[]),L,done) :- !.
@ -340,6 +574,171 @@ fixup3(black(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
black(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
done).
%
% whole list
%
rb_visit(t(_,T),Lf) :-
visit(T,[],Lf).
rb_visit(t(_,T),L0,Lf) :-
visit(T,L0,Lf).
visit(black([],_,_,_),L,L) :- !.
visit(red(L,K,V,R),L0,Lf) :-
visit(L,[K-V|L1],Lf),
visit(R,L0,L1).
visit(black(L,K,V,R),L0,Lf) :-
visit(L,[K-V|L1],Lf),
visit(R,L0,L1).
rb_map(t(Nil,Tree),Goal,t(Nil,NewTree)) :-
map(Tree,Goal,NewTree).
map(black([],[],[],[]),_,black([],[],[],[])) :- !.
map(red(L,K,V,R),Goal,red(NL,K,NV,NR)) :-
call(Goal,V,NV), !,
map(L,Goal,NL),
map(R,Goal,NR).
map(black(L,K,V,R),Goal,black(NL,K,NV,NR)) :-
call(Goal,V,NV), !,
map(L,Goal,NL),
map(R,Goal,NR).
rb_map(t(_,Tree),Goal) :-
map(Tree,Goal).
map(black([],[],[],[]),_) :- !.
map(red(L,_,V,R),Goal) :-
call(Goal,V), !,
map(L,Goal),
map(R,Goal).
map(black(L,_,V,R),Goal) :-
call(Goal,V), !,
map(L,Goal),
map(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]),
clone(R,NR,Ns1,Ns0).
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_partial_map(t(Nil,T0), Map, Goal, t(Nil,TF)) :-
partial_map(T0, Map, [], Goal, TF).
rb_partial_map(t(Nil,T0), Map, Map0, Goal, t(Nil,TF)) :-
rb_partial_map(T0, Map, Map0, Goal, TF).
partial_map(T,[],[],_,T) :- !.
partial_map(black([],[],[],[]),Map,Map,_,black([],[],[],[])) :- !.
partial_map(red(L,K,V,R),Map,MapF,Goal,red(NL,K,NV,NR)) :-
partial_map(L,Map,MapI,Goal,NL),
(
MapI == [] ->
NR = R, NV = V
;
MapI = [K1|MapR],
(
K == K1 ->
once(call(Goal,V,NV)),
Map2 = MapR
;
Map2 = [K1|MapR], NV = V
)
),
partial_map(R,Map2,MapF,Goal,NR).
partial_map(black(L,K,V,R),Map,MapF,Goal,black(NL,K,NV,NR)) :-
partial_map(L,Map,MapI,Goal,NL),
(
MapI == [] ->
NR = R, NV = V
;
MapI = [K1|MapR],
(
K == K1 ->
once(call(Goal,V,NV)),
Map2 = MapR
;
Map2 = [K1|MapR], NV = V
)
),
partial_map(R,Goal,Map2,MapF,NR).
%
% whole keys
%
rb_keys(t(_,T),Lf) :-
keys(T,[],Lf).
rb_keys(t(_,T),L0,Lf) :-
keys(T,L0,Lf).
keys(black([],[],[],[]),L,L) :- !.
keys(red(L,K,_,R),L0,Lf) :-
keys(L,[K|L1],Lf),
keys(R,L0,L1).
keys(black(L,K,_,R),L0,Lf) :-
keys(L,[K|L1],Lf),
keys(R,L0,L1).
list_to_rbtree(List,t(Nil,Tree)) :-
Nil = black([], [], [], []),
sort(List,Sorted),
Ar =.. [seq|Sorted],
functor(Ar,_,L),
construct_rbtree(1, L, Ar, black, Nil, Tree).
ord_list_to_rbtree(List,t(Nil,Tree)) :-
Nil = black([], [], [], []),
Ar =.. [seq|List],
functor(Ar,_,L),
construct_rbtree(1, L, Ar, black, Nil, Tree).
construct_rbtree(L, M, _, _, Nil, Nil) :- M < L, !.
construct_rbtree(L, L, Ar, Color, Nil, Node) :- !,
arg(L, Ar, K-Val),
build_node(Color, Nil, K, Val, Nil, Node, _).
construct_rbtree(I0, Max, Ar, Color, Nil, Node) :-
I is (I0+Max)//2,
arg(I, Ar, K-Val),
build_node(Color, Left, K, Val, Right, Node, NewColor),
I1 is I-1,
construct_rbtree(I0, I1, Ar, NewColor, Nil, Left),
I2 is I+1,
construct_rbtree(I2, Max, Ar, NewColor, Nil, Right).
build_node(black, Left, K, Val, Right, black(Left, K, Val, Right), red).
build_node(red, Left, K, Val, Right, red(Left, K, Val, Right), black).
rb_size(t(_,T),Size) :-
size(T,0,Size).
size(black([],_,_,_),Sz,Sz) :- !.
size(red(L,_,_,R),Sz0,Szf) :-
Sz1 is Sz0+1,
size(L,Sz1,Sz2),
size(R,Sz2,Szf).
size(black(L,_,_,R),Sz0,Szf) :-
Sz1 is Sz0+1,
size(L,Sz1,Sz2),
size(R,Sz2,Szf).
is_rbtree(t(Nil,Nil)) :- !.
is_rbtree(t(_,T)) :-
catch(rbtree1(T), msg(_,_), fail).
%
% This code checks if a tree is ordered and a rbtree
%

133
library/undgraphs.yap Normal file
View File

@ -0,0 +1,133 @@
% File : dgraphs.yap
% Author : Vitor Santos Costa
% Updated: 2006
% Purpose: Directed Graph Processing Utilities.
:- module( undgraphs,
[
undgraph_new/1,
undgraph_add_edge/4,
undgraph_add_edges/3,
undgraph_add_vertex/3,
undgraph_add_vertices/3,
undgraph_del_edge/4,
undgraph_del_edges/3,
undgraph_del_vertex/3,
undgraph_del_vertices/3,
undgraph_edges/2,
undgraph_vertices/2,
undgraph_neighbors/2,
undgraph_neighbours/2,
undgraph_complement/2]).
:- use_module( library(dgraphs),
[
dgraph_new/1,
dgraph_add_edge/4,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_del_edge/4,
dgraph_del_edges/3,
dgraph_del_vertex/3,
dgraph_del_vertices/3,
dgraph_edges/2,
dgraph_vertices/2,
dgraph_neighbors/2,
dgraph_neighbours/2,
dgraph_complement/2]).
:- use_module(library(ordsets),
[ ord_del_element/3,
ord_union/3,
ord_subtract/3]).
:- use_module(library(rbtrees),
[ rb_delete/4]).
undgraph_new(Vertices) :-
dgraph_new(Vertices).
undgraph_add_edge(V1,V2,Vs0,Vs2) :-
dgraphs:dgraph_new_edge(V1,V2,Vs0,Vs1),
dgraphs:dgraph_new_edge(V2,V1,Vs1,Vs2).
undgraph_add_edges(Edges) -->
{ dup_edges(Edges, DupEdges) },
dgraph_add_edges(Edges).
dup_edges([],[]).
dup_edges([E1-E2|Edges], [E1-E2,E2-E1|DupEdges]) :-
dup_edges(Edges, DupEdges).
undgraph_add_vertices([]) --> [].
undgraph_add_vertices([V|Vs]) -->
dgraph_add_vertex(V),
undgraph_add_vertices(Vs).
undgraph_add_vertex(V) -->
dgraph_add_vertex(V).
undgraph_edges(Vs,Edges) :-
dgraph_edges(Vs,DupEdges),
remove_dups(DupEdges,Edges).
remove_dups([],[]).
remove_dups([V1-V2|DupEdges],NEdges) :- V1 @< V2, !,
NEdges = [V1-V2|Edges],
remove_dups(DupEdges,Edges).
remove_dups([_|DupEdges],Edges) :-
remove_dups(DupEdges,Edges).
undgraph_vertices(Vs,Vertices) :-
dgraph_vertices(Vs,Vertices).
undgraph_neighbours(V,Vertices,Children) :-
dgraph_neighbours(V,Vertices,Children0),
ord_del_element(V,Children0,Children).
undgraph_neighbors(V,Vertices,Children) :-
dgraph_neighbors(V,Vertices,Children0),
ord_del_element(V,Children0,Children).
undgraph_complement(Vs0,VsF) :-
dgraph_complement(Vs0,VsF).
undgraph_del_edge(V1,V2,Vs0,VsF) :-
dgraph_del_edge(V1,V2,Vs0,Vs1),
dgraph_del_edge(V2,V1,Vs1,VsF).
undgraph_del_edges(Edges) -->
{
dup_edges(Edges,DupEdges)
},
dgraph_del_edges(DupEdges).
undgraph_del_vertex(V, Vs0, Vsf) :-
rb_delete(Vs0, V, BackEdges, Vsi),
ord_del_element(BackEdges,V,RealBackEdges),
rb_partial_map(Vsi, RealBackEdges, del_edge(V), Vsf).
undgraph_del_vertices(Vs) -->
{ sort(Vs,SortedVs) },
delete_all(SortedVs, [], BackEdges),
{ ord_subtract(BackEdges, SortedVs, TrueBackEdges) },
delete_remaining_edges(Vs, TrueBackEdges, 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([], BackEdges, BackEdges) --> [].
delete_all([V|Vs], BackEdges0, BackEdgesF, Vs0,Vsf) :-
rb_delete(Vs0, V, NewEdges, Vsi),
ord_union(NewEdges,BackEdges0,BackEdgesI),
delete_all(Vs, BackEdgesI ,BackEdgesF, Vsi,Vsf).
delete_remaining_edges(SortedVs, TrueBackEdges, Vs0,Vsf) :-
rb_partial_map(Vs0, TrueBackEdges, del_edges(SortedVs), Vsf).
del_edges(ToRemove,E0,E) :-
ord_subtract(E0,ToRemove,E).
del_edges(ToRemove,E0,E) :-
ord_del_element(E0,ToRemove,E).

10
pl/errors.yap
View File

@ -11,8 +11,11 @@
* File: errors.yap *
* comments: error messages for YAP *
* *
* Last rev: $Date: 2006-04-05 00:16:55 $,$Author: vsc $ *
* Last rev: $Date: 2006-04-10 19:24:52 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.76 2006/04/05 00:16:55 vsc
* Lots of fixes (check logfile for details
*
* Revision 1.75 2006/02/24 14:26:37 vsc
* fix informational_messages
*
@ -859,9 +862,8 @@ print_message(Level, Mss) :-
[Where]).
'$dump_syntax_error_line'(Start,Position) :-
Pos is Start+Position,
format(user_error,', near line ~d:~n',[Pos]).
'$dump_syntax_error_line'(Position,_) :-
format(user_error,', near line ~d:~n',[Position]).
'$dump_syntax_error_term'(0,J,L) :- !,
format(user_error,'~n', []),