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

fix rb_insert and add Jan's comments.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2243 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-05-23 10:42:14 +00:00
parent 7c24afa0f2
commit 6fbe60046b
2 changed files with 215 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
changes-5.1.html
View File

@ -17,6 +17,8 @@ xb
<h2>Yap-5.1.3:</h2>
<ul>
<li> FIXED: do not allow duplicate values in rbtrees (obs from Jan
Wielemaker and Rui Mendes).</li>
<li> FIXED: handle SIGPIPE and improve USR1 and USR2 (obs from Nicos
Angelopoulos).</li>
<li> NEW: tmp_file/2 (request from Nicos Angelopoulos).</li>

285
library/rbtrees.yap
View File

@ -13,18 +13,18 @@
:- module(rbtrees,
[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_empty/1, % ?T
rb_lookup/3, % +Key, -Value, +T
rb_update/4, % +T, +Key, +NewVal, -TN
rb_update/5, % +T, +Key, ?OldVal, +NewVal, -TN
rb_apply/4, % +T, +Key, :G, -TN
rb_lookupall/3, % +Key, -Value, +T
rb_insert/4, % +T0, +Key, ?Value, -TN
rb_delete/3, % +T, +Key, -TN
rb_delete/4, % +T, +Key, -Val, -TN
rb_visit/2, % +T, -Pairs
rb_visit/3,
rb_keys/2,
rb_keys/2, % +T, +Keys
rb_keys/3,
rb_map/2,
rb_map/3,
@ -44,15 +44,46 @@
rb_in/3
]).
/** <module> Red black trees
Red-Black trees are balanced search binary trees. They are named because
nodes can be classified as either red or black. The code we include is
based on "Introduction to Algorithms", second edition, by Cormen,
Leiserson, Rivest and Stein. The library includes routines to insert,
lookup and delete elements in the tree.
A Red black tree is represented as a term t(Nil, Tree), where Nil is the
Nil-node, a node shared for each nil-node in the tree. Any node has the
form colour(Left, Key, Value, Right), where _colour_ is one of =red= or
=black=.
@author Vitor Santos Costa, Jan Wielemaker
*/
:- meta_predicate rb_map(+,:,-), rb_partial_map(+,+,:,-), rb_apply(+,+,:,-).
% create an empty tree.
%% rb_new(-T) is det.
%
% Create a new Red-Black tree.
%
% @deprecated Use rb_empty/1.
rb_new(t(Nil,Nil)) :- Nil = black([],[],[],[]).
%% rb_empty(?T) is semidet.
%
% Succeeds if T is an empty Red-Black tree.
rb_empty(t(Nil,Nil)) :- Nil = black([],[],[],[]).
rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black([],[],[],[]).
%% rb_lookup(+Key, -Value, +T) is semidet.
%
% Backtrack through all elements with key Key in the Red-Black
% tree T, returning for each the value Value.
rb_lookup(Key, Val, t(_,Tree)) :-
lookup(Key, Val, Tree).
@ -71,6 +102,10 @@ lookup(<, K, V, Tree) :-
lookup(=, _, V, Tree) :-
arg(3,Tree,V).
%% rb_min(+T, -Key, -Value) is semidet.
%
% Key is the minimum key in T, and is associated with Val.
rb_min(t(_,Tree), Key, Val) :-
min(Tree, Key, Val).
@ -81,6 +116,10 @@ min(red(Right,_,_,_), Key, Val) :-
min(black(Right,_,_,_), Key, Val) :-
min(Right,Key,Val).
%% rb_max(+T, -Key, -Value) is semidet.
%
% Key is the maximal key in T, and is associated with Val.
rb_max(t(_,Tree), Key, Val) :-
max(Tree, Key, Val).
@ -91,6 +130,11 @@ max(red(_,_,_,Left), Key, Val) :-
max(black(_,_,_,Left), Key, Val) :-
max(Left,Key,Val).
%% rb_next(+T, +Key, -Next,-Value) is semidet.
%
% Next is the next element after Key in T, and is associated with
% Val.
rb_next(t(_,Tree), Key, Next, Val) :-
next(Tree, Key, Next, Val, []).
@ -110,12 +154,17 @@ next(<, K, _, _, NK, V, Tree, Candidate) :-
next(=, _, _, _, NK, Val, Tree, Candidate) :-
arg(4,Tree,NTree),
(
min(NTree, NK, Val) ->
true
min(NTree, NK, Val)
-> true
;
Candidate = NK-Val
Candidate = (NK-Val)
).
%% rb_previous(+T, +Key, -Previous, -Value) is semidet.
%
% Previous is the previous element after Key in T, and is
% associated with Val.
rb_previous(t(_,Tree), Key, Previous, Val) :-
previous(Tree, Key, Previous, Val, []).
@ -135,12 +184,18 @@ previous(<, K, KA, VA, NK, V, Tree, _) :-
previous(=, _, _, _, K, Val, Tree, Candidate) :-
arg(1,Tree,NTree),
(
max(NTree, K, Val) ->
true
max(NTree, K, Val)
-> true
;
Candidate = K-Val
Candidate = (K-Val)
).
%% rb_update(+T, +Key, +NewVal, -TN) is semidet.
%% rb_update(+T, +Key, ?OldVal, +NewVal, -TN) is semidet.
%
% Tree TN is tree T, but with value for Key associated with
% NewVal. Fails if it cannot find Key in T.
rb_update(t(Nil,OldTree), Key, OldVal, Val, t(Nil,NewTree)) :-
update(OldTree, Key, OldVal, Val, NewTree).
@ -150,11 +205,11 @@ rb_update(t(Nil,OldTree), Key, Val, t(Nil,NewTree)) :-
update(black(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
Left \= [],
compare(Cmp,Key0,Key),
(Cmp == = ->
OldVal = Val0,
(Cmp == (=)
-> OldVal = Val0,
NewTree = black(Left,Key0,Val,Right)
;
Cmp == > ->
Cmp == (>) ->
NewTree = black(NewLeft,Key0,Val0,Right),
update(Left, Key, OldVal, Val, NewLeft)
;
@ -163,31 +218,38 @@ update(black(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
).
update(red(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
compare(Cmp,Key0,Key),
(Cmp == = ->
OldVal = Val0,
(Cmp == (=)
-> OldVal = Val0,
NewTree = red(Left,Key0,Val,Right)
;
Cmp == > ->
NewTree = red(NewLeft,Key0,Val0,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, +Key, :G, -TN) is semidet.
%
% If the value associated with key Key is Val0 in T, and if
% call(G,Val0,ValF) holds, then TN differs from T only in that Key
% is associated with value ValF in tree TN. Fails if it cannot
% find Key in T, or if call(G,Val0,ValF) is not satisfiable.
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)) :-
apply(black(Left,Key0,Val0,Right), Key, Goal,
black(NewLeft,Key0,Val,NewRight)) :-
Left \= [],
compare(Cmp,Key0,Key),
(Cmp == (=) ->
NewLeft = Left,
(Cmp == (=)
-> NewLeft = Left,
NewRight = Right,
call(Goal,Val0,Val)
;
Cmp == (>) ->
; Cmp == (>) ->
NewRight = Right,
Val = Val0,
apply(Left, Key, Goal, NewLeft)
@ -196,23 +258,27 @@ apply(black(Left,Key0,Val0,Right), Key, Goal, black(NewLeft,Key0,Val,NewRight))
Val = Val0,
apply(Right, Key, Goal, NewRight)
).
apply(red(Left,Key0,Val0,Right), Key, Goal, red(NewLeft,Key0,Val,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 == (=)
-> NewLeft = Left,
NewRight = Right,
call(Goal,Val0,Val)
; Cmp == (>)
-> NewRight = Right,
Val = Val0,
apply(Left, Key, Goal, NewLeft)
;
Cmp == (>) ->
NewRight = Right,
Val = Val0,
apply(Left, Key, Goal, NewLeft)
;
NewLeft = Left,
Val = Val0,
apply(Right, Key, Goal, NewRight)
NewLeft = Left,
Val = Val0,
apply(Right, Key, Goal, NewRight)
).
%% rb_in(?Key, ?Val, +Tree) is nondet.
%
% True if Key-Val appear in Tree. Uses indexing if Key is bound.
rb_in(Key, Val, t(_,T)) :-
var(Key), !,
enum(Key, Val, T).
@ -233,6 +299,11 @@ enum_cases(Key, Val, _, _, _, R) :-
enum(Key, Val, R).
%% rb_lookupall(+Key, -Value, +T)
%
% Lookup all elements with key Key in the red-black tree T,
% returning the value Value.
rb_lookupall(Key, Val, t(_,Tree)) :-
lookupall(Key, Val, Tree).
@ -255,11 +326,17 @@ lookupall(<, K, V, Tree) :-
arg(1,Tree,NTree),
lookupall(K, V, NTree).
%
% Tree insertion
%
/*******************************
* TREE INSERTION *
*******************************/
% We don't use parent nodes, so we may have to fix the root.
%% rb_insert(+T0, +Key, ?Value, -TN)
%
% Add an element with key Key and Value to the tree T0 creating a
% new red-black tree TN. Duplicated elements are not allowed.
rb_insert(t(Nil,Tree0),Key,Val,t(Nil,Tree)) :-
insert(Tree0,Key,Val,Nil,Tree).
@ -302,20 +379,26 @@ insert2(black([],[],[],[]), K, V, Nil, T, Status) :- !,
T = red(Nil,K,V,Nil),
Status = not_done.
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)
( K @< K0
-> NR = R,
insert2(L, K, V, Nil, NL, Flag)
; K == K0 ->
NT = red(L,K0,V,R),
Flag = done
;
NL = L,
insert2(R, K, V, Nil, NR, 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)
( K @< K0
-> insert2(L, K, V, Nil, IL, Flag0),
fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
; K == K0 ->
NT = black(L,K0,V,R),
Flag = done
;
insert2(R, K, V, Nil, IR, Flag0),
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
insert2(R, K, V, Nil, IR, Flag0),
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
).
%
@ -407,6 +490,12 @@ pretty_print(black(L,K,_,R),D) :-
rb_delete(t(Nil,T), K, t(Nil,NT)) :-
delete(T, K, _, NT, _).
%% rb_delete(+T, +Key, -TN).
%% rb_delete(+T, +Key, -Val, -TN).
%
% Delete element with key Key from the tree T, returning the value
% Val associated with the key and a new tree TN.
rb_delete(t(Nil,T), K, V, t(Nil,NT)) :-
delete(T, K, V, NT, _).
@ -436,6 +525,11 @@ delete(black(L,_,V,R), _, V, OUT, Flag) :-
% K == K0,
delete_black_node(L,R,OUT,Flag).
%% rb_del_min(+T, -Key, -Val, -TN)
%
% Delete the least element from the tree T, returning the key Key,
% the value Val associated with the key and a new tree TN.
rb_del_min(t(Nil,T), K, Val, t(Nil,NT)) :-
del_min(T, K, Val, Nil, NT, _).
@ -451,6 +545,11 @@ del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
%% rb_del_max(+T, -Key, -Val, -TN)
%
% Delete the largest element from the tree T, returning the key
% Key, the value Val associated with the key and a new tree TN.
rb_del_max(t(Nil,T), K, Val, t(Nil,NT)) :-
del_max(T, K, Val, Nil, NT, _).
@ -584,6 +683,12 @@ fixup3(black(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
%
% whole list
%
%% rb_visit(+T, -Pairs)
%
% Pairs is an infix visit of tree T, where each element of Pairs
% is of the form K-Val.
rb_visit(t(_,T),Lf) :-
visit(T,[],Lf).
@ -598,10 +703,21 @@ visit(black(L,K,V,R),L0,Lf) :-
visit(L,[K-V|L1],Lf),
visit(R,L0,L1).
%% rb_map(+T, :Goal) is semidet.
%
% True if call(Goal, Value) is true for all nodes in T.
rb_map(t(Nil,Tree),Goal,t(Nil,NewTree)) :-
map(Tree,Goal,NewTree).
%% rb_map(+T, :G, -TN) is semidet.
%
% For all nodes Key in the tree T, if the value associated with
% key Key is Val0 in tree T, and if call(G,Val0,ValF) holds, then
% the value associated with Key in TN is ValF. Fails if
% call(G,Val0,ValF) is not satisfiable for all Var0.
map(black([],[],[],[]),_,black([],[],[],[])) :- !.
map(red(L,K,V,R),Goal,red(NL,K,NV,NR)) :-
call(Goal,V,NV), !,
@ -626,6 +742,12 @@ map(black(L,_,V,R),Goal) :-
map(L,Goal),
map(R,Goal).
%% rb_clone(+T, -NT, -Pairs)
%
% "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 K-V.
rb_clone(t(Nil,T),t(Nil,NT),Ns) :-
clone(T,NT,Ns,[]).
@ -648,6 +770,14 @@ 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, +Keys, :G, -TN)
%
% For all nodes Key in Keys, if the value associated with key Key
% is Val0 in tree T, and if call(G,Val0,ValF) holds, then the
% value associated with Key in TN is ValF. Fails if or if
% call(G,Val0,ValF) is not satisfiable for all Var0. Assumes keys
% are not repeated.
rb_partial_map(t(Nil,T0), Map, Goal, t(Nil,TF)) :-
partial_map(T0, Map, [], Nil, Goal, TF).
@ -697,6 +827,11 @@ partial_map(black(L,K,V,R),Map,MapF,Nil,Goal,black(NL,K,NV,NR)) :-
%
% whole keys
%
%% rb_keys(+T, -Keys)
%
% Keys is unified with an ordered list of all keys in the
% Red-Black tree T.
rb_keys(t(_,T),Lf) :-
keys(T,[],Lf).
@ -712,34 +847,27 @@ keys(black(L,K,_,R),L0,Lf) :-
keys(R,L0,L1).
ord_list_to_rbtree(List,Tree) :-
list_to_rbtree(List,Tree).
%% list_to_rbtree(+L, -T) is det.
%
% T is the red-black tree corresponding to the mapping in list L.
list_to_rbtree(List,Tree) :-
rb_new(T0),
list_to_rbtree(List,T0,Tree).
list_to_rbtree([],Tree,Tree).
list_to_rbtree([K-V|List],T0,Tree) :-
rb_insert(T0, K, V, T1),
list_to_rbtree(List,T1,Tree).
/*
list_to_rbtree(List,t(Nil,Tree)) :-
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)) :-
%% ord_list_to_rbtree(+L, -T) is det.
%
% T is the red-black tree corresponding to the mapping in ordered
% list L.
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) :- !,
@ -757,6 +885,11 @@ construct_rbtree(I0, Max, Ar, Color, Nil, Node) :-
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, -Size) is det.
%
% Size is the number of elements in T.
rb_size(t(_,T),Size) :-
size(T,0,Size).
@ -770,6 +903,14 @@ size(black(L,_,_,R),Sz0,Szf) :-
size(L,Sz1,Sz2),
size(R,Sz2,Szf).
%% is_rbtree(?Term) is semidet.
%
% True if Term is a valide Red-Black tree.
%
% @tbd Catch variables.
is_rbtree(X) :-
var(X), !, fail.
is_rbtree(t(Nil,Nil)) :- !.
is_rbtree(t(_,T)) :-
catch(rbtree1(T), msg(_,_), fail).