From 6fbe60046b0b4f0fecb08aa6eaa75706cf287bd9 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Fri, 23 May 2008 10:42:14 +0000
Subject: [PATCH] fix rb_insert and add Jan's comments.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2243 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 changes-5.1.html    |   2 +
 library/rbtrees.yap | 285 +++++++++++++++++++++++++++++++++-----------
 2 files changed, 215 insertions(+), 72 deletions(-)

diff --git a/changes-5.1.html b/changes-5.1.html
index 7f5a1ad4c..0237442b8 100644
--- a/changes-5.1.html
+++ b/changes-5.1.html
@@ -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>
diff --git a/library/rbtrees.yap b/library/rbtrees.yap
index 3b21b2319..9141bf7f3 100644
--- a/library/rbtrees.yap
+++ b/library/rbtrees.yap
@@ -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).