YAP 7.1.0
rbtrees.yap
Go to the documentation of this file.
1/**
2 * @file rbtrees.yap
3 * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
4 * @author Jan Wielemaker
5 * @date Wed Nov 18 00:11:41 2015
6 *
7 * @brief Red-Black trees
8 *
9 *
10*/
11
12
13:- module(rbtrees,
14 [rb_new/1,
15 rb_empty/1, % ?T
16 rb_lookup/3, % +Key, -Value, +T
17 rb_update/4, % +T, +Key, +NewVal, -TN
18 rb_update/5, % +T, +Key, ?OldVal, +NewVal, -TN
19 rb_rewrite/3, % +T, +Key, +NewVal
20 rb_rewrite/4, % +T, +Key, ?OldVal, +NewVal
21 rb_apply/4, % +T, +Key, :G, -TN
22 rb_lookupall/3, % +Key, -Value, +T
23 rb_insert/4, % +T0, +Key, ?Value, -TN
24 rb_insert_new/4, % +T0, +Key, ?Value, -TN
25 rb_delete/3, % +T, +Key, -TN
26 rb_delete/4, % +T, +Key, -Val, -TN
27 rb_visit/2, % +T, -Pairs
28 rb_visit/3,
29 rb_keys/2, % +T, +Keys
30 rb_keys/3,
31 rb_map/2,
34 rb_accumulate/4,
36 rb_clone/4,
45 list_to_rbtree/2,
46 ord_list_to_rbtree/2,
47 keys_to_rbtree/2,
48 ord_keys_to_rbtree/2,
49 is_rbtree/1,
51 rb_in/3
52 ]).
53
54/**
55 *
56 * @defgroup rbtrees Red-Black Trees
57 * @ingroup YAPLibrary
58 * @{
59 *
60
61Red-Black trees are balanced search binary trees. They are named because
62nodes can be classified as either red or black. The code we include is
63based on "Introduction to Algorithms", second edition, by Cormen,
64Leiserson, Rivest and Stein. The library includes routines to insert,
65lookup and delete elements in the tree.
66
67A Red black tree is represented as a term t(Nil, Tree), where Nil is the
68Nil-node, a node shared for each nil-node in the tree. Any node has the
69form colour(Left, Key, Value, Right), where _colour_ is one of =red= or
70=black=.
71
72@author Vitor Santos Costa, Jan Wielemaker
73*/
74
75:- meta_predicate rb_map(+,2,-),
76 rb_partial_map(+,+,2,-),
77 rb_apply(+,+,2,-).
78
79/*
80:- use_module(library(type_check)).
81
82:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)).
83:- type tree(K,V) ---> black(tree(K,V),K,V,tree(K,V))
84 ; red(tree(K,V),K,V,tree(K,V))
85 ; ''.
86:- type cmp ---> (=) ; (<) ; (>).
87
88
89:- pred rb_new(rbtree(_K,_V)).
90:- pred rb_empty(rbtree(_K,_V)).
91:- pred rb_lookup(K,V,rbtree(K,V)).
92:- pred lookup(K,V, tree(K,V)).
93:- pred lookup(cmp, K, V, tree(K,V)).
94:- pred rb_min(rbtree(K,V),K,V).
95:- pred min(tree(K,V),K,V).
96:- pred rb_max(rbtree(K,V),K,V).
97:- pred max(tree(K,V),K,V).
98:- pred rb_next(rbtree(K,V),K,pair(K,V),V).
99:- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)).
100*/
101
102%% @pred rb_new(-T) is det.
103% create an empty tree.
104%
105% Create a new Red-Black tree.
106%
107% @deprecated Use rb_empty/1.
108
109rb_new(t(Nil,Nil)) :- Nil = black('',_,_,'').
110
111rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black('',_,_,'').
112
113%% @pred rb_empty(?T) is semidet.
114%
115% Succeeds if T is an empty Red-Black tree.
116rb_empty(t(Nil,Nil)) :- Nil = black('',_,_,'').
117
118%% @pred rb_lookup(+Key, -Value, +T) is semidet.
119%
120% Backtrack through all elements with key Key in the Red-Black
121% tree T, returning for each the value Value.
122
123rb_lookup(Key, Val, t(_,Tree)) :-
124 lookup(Key, Val, Tree).
125
126lookup(_, _, black('',_,_,'')) :- lookup, lookup.
127lookup(Key, Val, Tree) :-
128 arg(2,Tree,KA),
129 compare(Cmp,KA,Key),
130 lookup(Cmp,Key,Val,Tree).
131
132lookup(>, K, V, Tree) :-
133 arg(1,Tree,NTree),
134 lookup(K, V, NTree).
135lookup(<, K, V, Tree) :-
136 arg(4,Tree,NTree),
137 lookup(K, V, NTree).
138lookup(=, _, V, Tree) :-
139 arg(3,Tree,V).
140
141%% @pred rb_min(+T, -Key, -Value) is semidet.
142%
143% Key is the minimum key in T, and is associated with Val.
144
145rb_min(t(_,Tree), Key, Val) :-
146 min(Tree, Key, Val).
147
148min(red(black('',_,_,_),Key,Val,_), Key, Val) :- min.
149min(black(black('',_,_,_),Key,Val,_), Key, Val) :- min.
150min(red(Right,_,_,_), Key, Val) :-
151 min(Right,Key,Val).
152min(black(Right,_,_,_), Key, Val) :-
153 min(Right,Key,Val).
154
155%% @pred rb_max( +T, -Key, -Value) is semidet.
156%
157% Key is the maximal key in T, and is associated with Val.
158
159rb_max(t(_,Tree), Key, Val) :-
160 max(Tree, Key, Val).
161
162max(red(_,Key,Val,black('',_,_,_)), Key, Val) :- max.
163max(black(_,Key,Val,black('',_,_,_)), Key, Val) :- max.
164max(red(_,_,_,Left), Key, Val) :-
165 max(Left,Key,Val).
166max(black(_,_,_,Left), Key, Val) :-
167 max(Left,Key,Val).
168
169%% @pred rb_next(+T, +Key, -Next,-Value) is semidet.
170%
171% Next is the next element after Key in T, and is associated with
172% Val.
173
174rb_next(t(_,Tree), Key, Next, Val) :-
175 next(Tree, Key, Next, Val, []).
176
177next(black('',_,_,''), _, _, _, _) :- next, next.
178next(Tree, Key, Next, Val, Candidate) :-
179 arg(2,Tree,KA),
180 arg(3,Tree,VA),
181 compare(Cmp,KA,Key),
182 next(Cmp, Key, KA, VA, Next, Val, Tree, Candidate).
183
184next(>, K, KA, VA, NK, V, Tree, _) :-
185 arg(1,Tree,NTree),
186 next(NTree,K,NK,V,KA-VA).
187next(<, K, _, _, NK, V, Tree, Candidate) :-
188 arg(4,Tree,NTree),
189 next(NTree,K,NK,V,Candidate).
190next(=, _, _, _, NK, Val, Tree, Candidate) :-
191 arg(4,Tree,NTree),
192 (
193 min(NTree, NK, Val)
194 -> min
195 ;
196 Candidate = (NK-Val)
197 ).
198
199%% @pred rb_previous(+T, +Key, -Previous, -Value) is semidet.
200%
201% Previous is the previous element after Key in T, and is
202% associated with Val.
203
204rb_previous(t(_,Tree), Key, Previous, Val) :-
205 previous(Tree, Key, Previous, Val, []).
206
207previous(black('',_,_,''), _, _, _, _) :- previous, previous.
208previous(Tree, Key, Previous, Val, Candidate) :-
209 arg(2,Tree,KA),
210 arg(3,Tree,VA),
211 compare(Cmp,KA,Key),
212 previous(Cmp, Key, KA, VA, Previous, Val, Tree, Candidate).
213
214previous(>, K, _, _, NK, V, Tree, Candidate) :-
215 arg(1,Tree,NTree),
216 previous(NTree,K,NK,V,Candidate).
217previous(<, K, KA, VA, NK, V, Tree, _) :-
218 arg(4,Tree,NTree),
219 previous(NTree,K,NK,V,KA-VA).
220previous(=, _, _, _, K, Val, Tree, Candidate) :-
221 arg(1,Tree,NTree),
222 (
223 max(NTree, K, Val)
224 -> max
225 ;
226 Candidate = (K-Val)
227 ).
228
229%% @pred rb_update(+T, +Key, +NewVal, -TN) is semidet.
230%% @pred rb_update(+T, +Key, ?OldVal, +NewVal, -TN) is semidet.
231%
232% Tree TN is tree T, but with value for Key associated with
233% NewVal. Fails if it cannot find Key in T.
234
235rb_update(t(Nil,OldTree), Key, OldVal, Val, t(Nil,NewTree)) :-
236 update(OldTree, Key, OldVal, Val, NewTree).
237
238rb_update(t(Nil,OldTree), Key, Val, t(Nil,NewTree)) :-
239 update(OldTree, Key, _, Val, NewTree).
240
241update(black(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
242 Left \= [],
243 compare(Cmp,Key0,Key),
244 (Cmp == (=)
245 -> OldVal = Val0,
246 NewTree = black(Left,Key0,Val,Right)
247 ;
248 Cmp == (>) ->
249 NewTree = black(NewLeft,Key0,Val0,Right),
250 update(Left, Key, OldVal, Val, NewLeft)
251 ;
252 NewTree = black(Left,Key0,Val0,NewRight),
253 update(Right, Key, OldVal, Val, NewRight)
254 ).
255update(red(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
256 compare(Cmp,Key0,Key),
257 (Cmp == (=)
258 -> OldVal = Val0,
259 NewTree = red(Left,Key0,Val,Right)
260 ;
261 Cmp == (>)
262 -> NewTree = red(NewLeft,Key0,Val0,Right),
263 update(Left, Key, OldVal, Val, NewLeft)
264 ;
265 NewTree = red(Left,Key0,Val0,NewRight),
266 update(Right, Key, OldVal, Val, NewRight)
267 ).
268
269%% @pred rb_rewrite(+T, +Key, +NewVal) is semidet.
270%% @pred rb_rewrite(+T, +Key, ?OldVal, +NewVal) is semidet.
271%
272% Tree T has value for Key associated with
273% NewVal. Fails if it cannot find Key in T.
274
275rb_rewrite(t(_Nil,OldTree), Key, OldVal, Val) :-
276 rewrite(OldTree, Key, OldVal, Val).
277
278rb_rewrite(t(_Nil,OldTree), Key, Val) :-
279 rewrite(OldTree, Key, _, Val).
280
281rewrite(Node, Key, OldVal, Val) :-
282 Node = black(Left,Key0,Val0,Right),
283 Left \= [],
284 compare(Cmp,Key0,Key),
285 (Cmp == (=)
286 -> OldVal = Val0,
287 setarg(3, Node, Val)
288 ;
289 Cmp == (>) ->
290 rewrite(Left, Key, OldVal, Val)
291 ;
292 rewrite(Right, Key, OldVal, Val)
293 ).
294 rewrite(Node, Key, OldVal, Val) :-
295 Node = red(Left,Key0,Val0,Right),
296 Left \= [],
297 compare(Cmp,Key0,Key),
298 (
299 Cmp == (=)
300 ->
301 OldVal = Val0,
302 setarg(3, Node, Val)
303 ;
304 Cmp == (>)
305 ->
306 rewrite(Left, Key, OldVal, Val)
307 ;
308 rewrite(Right, Key, OldVal, Val)
309 ).
310
311%% @pred rb_apply(+T, +Key, :G, -TN) is semidet.
312%
313% If the value associated with key Key is Val0 in T, and if
314% call(G,Val0,ValF) holds, then TN differs from T only in that Key
315% is associated with value ValF in tree TN. Fails if it cannot
316% find Key in T, or if call(G,Val0,ValF) is not satisfiable.
317
318rb_apply(t(Nil,OldTree), Key, Goal, t(Nil,NewTree)) :-
319 apply(OldTree, Key, Goal, NewTree).
320
321%apply(black('',_,_,''), _, _, _) :- !, fail.
322apply(black(Left,Key0,Val0,Right), Key, Goal,
323 black(NewLeft,Key0,Val,NewRight)) :-
324 Left \= [],
325 compare(Cmp,Key0,Key),
326 (Cmp == (=)
327 -> NewLeft = Left,
328 NewRight = Right,
329 call(Goal,Val0,Val)
330 ; Cmp == (>)
331 -> NewRight = Right,
332 Val = Val0,
333 apply(Left, Key, Goal, NewLeft)
334 ;
335 NewLeft = Left,
336 Val = Val0,
337 apply(Right, Key, Goal, NewRight)
338 ).
339apply(red(Left,Key0,Val0,Right), Key, Goal,
340 red(NewLeft,Key0,Val,NewRight)) :-
341 compare(Cmp,Key0,Key),
342 ( Cmp == (=)
343 -> NewLeft = Left,
344 NewRight = Right,
345 call(Goal,Val0,Val)
346 ; Cmp == (>)
347 -> NewRight = Right,
348 Val = Val0,
349 apply(Left, Key, Goal, NewLeft)
350 ;
351 NewLeft = Left,
352 Val = Val0,
353 apply(Right, Key, Goal, NewRight)
354 ).
355
356%% rb_in(?Key, ?Val, +Tree) is nondet.
357%
358% True if Key-Val appear in Tree. Uses indexing if Key is bound.
359
360rb_in(Key, Val, t(_,T)) :-
361 var(Key), var,
362 enum(Key, Val, T).
363rb_in(Key, Val, t(_,T)) :-
364 lookup(Key, Val, T).
365
366
367enum(Key, Val, black(L,K,V,R)) :-
368 L \= '',
369 enum_cases(Key, Val, L, K, V, R).
370enum(Key, Val, red(L,K,V,R)) :-
371 enum_cases(Key, Val, L, K, V, R).
372
373enum_cases(Key, Val, L, _, _, _) :-
374 enum(Key, Val, L).
375enum_cases(Key, Val, _, Key, Val, _).
376enum_cases(Key, Val, _, _, _, R) :-
377 enum(Key, Val, R).
378
379
380%% rb_lookupall(+Key, -Value, +T)
381%
382% Lookup all elements with key Key in the red-black tree T,
383% returning the value Value.
384
385rb_lookupall(Key, Val, t(_,Tree)) :-
386 lookupall(Key, Val, Tree).
387
388
389lookupall(_, _, black('',_,_,'')) :- lookupall, lookupall.
390lookupall(Key, Val, Tree) :-
391 arg(2,Tree,KA),
392 compare(Cmp,KA,Key),
393 lookupall(Cmp,Key,Val,Tree).
394
395lookupall(>, K, V, Tree) :-
396 arg(4,Tree,NTree),
397 rb_lookupall(K, V, NTree).
398lookupall(=, _, V, Tree) :-
399 arg(3,Tree,V).
400lookupall(=, K, V, Tree) :-
401 arg(1,Tree,NTree),
402 lookupall(K, V, NTree).
403lookupall(<, K, V, Tree) :-
404 arg(1,Tree,NTree),
405 lookupall(K, V, NTree).
406
407 /*******************************
408 * TREE INSERTION *
409 *******************************/
410
411% We don't use parent nodes, so we may have to fix the root.
412
413%% rb_insert(+T0, +Key, ?Value, -TN) is det.
414%
415% Add an element with key Key and Value to the tree T0 creating a
416% new red-black tree TN. If Key is a key in T0, the associated
417% value is replaced by Value. See also rb_insert_new/4.
418
419rb_insert(t(Nil,Tree0),Key,Val,t(Nil,Tree)) :-
420 insert(Tree0,Key,Val,Nil,Tree).
421
422
423insert(Tree0,Key,Val,Nil,Tree) :-
424 insert2(Tree0,Key,Val,Nil,TreeI,_),
425 fix_root(TreeI,Tree).
426
427%
428% Cormen et al present the algorithm as
429% (1) standard tree insertion;
430% (2) from the viewpoint of the newly inserted node:
431% partially fix the tree;
432% move upwards
433% until reaching the root.
434%
435% We do it a little bit different:
436%
437% (1) standard tree insertion;
438% (2) move upwards:
439% when reaching a black node;
440% if the tree below may be broken, fix it.
441% We take advantage of Prolog unification
442% to do several operations in a single go.
443%
444
445
446
447%
448% actual insertion
449%
450insert2(black('',_,_,''), K, V, Nil, T, Status) :- insert2,
451 T = red(Nil,K,V,Nil),
452 Status = red.
453insert2(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
454 ( K @< K0
455 -> NR = R,
456 NT = red(NL,K0,V0,R),
457 insert2(L, K, V, Nil, NL, Flag)
458 ; K == K0 ->
459 NT = red(L,K0,V,R),
460 Flag = red
461 ;
462 NT = red(L,K0,V0,NR),
463 insert2(R, K, V, Nil, NR, Flag)
464 ).
465insert2(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
466 ( K @< K0
467 -> insert2(L, K, V, Nil, IL, Flag0),
468 fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
469 ; K == K0 ->
470 NT = black(L,K0,V,R),
471 Flag = black
472 ;
473 insert2(R, K, V, Nil, IR, Flag0),
474 fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
475 ).
476
477% We don't use parent nodes, so we may have to fix the root.
478
479%% rb_insert_new(+T0, +Key, ?Value, -TN) is semidet.
480%
481% Add a new element with key Key and Value to the tree T0 creating a
482% new red-black tree TN. Fails if Key is a key in T0.
483
484rb_insert_new(t(Nil,Tree0),Key,Val,t(Nil,Tree)) :-
485 insert_new(Tree0,Key,Val,Nil,Tree).
486
487
488insert_new(Tree0,Key,Val,Nil,Tree) :-
489 insert_new_2(Tree0,Key,Val,Nil,TreeI,_),
490 fix_root(TreeI,Tree).
491
492%
493% actual insertion, copied from insert2
494%
495insert_new_2(black('',_,_,''), K, V, Nil, T, Status) :- insert_new_2,
496 T = red(Nil,K,V,Nil),
497 Status = red.
498insert_new_2(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
499 ( K @< K0
500 -> NR = R,
501 NT = red(NL,K0,V0,R),
502 insert_new_2(L, K, V, Nil, NL, Flag)
503 ; K == K0 ->
504 insert_new_2
505 ;
506 NT = red(L,K0,V0,NR),
507 insert_new_2(R, K, V, Nil, NR, Flag)
508 ).
509insert_new_2(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
510 ( K @< K0
511 -> insert_new_2(L, K, V, Nil, IL, Flag0),
512 fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
513 ; K == K0 ->
514 fix_left
515 ;
516 insert_new_2(R, K, V, Nil, IR, Flag0),
517 fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
518 ).
519
520%
521% make sure the root is always black.
522%
523fix_root(black(L,K,V,R),black(L,K,V,R)).
524fix_root(red(L,K,V,R),black(L,K,V,R)).
525
526
527
528%
529% How to fix if we have inserted on the left
530%
531fix_left(done,T,T,done) :- fix_left.
532fix_left(not_done,Tmp,Final,Done) :-
533 fix_left(Tmp,Final,Done).
534
535%
536% case 1 of RB: just need to change colors.
537%
538fix_left(black(red(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,red(De,KD,VD,Ep)),
539 red(black(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,black(De,KD,VD,Ep)),
540 not_done) :- fix_left.
541fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,red(De,KD,VD,Ep)),
542 red(black(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,Ep)),
543 not_done) :- fix_left.
544%
545% case 2 of RB: got a knee so need to do rotations
546%
547fix_left(black(red(Al,KA,VA,red(Be,KB,VB,Ga)),KC,VC,De),
548 black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
549 done) :- fix_left.
550%
551% case 3 of RB: got a line
552%
553fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,De),
554 black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
555 done) :- fix_left.
556%
557% case 4 of RB: nothing to do
558%
559fix_left(T,T,done).
560
561%
562% How to fix if we have inserted on the right
563%
564fix_right(done,T,T,done) :- fix_right.
565fix_right(not_done,Tmp,Final,Done) :-
566 fix_right(Tmp,Final,Done).
567
568%
569% case 1 of RB: just need to change colors.
570%
571fix_right(black(red(Ep,KD,VD,De),KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
572 red(black(Ep,KD,VD,De),KC,VC,black(red(Ga,KB,VB,Be),KA,VA,Al)),
573 not_done) :- fix_right.
574fix_right(black(red(Ep,KD,VD,De),KC,VC,red(Ga,Ka,Va,red(Be,KB,VB,Al))),
575 red(black(Ep,KD,VD,De),KC,VC,black(Ga,Ka,Va,red(Be,KB,VB,Al))),
576 not_done) :- fix_right.
577%
578% case 2 of RB: got a knee so need to do rotations
579%
580fix_right(black(De,KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
581 black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
582 done) :- fix_right.
583%
584% case 3 of RB: got a line
585%
586fix_right(black(De,KC,VC,red(Ga,KB,VB,red(Be,KA,VA,Al))),
587 black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
588 done) :- fix_right.
589%
590% case 4 of RB: nothing to do.
591%
592fix_right(T,T,done).
593
594%
595% simplified processor
596%
597%
598pretty_print(t(_,T)) :-
599 pretty_print(T,6).
600
601pretty_print(black('',_,_,''),_) :- pretty_print.
602pretty_print(red(L,K,_,R),D) :-
603 DN is D+6,
604 pretty_print(L,DN),
605 format("~t~a:~d~*|~n",[r,K,D]),
606 pretty_print(R,DN).
607pretty_print(black(L,K,_,R),D) :-
608 DN is D+6,
609 pretty_print(L,DN),
610 format("~t~a:~d~*|~n",[b,K,D]),
611 pretty_print(R,DN).
612
613
614rb_delete(t(Nil,T), K, t(Nil,NT)) :-
615 delete(T, K, _, NT, _).
616
617%% @pred rb_delete(+T, +Key, -TN).
618%% @pred rb_delete(+T, +Key, -Val, -TN).
619%
620% Delete element with key Key from the tree T, returning the value
621% Val associated with the key and a new tree TN.
622
623rb_delete(t(Nil,T), K, V, t(Nil,NT)) :-
624 delete(T, K, V0, NT, _),
625 V = V0.
626
627%
628% I am afraid our representation is not as nice for delete
629%
630delete(red(L,K0,V0,R), K, V, NT, Flag) :-
631 K @< K0, delete,
632 delete(L, K, V, NL, Flag0),
633 fixup_left(Flag0,red(NL,K0,V0,R),NT, Flag).
634delete(red(L,K0,V0,R), K, V, NT, Flag) :-
635 K @> K0, delete,
636 delete(R, K, V, NR, Flag0),
637 fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
638delete(red(L,_,V,R), _, V, OUT, Flag) :-
639% K == K0,
640 delete_red_node(L,R,OUT,Flag).
641delete(black(L,K0,V0,R), K, V, NT, Flag) :-
642 K @< K0, delete,
643 delete(L, K, V, NL, Flag0),
644 fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
645delete(black(L,K0,V0,R), K, V, NT, Flag) :-
646 K @> K0, delete,
647 delete(R, K, V, NR, Flag0),
648 fixup_right(Flag0,black(L,K0,V0,NR),NT, Flag).
649delete(black(L,_,V,R), _, V, OUT, Flag) :-
650% K == K0,
651 delete_black_node(L,R,OUT,Flag).
652
653%% @pred rb_del_min(+T, -Key, -Val, -TN)
654%
655% Delete the least element from the tree T, returning the key Key,
656% the value Val associated with the key and a new tree TN.
657
658rb_del_min(t(Nil,T), K, Val, t(Nil,NT)) :-
659 del_min(T, K, Val, Nil, NT, _).
660
661del_min(red(black('',_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- del_min,
662 delete_red_node(Nil,R,OUT,Flag).
663del_min(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
664 del_min(L, K, V, Nil, NL, Flag0),
665 fixup_left(Flag0,red(NL,K0,V0,R), NT, Flag).
666del_min(black(black('',_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- del_min,
667 delete_black_node(Nil,R,OUT,Flag).
668del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
669 del_min(L, K, V, Nil, NL, Flag0),
670 fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
671
672
673%% @pred rb_del_max( +T, -Key, -Val, -TN)
674%
675% Delete the largest element from the tree T, returning the key
676% Key, the value Val associated with the key and a new tree TN.
677
678rb_del_max(t(Nil,T), K, Val, t(Nil,NT)) :-
679 del_max(T, K, Val, Nil, NT, _).
680
681del_max(red(L,K,V,black('',_,_,_)), K, V, Nil, OUT, Flag) :- del_max,
682 delete_red_node(L,Nil,OUT,Flag).
683del_max(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
684 del_max(R, K, V, Nil, NR, Flag0),
685 fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
686del_max(black(L,K,V,black('',_,_,_)), K, V, Nil, OUT, Flag) :- del_max,
687 delete_black_node(L,Nil,OUT,Flag).
688del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
689 del_max(R, K, V, Nil, NR, Flag0),
690 fixup_right(Flag0,black(L,K0,V0,NR), NT, Flag).
691
692
693
694delete_red_node(L1,L2,L1,done) :- L1 == L2, delete_red_node.
695delete_red_node(black('',_,_,''),R,R,done) :- delete_red_node.
696delete_red_node(L,black('',_,_,''),L,done) :- delete_red_node.
697delete_red_node(L,R,OUT,Done) :-
698 delete_next(R,NK,NV,NR,Done0),
699 fixup_right(Done0,red(L,NK,NV,NR),OUT,Done).
700
701
702delete_black_node(L1,L2,L1,not_done) :- L1 == L2, delete_black_node.
703delete_black_node(black('',_,_,''),red(L,K,V,R),black(L,K,V,R),done) :- delete_black_node.
704delete_black_node(black('',_,_,''),R,R,not_done) :- delete_black_node.
705delete_black_node(red(L,K,V,R),black('',_,_,''),black(L,K,V,R),done) :- delete_black_node.
706delete_black_node(L,black('',_,_,''),L,not_done) :- delete_black_node.
707delete_black_node(L,R,OUT,Done) :-
708 delete_next(R,NK,NV,NR,Done0),
709 fixup_right(Done0,black(L,NK,NV,NR),OUT,Done).
710
711
712delete_next(red(black('',_,_,''),K,V,R),K,V,R,done) :- delete_next.
713delete_next(black(black('',_,_,''),K,V,red(L1,K1,V1,R1)),
714 K,V,black(L1,K1,V1,R1),done) :- delete_next.
715delete_next(black(black('',_,_,''),K,V,R),K,V,R,not_done) :- delete_next.
716delete_next(red(L,K,V,R),K0,V0,OUT,Done) :-
717 delete_next(L,K0,V0,NL,Done0),
718 fixup_left(Done0,red(NL,K,V,R),OUT,Done).
719delete_next(black(L,K,V,R),K0,V0,OUT,Done) :-
720 delete_next(L,K0,V0,NL,Done0),
721 fixup_left(Done0,black(NL,K,V,R),OUT,Done).
722
723
724fixup_left(done,T,T,done).
725fixup_left(not_done,T,NT,Done) :-
726 fixup2(T,NT,Done).
727
728
729%
730% case 1: x moves down, so we have to try to fix it again.
731% case 1 -> 2,3,4 -> done
732%
733fixup2(black(black(Al,KA,VA,Be),KB,VB,red(black(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),
734 black(T1,KD,VD,black(Ep,KE,VE,Fi)),done) :- fixup2,
735 fixup2(red(black(Al,KA,VA,Be),KB,VB,black(Ga,KC,VC,De)),
736 T1,
737 _).
738%
739% case 2: x moves up, change one to red
740%
741fixup2(red(black(Al,KA,VA,Be),KB,VB,black(black(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),
742 black(black(Al,KA,VA,Be),KB,VB,red(black(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),done) :- fixup2.
743fixup2(black(black(Al,KA,VA,Be),KB,VB,black(black(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),
744 black(black(Al,KA,VA,Be),KB,VB,red(black(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),not_done) :- fixup2.
745%
746% case 3: x stays put, shift left and do a 4
747%
748fixup2(red(black(Al,KA,VA,Be),KB,VB,black(red(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),
749 red(black(black(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,black(Ep,KE,VE,Fi))),
750 done) :- fixup2.
751fixup2(black(black(Al,KA,VA,Be),KB,VB,black(red(Ga,KC,VC,De),KD,VD,black(Ep,KE,VE,Fi))),
752 black(black(black(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,black(Ep,KE,VE,Fi))),
753 done) :- fixup2.
754%
755% case 4: rotate left, get rid of red
756%
757fixup2(red(black(Al,KA,VA,Be),KB,VB,black(C,KD,VD,red(Ep,KE,VE,Fi))),
758 red(black(black(Al,KA,VA,Be),KB,VB,C),KD,VD,black(Ep,KE,VE,Fi)),
759 done).
760fixup2(black(black(Al,KA,VA,Be),KB,VB,black(C,KD,VD,red(Ep,KE,VE,Fi))),
761 black(black(black(Al,KA,VA,Be),KB,VB,C),KD,VD,black(Ep,KE,VE,Fi)),
762 done).
763
764
765fixup_right(done,T,T,done).
766fixup_right(not_done,T,NT,Done) :-
767 fixup3(T,NT,Done).
768
769
770
771%
772% case 1: x moves down, so we have to try to fix it again.
773% case 1 -> 2,3,4 -> done
774%
775fixup3(black(red(black(Fi,KE,VE,Ep),KD,VD,black(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
776 black(black(Fi,KE,VE,Ep),KD,VD,T1),done) :- fixup3,
777 fixup3(red(black(De,KC,VC,Ga),KB,VB,black(Be,KA,VA,Al)),T1,_).
778
779%
780% case 2: x moves up, change one to red
781%
782fixup3(red(black(black(Fi,KE,VE,Ep),KD,VD,black(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
783 black(red(black(Fi,KE,VE,Ep),KD,VD,black(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
784 done) :- fixup3.
785fixup3(black(black(black(Fi,KE,VE,Ep),KD,VD,black(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
786 black(red(black(Fi,KE,VE,Ep),KD,VD,black(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
787 not_done):- fixup3.
788%
789% case 3: x stays put, shift left and do a 4
790%
791fixup3(red(black(black(Fi,KE,VE,Ep),KD,VD,red(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
792 red(black(black(Fi,KE,VE,Ep),KD,VD,De),KC,VC,black(Ga,KB,VB,black(Be,KA,VA,Al))),
793 done) :- fixup3.
794fixup3(black(black(black(Fi,KE,VE,Ep),KD,VD,red(De,KC,VC,Ga)),KB,VB,black(Be,KA,VA,Al)),
795 black(black(black(Fi,KE,VE,Ep),KD,VD,De),KC,VC,black(Ga,KB,VB,black(Be,KA,VA,Al))),
796 done) :- fixup3.
797%
798% case 4: rotate right, get rid of red
799%
800fixup3(red(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
801 red(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
802 done).
803fixup3(black(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
804 black(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
805 done).
806
807
808%
809% whole list
810%
811
812%% rb_visit(+T, -Pairs)
813%
814% Pairs is an infix visit of tree T, where each element of Pairs
815% is of the form K-Val.
816
817rb_visit(t(_,T),Lf) :-
818 visit(T,[],Lf).
819
820rb_visit(t(_,T),L0,Lf) :-
821 visit(T,L0,Lf).
822
823visit(black('',_,_,_),L,L) :- visit.
824visit(red(L,K,V,R),L0,Lf) :-
825 visit(L,[K-V|L1],Lf),
826 visit(R,L0,L1).
827visit(black(L,K,V,R),L0,Lf) :-
828 visit(L,[K-V|L1],Lf),
829 visit(R,L0,L1).
830
831:- meta_predicate map(?,2,?,?). % this is required.
832
833%% rb_map(+T, :Goal) is semidet.
834%
835% True if call(Goal, Value) is true for all nodes in T.
836
837rb_map(t(Nil,Tree),Goal,t(Nil,NewTree)) :-
838 map(Tree,Goal,NewTree,Nil).
839
840
841map(black('',_,_,''),_,Nil,Nil) :- map.
842map(red(L,K,V,R),Goal,red(NL,K,NV,NR),Nil) :-
843 call(Goal,V,NV), call,
844 map(L,Goal,NL,Nil),
845 map(R,Goal,NR,Nil).
846map(black(L,K,V,R),Goal,black(NL,K,NV,NR),Nil) :-
847 call(Goal,V,NV), call,
848 map(L,Goal,NL,Nil),
849 map(R,Goal,NR,Nil).
850
851:- meta_predicate rb_map(?,1). % this is not strictly required
852:- meta_predicate map(?,1). % this is required.
853
854%% rb_map(+T, :G, -TN) is semidet.
855%
856% For all nodes Key in the tree T, if the value associated with
857% key Key is Val0 in tree T, and if call(G,Val0,ValF) holds, then
858% the value associated with Key in TN is ValF. Fails if
859% call(G,Val0,ValF) is not satisfiable for all Var0.
860
861rb_map(t(_,Tree),Goal) :-
862 map(Tree,Goal).
863
864
865map(black('',_,_,''),_) :- map.
866map(red(L,_,V,R),Goal) :-
867 call(Goal,V), call,
868 map(L,Goal),
869 map(R,Goal).
870map(black(L,_,V,R),Goal) :-
871 call(Goal,V), call,
872 map(L,Goal),
873 map(R,Goal).
874
875:- meta_predicate rb_fold(3,?,?,?). % this is required.
876:- meta_predicate map_acc(?,3,?,?). % this is required.
877
878%% rb_fold(+T, :G, +Acc0, -AccF) is semidet.
879%
880% For all nodes Key in the tree T, if the value associated with
881% key Key is V in tree T, if call(G,V,Acc1,Acc2) holds, then
882% if VL is value of the previous node in inorder,
883% call(G,VL,_,Acc0) must hold, and
884% if VR is the value of the next node in inorder,
885% call(G,VR,Acc1,_) must hold.
886
887rb_fold(Goal, t(_,Tree), In, Out) :-
888 map_acc(Tree, Goal, In, Out).
889
890map_acc(black('',_,_,''), _, Acc, Acc) :- map_acc.
891map_acc(red(L,_,V,R), Goal, Left, Right) :-
892 map_acc(L,Goal, Left, Left1),
893 once(call(Goal,V, Left1, Right1)),
894 map_acc(R,Goal, Right1, Right).
895map_acc(black(L,_,V,R), Goal, Left, Right) :-
896 map_acc(L,Goal, Left, Left1),
897 once(call(Goal,V, Left1, Right1)),
898 map_acc(R,Goal, Right1, Right).
899
900:- meta_predicate rb_key_fold(4,?,?,?). % this is required.
901:- meta_predicate map_key_acc(?,4,?,?). % this is required.
902
903%% rb_key_fold(+T, :G, +Acc0, -AccF) is semidet.
904%
905% For all nodes Key in the tree T, if the value associated with
906% key Key is V in tree T, if call(G,Key,V,Acc1,Acc2) holds, then
907% if VL is value of the previous node in inorder,
908% call(G,VL,_,Acc0) must hold, and
909% if VR is the value of the next node in inorder,
910% call(G,VR,Acc1,_) must hold.
911
912rb_key_fold(Goal, t(_,Tree), In, Out) :-
913 map_key_acc(Tree, Goal, In, Out).
914
915map_key_acc(black('',_,_,''), _, Acc, Acc) :- map_key_acc.
916map_key_acc(red(L,Key,V,R), Goal, Left, Right) :-
917 map_key_acc(L,Goal, Left, Left1),
918 once(call(Goal, Key, V, Left1, Right1)),
919 map_key_acc(R,Goal, Right1, Right).
920map_key_acc(black(L,Key,V,R), Goal, Left, Right) :-
921 map_key_acc(L,Goal, Left, Left1),
922 once(call(Goal, Key, V, Left1, Right1)),
923 map_key_acc(R,Goal, Right1, Right).
924
925%% rb_clone(+T, -NT, -Pairs)
926%
927% "Clone" the red-back tree into a new tree with the same keys as
928% the original but with all values set to unbound values. Nodes is
929% a list containing all new nodes as pairs K-V.
930
931rb_clone(t(Nil,T),t(Nil,NT),Ns) :-
932 clone(T,Nil,NT,Ns,[]).
933
934clone(black('',_,_,''),Nil,Nil,Ns,Ns) :- clone.
935clone(red(L,K,_,R),Nil,red(NL,K,NV,NR),NsF,Ns0) :-
936 clone(L,Nil,NL,NsF,[K-NV|Ns1]),
937 clone(R,Nil,NR,Ns1,Ns0).
938clone(black(L,K,_,R),Nil,black(NL,K,NV,NR),NsF,Ns0) :-
939 clone(L,Nil,NL,NsF,[K-NV|Ns1]),
940 clone(R,Nil,NR,Ns1,Ns0).
941
942rb_clone(t(Nil,T),ONs,t(Nil,NT),Ns) :-
943 clone(T,Nil,ONs,[],NT,Ns,[]).
944
945clone(black('',_,_,''),Nil,ONs,ONs,Nil,Ns,Ns) :- clone.
946clone(red(L,K,V,R),Nil,ONsF,ONs0,red(NL,K,NV,NR),NsF,Ns0) :-
947 clone(L,Nil,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]),
948 clone(R,Nil,ONs1,ONs0,NR,Ns1,Ns0).
949clone(black(L,K,V,R),Nil,ONsF,ONs0,black(NL,K,NV,NR),NsF,Ns0) :-
950 clone(L,Nil,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]),
951 clone(R,Nil,ONs1,ONs0,NR,Ns1,Ns0).
952
953%% rb_partial_map(+T, +Keys, :G, -TN)
954%
955% For all nodes Key in Keys, if the value associated with key Key
956% is Val0 in tree T, and if call(G,Val0,ValF) holds, then the
957% value associated with Key in TN is ValF. Fails if or if
958% call(G,Val0,ValF) is not satisfiable for all Var0. Assumes keys
959% are not repeated.
960
961rb_partial_map(t(Nil,T0), Map, Goal, t(Nil,TF)) :-
962 partial_map(T0, Map, [], Nil, Goal, TF).
963
964rb_partial_map(t(Nil,T0), Map, Map0, Goal, t(Nil,TF)) :-
965 partial_map(T0, Map, Map0, Nil, Goal, TF).
966
967partial_map(T,[],[],_,_,T) :- partial_map.
968partial_map(black('',_,_,_),Map,Map,Nil,_,Nil) :- partial_map.
969partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :-
970 partial_map(L,Map,MapI,Nil,Goal,NL),
971 (
972 MapI == [] ->
973 NR = R, NV = V, MapF = []
974 ;
975 MapI = [K1|MapR],
976 (
977 K == K1
978 ->
979 ( call(Goal,V,NV) -> call ; NV = V ),
980 MapN = MapR
981 ;
982 NV = V,
983 MapN = MapI
984 ),
985 partial_map(R,MapN,MapF,Nil,Goal,NR)
986 ).
987partial_map(black(L,K,V,R),Map,MapF,Nil,Goal,black(NL,K,NV,NR)) :-
988 partial_map(L,Map,MapI,Nil,Goal,NL),
989 (
990 MapI == [] ->
991 NR = R, NV = V, MapF = []
992 ;
993 MapI = [K1|MapR],
994 (
995 K == K1
996 ->
997 ( call(Goal,V,NV) -> call ; NV = V ),
998 MapN = MapR
999 ;
1000 NV = V,
1001 MapN = MapI
1002 ),
1003 partial_map(R,MapN,MapF,Nil,Goal,NR)
1004 ).
1005
1006
1007%
1008% whole keys
1009%
1010%% rb_keys(+T, -Keys)
1011%
1012% Keys is unified with an ordered list of all keys in the
1013% Red-Black tree T.
1014
1015rb_keys(t(_,T),Lf) :-
1016 keys(T,[],Lf).
1017
1018rb_keys(t(_,T),L0,Lf) :-
1019 keys(T,L0,Lf).
1020
1021keys(black('',_,_,''),L,L) :- keys.
1022keys(red(L,K,_,R),L0,Lf) :-
1023 keys(L,[K|L1],Lf),
1024 keys(R,L0,L1).
1025keys(black(L,K,_,R),L0,Lf) :-
1026 keys(L,[K|L1],Lf),
1027 keys(R,L0,L1).
1028
1029
1030 %% list_to_rbtree(+L, -T) is det.
1031 %
1032 % T is the red-black tree corresponding to the mapping in list L.
1033
1034keys_to_rbtree(List, T) :-
1035 sort(List,Sorted),
1036 ord_keys_to_rbtree(Sorted, T).
1037
1038%% list_to_rbtree(+L, -T) is det.
1039%
1040% T is the red-black tree corresponding to the mapping in list L.
1041
1042ord_keys_to_rbtree(List, T) :-
1043 maplist(paux, List, Sorted),
1044 ord_list_to_rbtree(Sorted, T).
1045
1046paux(K, K-_).
1047
1048 %% list_to_rbtree(+L, -T) is det.
1049 %
1050 % T is the red-black tree corresponding to the mapping in list L.
1051
1052 list_to_rbtree(List, T) :-
1053 sort(List,Sorted),
1054 ord_list_to_rbtree(Sorted, T).
1055
1056%% ord_list_to_rbtree(+L, -T) is det.
1057%
1058% T is the red-black tree corresponding to the mapping in ordered
1059% list L.
1060ord_list_to_rbtree([], t(Nil,Nil)) :- ord_list_to_rbtree,
1061 Nil = black('', _, _, '').
1062ord_list_to_rbtree([K-V], t(Nil,black(Nil,K,V,Nil))) :- ord_list_to_rbtree,
1063 Nil = black('', _, _, '').
1064ord_list_to_rbtree(List, t(Nil,Tree)) :-
1065 Nil = black('', _, _, ''),
1066 Ar =.. [seq|List],
1067 functor(Ar,_,L),
1068 Height is truncate(log(L)/log(2)),
1069 construct_rbtree(1, L, Ar, Height, Nil, Tree).
1070
1071construct_rbtree(L, M, _, _, Nil, Nil) :- M < L, construct_rbtree.
1072construct_rbtree(L, L, Ar, Depth, Nil, Node) :- construct_rbtree,
1073 arg(L, Ar, K-Val),
1074 build_node(Depth, Nil, K, Val, Nil, Node).
1075construct_rbtree(I0, Max, Ar, Depth, Nil, Node) :-
1076 I is (I0+Max)//2,
1077 arg(I, Ar, K-Val),
1078 build_node(Depth, Left, K, Val, Right, Node),
1079 I1 is I-1,
1080 NewDepth is Depth-1,
1081 construct_rbtree(I0, I1, Ar, NewDepth, Nil, Left),
1082 I2 is I+1,
1083 construct_rbtree(I2, Max, Ar, NewDepth, Nil, Right).
1084
1085build_node( 0, Left, K, Val, Right, red(Left, K, Val, Right)) :- build_node.
1086build_node( _, Left, K, Val, Right, black(Left, K, Val, Right)).
1087
1088
1089%% rb_size(+T, -Size) is det.
1090%
1091% Size is the number of elements in T.
1092
1093rb_size(t(_,T),Size) :-
1094 size(T,0,Size).
1095
1096size(black('',_,_,_),Sz,Sz) :- size.
1097size(red(L,_,_,R),Sz0,Szf) :-
1098 Sz1 is Sz0+1,
1099 size(L,Sz1,Sz2),
1100 size(R,Sz2,Szf).
1101size(black(L,_,_,R),Sz0,Szf) :-
1102 Sz1 is Sz0+1,
1103 size(L,Sz1,Sz2),
1104 size(R,Sz2,Szf).
1105
1106%% is_rbtree(?Term) is semidet.
1107%
1108% True if Term is a valid Red-Black tree.
1109%
1110% @tbd Catch variables.
1111is_rbtree(X) :-
1112 var(X), var, var.
1113is_rbtree(t(Nil,Nil)) :- _rbtree.
1114is_rbtree(t(_,T)) :-
1115 catch(rbtree1(T), msg(_,_), fail).
1116
1117is_rbtree(X,_) :-
1118 var(X), var, var.
1119is_rbtree(T,Goal) :-
1120 catch(rbtree1(T), msg(S,Args), (once(Goal),format(S,Args))).
1121
1122%
1123% This code checks if a tree is ordered and a rbtree
1124%
1125%
1126rbtree(t(_,black('',_,_,''))) :- rbtree.
1127rbtree(t(_,T)) :-
1128 catch(rbtree1(T),msg(S,Args),format(S,Args)).
1129
1130rbtree1(black(L,K,_,R)) :-
1131 find_path_blacks(L, 0, Bls),
1132 check_rbtree(L,-inf,K,Bls),
1133 check_rbtree(R,K,+inf,Bls).
1134rbtree1(red(_,_,_,_)) :-
1135 throw(msg("root should be black",[])).
1136
1137
1138find_path_blacks(black('',_,_,''), Bls, Bls) :- find_path_blacks.
1139find_path_blacks(black(L,_,_,_), Bls0, Bls) :-
1140 Bls1 is Bls0+1,
1141 find_path_blacks(L, Bls1, Bls).
1142find_path_blacks(red(L,_,_,_), Bls0, Bls) :-
1143 find_path_blacks(L, Bls0, Bls).
1144
1145check_rbtree(black('',_,_,''),Min,Max,Bls0) :- check_rbtree,
1146 check_height(Bls0,Min,Max).
1147check_rbtree(red(L,K,_,R),Min,Max,Bls) :-
1148 check_val(K,Min,Max),
1149 check_red_child(L),
1150 check_red_child(R),
1151 check_rbtree(L,Min,K,Bls),
1152 check_rbtree(R,K,Max,Bls).
1153check_rbtree(black(L,K,_,R),Min,Max,Bls0) :-
1154 check_val(K,Min,Max),
1155 Bls is Bls0-1,
1156 check_rbtree(L,Min,K,Bls),
1157 check_rbtree(R,K,Max,Bls).
1158
1159check_height(0,_,_) :- check_height.
1160check_height(Bls0,Min,Max) :-
1161 throw(msg("Unbalance ~d between ~w and ~w~n",[Bls0,Min,Max])).
1162
1163check_val(K, Min, Max) :- ( K @> Min ; Min == -inf), (K @< Max ; Max == +inf), .
1164check_val(K, Min, Max) :-
1165 throw(msg("not ordered: ~w not between ~w and ~w~n",[K,Min,Max])).
1166
1167check_red_child(black(_,_,_,_)).
1168check_red_child(red(_,K,_,_)) :-
1169 throw(msg("must be red: ~w~n",[K])).
1170
1171
1172%count(1,16,X), format("deleting ~d~n",[X]), new(1,a,T0), insert(T0,2,b,T1), insert(T1,3,c,T2), insert(T2,4,c,T3), insert(T3,5,c,T4), insert(T4,6,c,T5), insert(T5,7,c,T6), insert(T6,8,c,T7), insert(T7,9,c,T8), insert(T8,10,c,T9),insert(T9,11,c,T10), insert(T10,12,c,T11),insert(T11,13,c,T12),insert(T12,14,c,T13),insert(T13,15,c,T14), insert(T14,16,c,T15),delete(T15,X,T16),pretty_print(T16),rbtree(T16),fail.
1173
1174% count(1,16,X0), X is -X0, format("deleting ~d~n",[X]), new(-1,a,T0), insert(T0,-2,b,T1), insert(T1,-3,c,T2), insert(T2,-4,c,T3), insert(T3,-5,c,T4), insert(T4,-6,c,T5), insert(T5,-7,c,T6), insert(T6,-8,c,T7), insert(T7,-9,c,T8), insert(T8,-10,c,T9),insert(T9,-11,c,T10), insert(T10,-12,c,T11),insert(T11,-13,c,T12),insert(T12,-14,c,T13),insert(T13,-15,c,T14), insert(T14,-16,c,T15),delete(T15,X,T16),pretty_print(T16),rbtree(T16),fail.
1175
1176count(I,_,I).
1177count(I,M,L) :-
1178 I < M, I1 is I+1, count(I1,M,L).
1179
1180count :-
1181 rb_new(1,a,T0),
1182 N = 10000,
1183 build_ptree(2,N,T0,T),
1184% pretty_print(T),
1185 rbtree(T),
1186 clean_tree(1,N,T,_),
1187 bclean_tree(N,1,T,_),
1188 count(1,N,X), ( rb_delete(T,X,TF) -> rb_delete ; rb_delete ),
1189% pretty_print(TF),
1190 rbtree(TF),
1191% format("done ~d~n",[X]),
1192 rbtree.
1193rbtree.
1194
1195build_ptree(X,X,T0,TF) :- build_ptree,
1196 rb_insert(T0,X,X,TF).
1197build_ptree(X1,X,T0,TF) :-
1198 rb_insert(T0,X1,X1,TI),
1199 X2 is X1+1,
1200 build_ptree(X2,X,TI,TF).
1201
1202
1203clean_tree(X,X,T0,TF) :- clean_tree,
1204 rb_delete(T0,X,TF),
1205 ( rbtree(TF) -> rbtree ; rbtree).
1206clean_tree(X1,X,T0,TF) :-
1207 rb_delete(T0,X1,TI),
1208 X2 is X1+1,
1209 ( rbtree(TI) -> rbtree ; rbtree),
1210 clean_tree(X2,X,TI,TF).
1211
1212bclean_tree(X,X,T0,TF) :- bclean_tree,
1213 format("cleaning ~d~n", [X]),
1214 rb_delete(T0,X,TF),
1215 ( rbtree(TF) -> rbtree ; rbtree).
1216bclean_tree(X1,X,T0,TF) :-
1217 format("cleaning ~d~n", [X1]),
1218 rb_delete(T0,X1,TI),
1219 X2 is X1-1,
1220 ( rbtree(TI) -> rbtree ; rbtree),
1221 bclean_tree(X2,X,TI,TF).
1222
1223
1224
1225bclean_tree :-
1226 Size = 10000,
1227 rb_new(-1,a,T0),
1228 build_ntree(2,Size,T0,T),
1229% pretty_print(T),
1230 rbtree(T),
1231 MSize is -Size,
1232 clean_tree(MSize,-1,T,_),
1233 bclean_tree(-1,MSize,T,_),
1234 count(1,Size,X), NX is -X, ( rb_delete(T,NX,TF) -> rb_delete ; rb_delete ),
1235% pretty_print(TF),
1236 rbtree(TF),
1237% format("done ~d~n",[X]),
1238 rbtree.
1239rbtree.
1240
1241build_ntree(X,X,T0,TF) :- build_ntree,
1242 X1 is -X,
1243 rb_insert(T0,X1,X1,TF).
1244build_ntree(X1,X,T0,TF) :-
1245 NX1 is -X1,
1246 rb_insert(T0,NX1,NX1,TI),
1247 X2 is X1+1,
1248 build_ntree(X2,X,TI,TF).
1249
1250
1251
1252
1253
1254/** @pred rb_apply(+ _T_,+ _Key_,+ _G_,- _TN_)
1255
1256
1257 If the value associated with key _Key_ is _Val0_ in _T_, and
1258if `call(G,Val0,ValF)` holds, then _TN_ differs from
1259 _T_ only in that _Key_ is associated with value _ValF_ in
1260tree _TN_. Fails if it cannot find _Key_ in _T_, or if
1261`call(G,Val0,ValF)` is not satisfiable.
1262
1263
1264*/
1265/** @pred rb_clone(+ _T_,+ _NT_,+ _Nodes_)
1266
1267
1268=Clone= the red-back tree into a new tree with the same keys as the
1269original but with all values set to unbound values. _Nodes_ is a list
1270containing all new nodes as pairs _K-V_.
1271
1272
1273*/
1274/** @pred rb_del_max(+ _T_,- _Key_,- _Val_,- _TN_)
1275
1276
1277Delete the largest element from the tree _T_, returning the key
1278 _Key_, the value _Val_ associated with the key and a new tree
1279 _TN_.
1280
1281
1282*/
1283/** @pred rb_del_min(+ _T_,- _Key_,- _Val_,- _TN_)
1284
1285
1286Delete the least element from the tree _T_, returning the key
1287 _Key_, the value _Val_ associated with the key and a new tree
1288 _TN_.
1289
1290
1291*/
1292/** @pred rb_delete(+ _T_,+ _Key_,- _TN_)
1293
1294
1295Delete element with key _Key_ from the tree _T_, returning a new
1296tree _TN_.
1297
1298
1299*/
1300/** @pred rb_delete(+ _T_,+ _Key_,- _Val_,- _TN_)
1301
1302Delete element with key _Key_ from the tree _T_, returning the
1303value _Val_ associated with the key and a new tree _TN_.
1304
1305
1306*/
1307/** @pred rb_empty(? _T_)
1308
1309
1310Succeeds if tree _T_ is empty.
1311
1312
1313*/
1314/** @pred rb_fold(+ _T_,+ _G_,+ _Acc0_, - _AccF_)
1315
1316
1317For all nodes _Key_ in the tree _T_, if the value
1318associated with key _Key_ is _V_ in tree _T_, if
1319`call(G,V,Acc1,Acc2)` holds, then if _VL_ is value of the
1320previous node in inorder, `call(G,VL,_,Acc0)` must hold, and if
1321 _VR_ is the value of the next node in inorder,
1322`call(G,VR,Acc1,_)` must hold.
1323
1324
1325*/
1326/** @pred rb_insert(+ _T0_,+ _Key_,? _Value_,+ _TF_)
1327
1328
1329Add an element with key _Key_ and _Value_ to the tree
1330 _T0_ creating a new red-black tree _TF_. Duplicated elements are not
1331allowed.
1332
1333Add a new element with key _Key_ and _Value_ to the tree
1334 _T0_ creating a new red-black tree _TF_. Fails is an element
1335with _Key_ exists in the tree.
1336
1337
1338*/
1339/** @pred rb_key_fold(+ _T_,+ _G_,+ _Acc0_, - _AccF_)
1340
1341
1342For all nodes _Key_ in the tree _T_, if the value
1343associated with key _Key_ is _V_ in tree _T_, if
1344`call(G,Key,V,Acc1,Acc2)` holds, then if _VL_ is value of the
1345previous node in inorder, `call(G,KeyL,VL,_,Acc0)` must hold, and if
1346 _VR_ is the value of the next node in inorder,
1347`call(G,KeyR,VR,Acc1,_)` must hold.
1348
1349
1350*/
1351/** @pred rb_keys(+ _T_,+ _Keys_)
1352
1353
1354 _Keys_ is an infix visit with all keys in tree _T_. Keys will be
1355sorted, but may be duplicate.
1356
1357
1358*/
1359/** @pred rb_lookup(+ _Key_,- _Value_,+ _T_)
1360
1361
1362Backtrack through all elements with key _Key_ in the red-black tree
1363 _T_, returning for each the value _Value_.
1364
1365
1366*/
1367/** @pred rb_lookupall(+ _Key_,- _Value_,+ _T_)
1368
1369
1370Lookup all elements with key _Key_ in the red-black tree
1371 _T_, returning the value _Value_.
1372
1373
1374*/
1375/** @pred rb_map(+ _T_,+ _G_,- _TN_)
1376
1377
1378For all nodes _Key_ in the tree _T_, if the value associated with
1379key _Key_ is _Val0_ in tree _T_, and if
1380`call(G,Val0,ValF)` holds, then the value associated with _Key_
1381in _TN_ is _ValF_. Fails if or if `call(G,Val0,ValF)` is not
1382satisfiable for all _Var0_.
1383
1384
1385*/
1386/** @pred rb_max(+ _T_,- _Key_,- _Value_)
1387
1388
1389 _Key_ is the maximal key in _T_, and is associated with _Val_.
1390
1391
1392*/
1393/** @pred rb_min(+ _T_,- _Key_,- _Value_)
1394
1395
1396 _Key_ is the minimum key in _T_, and is associated with _Val_.
1397
1398
1399*/
1400/** @pred rb_new(? _T_)
1401
1402
1403Create a new tree.
1404
1405
1406*/
1407/** @pred rb_next(+ _T_, + _Key_,- _Next_,- _Value_)
1408
1409
1410 _Next_ is the next element after _Key_ in _T_, and is
1411associated with _Val_.
1412
1413
1414*/
1415/** @pred rb_partial_map(+ _T_,+ _Keys_,+ _G_,- _TN_)
1416
1417
1418For all nodes _Key_ in _Keys_, if the value associated with key
1419 _Key_ is _Val0_ in tree _T_, and if `call(G,Val0,ValF)`
1420holds, then the value associated with _Key_ in _TN_ is
1421 _ValF_. Fails if or if `call(G,Val0,ValF)` is not satisfiable
1422for all _Var0_. Assumes keys are not repeated.
1423
1424
1425*/
1426/** @pred rb_previous(+ _T_, + _Key_,- _Previous_,- _Value_)
1427
1428
1429 _Previous_ is the previous element after _Key_ in _T_, and is
1430associated with _Val_.
1431
1432
1433*/
1434/** @pred rb_size(+ _T_,- _Size_)
1435
1436
1437 _Size_ is the number of elements in _T_.
1438
1439
1440*/
1441/** @pred rb_update(+ _T_,+ _Key_,+ _NewVal_,- _TN_)
1442
1443
1444Tree _TN_ is tree _T_, but with value for _Key_ associated
1445with _NewVal_. Fails if it cannot find _Key_ in _T_.
1446
1447
1448*/
1449/** @pred rb_visit(+ _T_,- _Pairs_)
1450
1451
1452 _Pairs_ is an infix visit of tree _T_, where each element of
1453 _Pairs_ is of the form _K_- _Val_.
1454
1455
1456*/
1457
1458/**
1459 @}
1460*/
1461
catch( : Goal,+ Exception,+ Action)
setarg(+ I,+ S,? T)
sort(+ L,- S)
throw(+ Ball)
format(+ T, :L)
once( 0:G)
arg(+ N,+ T, A)
functor( T, F, N)
var( T)
maplist( 2:Pred, + List1,+ List2)
rb_apply(+T, +Key, :G, -TN)
rb_clone(+ T,+ NT,+ Nodes)
rb_del_max( +T, -Key, -Val, -TN)
rb_del_min(+T, -Key, -Val, -TN)
rb_delete(+T, +Key, -TN)
rb_delete(+T, +Key, -Val, -TN)
rb_empty(?T)
rb_fold(+ T,+ G,+ Acc0, - AccF)
rb_insert(+ T0,+ Key,? Value,+ TF)
rb_key_fold(+ T,+ G,+ Acc0, - AccF)
rb_keys(+ T,+ Keys)
rb_lookup(+Key, -Value, +T)
rb_lookupall(+ Key,- Value,+ T)
rb_map(+ T,+ G,- TN)
rb_max( +T, -Key, -Value)
rb_min(+T, -Key, -Value)
rb_new(-T)
rb_next(+T, +Key, -Next,-Value)
rb_partial_map(+ T,+ Keys,+ G,- TN)
rb_previous(+T, +Key, -Previous, -Value)
rb_rewrite(+T, +Key, +NewVal)
rb_rewrite(+T, +Key, ?OldVal, +NewVal)
rb_size(+ T,- Size)
rb_update(+T, +Key, +NewVal, -TN)
rb_update(+T, +Key, ?OldVal, +NewVal, -TN)
rb_visit(+ T,- Pairs)