1/*  Part of SWI-Prolog
    2
    3    Author:        Vitor Santos Costa
    4    E-mail:        vscosta@gmail.com
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2007-2021, Vitor Santos Costa
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(rbtrees,
   36          [ rb_new/1,                   % -Tree
   37            rb_empty/1,                 % ?Tree
   38            rb_lookup/3,                % +Key, -Value, +Tree
   39            rb_update/4,                % +Tree, +Key,          ?NewVal, -NewTree
   40            rb_update/5,                % +Tree, +Key, -OldVal, ?NewVal, -NewTree
   41            rb_apply/4,                 % +Tree, +Key, :G, -NewTree
   42            rb_insert/4,                % +Tree, +Key, ?Value, -NewTree
   43            rb_insert_new/4,            % +Tree, +Key, ?Value, -NewTree
   44            rb_delete/3,                % +Tree, +Key,       -NewTree
   45            rb_delete/4,                % +Tree, +Key, -Val, -NewTree
   46            rb_visit/2,                 % +Tree, -Pairs
   47            rb_keys/2,                  % +Tree, +Keys
   48            rb_map/2,                   % +Tree, :Goal
   49            rb_map/3,                   % +Tree, :Goal, -MappedTree
   50            rb_partial_map/4,           % +Tree, +Keys, :Goal, -MappedTree
   51            rb_fold/4,                  % :Goal, +Tree, +State0, -State
   52            rb_clone/3,                 % +TreeIn, -TreeOut, -Pairs
   53            rb_min/3,                   % +Tree, -Key, -Value
   54            rb_max/3,                   % +Tree, -Key, -Value
   55            rb_del_min/4,               % +Tree, -Key, -Val, -TreeDel
   56            rb_del_max/4,               % +Tree, -Key, -Val, -TreeDel
   57            rb_next/4,                  % +Tree, +Key, -Next, -Value
   58            rb_previous/4,              % +Tree, +Key, -Next, -Value
   59            list_to_rbtree/2,           % +Pairs, -Tree
   60            ord_list_to_rbtree/2,       % +Pairs, -Tree
   61            is_rbtree/1,                % @Tree
   62            rb_size/2,                  % +Tree, -Size
   63            rb_in/3                     % ?Key, ?Value, +Tree
   64          ]).   65:- autoload(library(error), [domain_error/2]).

  102% rbtrees.pl is derived from YAP's rbtrees.yap, with some minor editing.
  103% One difference is that the SWI-Prolog version  assumes that a key only
  104% appears once in the tree - the   YAP  code is somewhat inconsistent in
  105% that  (and  even  allows  rb_lookup/3  to    backtrack,  plus  it  has
  106% rb_lookupall/3, which isn't in the SWI-Prolog code).
  107
  108% The code has also been modified to   use SWI-Prolog's '=>' operator to
  109% throw an existence_error(matching_rule, _)  exception   if  Tree isn't
  110% instantiated (if ':-' is used, an  uninstanted   Tree  gets  set to an
  111% empty tree, which probably isn't the desired result).
  112
  113:- meta_predicate
  114    rb_map(+,2,-),
  115    rb_map(?,1),
  116    rb_partial_map(+,+,2,-),
  117    rb_apply(+,+,2,-),
  118    rb_fold(3,+,+,-).  119
  120/*
  121:- use_module(library(type_check)).
  122
  123:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)).
  124:- type tree(K,V)   ---> black(tree(K,V),K,V,tree(K,V))
  125                       ; red(tree(K,V),K,V,tree(K,V))
  126                       ; ''.
  127:- type cmp ---> (=) ; (<) ; (>).
  128
  129
  130:- pred rb_new(rbtree(_K,_V)).
  131:- pred rb_empty(rbtree(_K,_V)).
  132:- pred rb_lookup(K,V,rbtree(K,V)).
  133:- pred lookup(K,V, tree(K,V)).
  134:- pred lookup(cmp, K, V, tree(K,V)).
  135:- pred rb_min(rbtree(K,V),K,V).
  136:- pred min(tree(K,V),K,V).
  137:- pred rb_max(rbtree(K,V),K,V).
  138:- pred max(tree(K,V),K,V).
  139:- pred rb_next(rbtree(K,V),K,pair(K,V),V).
  140:- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)).
  141*/

 rb_new(-Tree) is det

Create a new Red-Black tree Tree.

deprecated

- Use rb_empty/1.

  149:- det(rb_new/1).  150rb_new(t(Nil,Nil)) :-
  151    Nil = black('',_,_,'').

 rb_empty(?Tree) is semidet

Succeeds if Tree is an empty Red-Black tree.

  157rb_empty(t(Nil,Nil)) :-
  158    Nil = black('',_,_,'').

 rb_lookup(+Key, -Value, +Tree) is semidet

True when Value is associated with Key in the Red-Black tree Tree. The given Key may include variables, in which case the RB tree is searched for a key with equivalent variables (using (==)/2). Time complexity is O(log N) in the number of elements in the tree.

See also

- rb_in/3 for backtracking over keys.

  169rb_lookup(Key, Val, t(_,Tree)) =>
  170    lookup(Key, Val, Tree).
  171
  172lookup(_Key, _Val, black('',_,_,'')) => fail.
  173lookup(Key, Val, Tree) =>
  174    arg(2,Tree,KA),
  175    compare(Cmp,KA,Key),
  176    lookup(Cmp,Key,Val,Tree).
  177
  178lookup(>, K, V, Tree) :-
  179    arg(1,Tree,NTree),
  180    lookup(K, V, NTree).
  181lookup(<, K, V, Tree) :-
  182    arg(4,Tree,NTree),
  183    lookup(K, V, NTree).
  184lookup(=, _, V, Tree) :-
  185    arg(3,Tree,V).

 rb_min(+Tree, -Key, -Value) is semidet

Key is the minimum key in Tree, and is associated with Val.

  191rb_min(t(_,Tree), Key, Val) =>
  192    min(Tree, Key, Val).
  193
  194min(red(black('',_,_,_),Key0,Val0,_), Key, Val) => Key0=Key, Val0=Val.
  195min(black(black('',_,_,_),Key0,Val0,_), Key, Val) => Key0=Key, Val0=Val.
  196min(red(Right,_,_,_), Key, Val) =>
  197    min(Right,Key,Val).
  198min(black(Right,_,_,_), Key, Val) =>
  199    min(Right,Key,Val).
  200min('', _Key, _Val) => fail.

 rb_max(+Tree, -Key, -Value) is semidet

Key is the maximal key in Tree, and is associated with Val.

  206rb_max(t(_,Tree), Key, Val) =>
  207    max(Tree, Key, Val).
  208
  209max(red(_,Key0,Val0,black('',_,_,_)), Key, Val) => Key0=Key, Val0=Val.
  210max(black(_,Key0,Val0,black('',_,_,_)), Key, Val) =>Key0=Key, Val0=Val.
  211max(red(_,_,_,Left), Key, Val) =>
  212    max(Left,Key,Val).
  213max(black(_,_,_,Left), Key, Val) =>
  214    max(Left,Key,Val).
  215max('', _Key, _Val) => fail.

 rb_next(+Tree, +Key, -Next, -Value) is semidet

Next is the next element after Key in Tree, and is associated with Val. Fails if Key isn't in Tree or if Key is the maximum key.

  222rb_next(t(_,Tree), Key, Next, Val) =>
  223    next(Tree, Key, Next, Val, []).
  224
  225next(black('',_,_,''), _, _, _, _) => fail.
  226next(Tree, Key, Next, Val, Candidate) =>
  227    arg(2,Tree,KA),
  228    arg(3,Tree,VA),
  229    compare(Cmp,KA,Key),
  230    next(Cmp, Key, KA, VA, Next, Val, Tree, Candidate).
  231
  232next(>, K, KA, VA, NK, V, Tree, _) :-
  233    arg(1,Tree,NTree),
  234    next(NTree,K,NK,V,KA-VA).
  235next(<, K, _, _, NK, V, Tree, Candidate) :-
  236    arg(4,Tree,NTree),
  237    next(NTree,K,NK,V,Candidate).
  238next(=, _, _, _, NK, Val, Tree, Candidate) :-
  239    arg(4,Tree,NTree),
  240    (   min(NTree, NK, Val)
  241    ->  true
  242    ;   Candidate = (NK-Val)
  243    ).

 rb_previous(+Tree, +Key, -Previous, -Value) is semidet

Previous is the previous element after Key in Tree, and is associated with Val. Fails if Key isn't in Tree or if Key is the minimum key.

  251rb_previous(t(_,Tree), Key, Previous, Val) =>
  252    previous(Tree, Key, Previous, Val, []).
  253
  254previous(black('',_,_,''), _, _, _, _) => fail.
  255previous(Tree, Key, Previous, Val, Candidate) =>
  256    arg(2,Tree,KA),
  257    arg(3,Tree,VA),
  258    compare(Cmp,KA,Key),
  259    previous(Cmp, Key, KA, VA, Previous, Val, Tree, Candidate).
  260
  261previous(>, K, _, _, NK, V, Tree, Candidate) :-
  262    arg(1,Tree,NTree),
  263    previous(NTree,K,NK,V,Candidate).
  264previous(<, K, KA, VA, NK, V, Tree, _) :-
  265    arg(4,Tree,NTree),
  266    previous(NTree,K,NK,V,KA-VA).
  267previous(=, _, _, _, K, Val, Tree, Candidate) :-
  268    arg(1,Tree,NTree),
  269    (   max(NTree, K, Val)
  270    ->  true
  271    ;   Candidate = (K-Val)
  272    ).

 rb_update(+Tree, +Key, ?NewVal, -NewTree) is semidet

Tree NewTree is tree Tree, but with value for Key associated with NewVal. Fails if Key is not in Tree (using (==)/2). This predicate may fail or give unexpected results if Key is not sufficiently instantiated.

See also

- rb_in/3 for backtracking over keys.

  283rb_update(t(Nil,OldTree), Key, OldVal, Val, NewTree2) =>
  284    NewTree2 = t(Nil,NewTree),
  285    update(OldTree, Key, OldVal, Val, NewTree).

 rb_update(+Tree, +Key, -OldVal, ?NewVal, -NewTree) is semidet

Same as rb_update(Tree, Key, NewVal, NewTree) but also unifies OldVal with the value associated with Key in Tree.

  292rb_update(t(Nil,OldTree), Key, Val, NewTree2) =>
  293    NewTree2 = t(Nil,NewTree),
  294    update(OldTree, Key, _, Val, NewTree).
  295
  296update(black(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
  297    Left \= [],
  298    compare(Cmp,Key0,Key),
  299    (   Cmp == (=)
  300    ->  OldVal = Val0,
  301        NewTree = black(Left,Key0,Val,Right)
  302    ;   Cmp == (>)
  303    ->  NewTree = black(NewLeft,Key0,Val0,Right),
  304        update(Left, Key, OldVal, Val, NewLeft)
  305    ;   NewTree = black(Left,Key0,Val0,NewRight),
  306        update(Right, Key, OldVal, Val, NewRight)
  307    ).
  308update(red(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
  309    compare(Cmp,Key0,Key),
  310    (   Cmp == (=)
  311    ->  OldVal = Val0,
  312        NewTree = red(Left,Key0,Val,Right)
  313    ;   Cmp == (>)
  314    ->  NewTree = red(NewLeft,Key0,Val0,Right),
  315        update(Left, Key, OldVal, Val, NewLeft)
  316    ;   NewTree = red(Left,Key0,Val0,NewRight),
  317        update(Right, Key, OldVal, Val, NewRight)
  318    ).

 rb_apply(+Tree, +Key, :G, -NewTree) is semidet

If the value associated with key Key is Val0 in Tree, and if call(G,Val0,ValF) holds, then NewTree differs from Tree only in that Key is associated with value ValF in tree NewTree. Fails if it cannot find Key in Tree, or if call(G,Val0,ValF) is not satisfiable.

  327rb_apply(t(Nil,OldTree), Key, Goal, NewTree2) =>
  328    NewTree2 = t(Nil,NewTree),
  329    apply(OldTree, Key, Goal, NewTree).
  330
  331%apply(black('',_,_,''), _, _, _) :- !, fail.
  332apply(black(Left,Key0,Val0,Right), Key, Goal,
  333      black(NewLeft,Key0,Val,NewRight)) :-
  334    Left \= [],
  335    compare(Cmp,Key0,Key),
  336    (   Cmp == (=)
  337    ->  NewLeft = Left,
  338        NewRight = Right,
  339        call(Goal,Val0,Val)
  340    ;   Cmp == (>)
  341    ->  NewRight = Right,
  342        Val = Val0,
  343        apply(Left, Key, Goal, NewLeft)
  344    ;   NewLeft = Left,
  345        Val = Val0,
  346        apply(Right, Key, Goal, NewRight)
  347    ).
  348apply(red(Left,Key0,Val0,Right), Key, Goal,
  349      red(NewLeft,Key0,Val,NewRight)) :-
  350    compare(Cmp,Key0,Key),
  351    (   Cmp == (=)
  352    ->  NewLeft = Left,
  353        NewRight = Right,
  354        call(Goal,Val0,Val)
  355    ;   Cmp == (>)
  356    ->  NewRight = Right,
  357        Val = Val0,
  358        apply(Left, Key, Goal, NewLeft)
  359    ;   NewLeft = Left,
  360        Val = Val0,
  361        apply(Right, Key, Goal, NewRight)
  362    ).

 rb_in(?Key, ?Value, +Tree) is nondet

True when Key-Value is a key-value pair in red-black tree Tree. Same as below, but does not materialize the pairs.

rb_visit(Tree, Pairs), member(Key-Value, Pairs)

Leaves a choicepoint even if Key is instantiated; to avoid a choicepoint, use rb_lookup/3.

  374rb_in(Key, Val, t(_,T)) =>
  375    enum(Key, Val, T).
  376
  377enum(Key, Val, black(L,K,V,R)) =>
  378    L \= '',
  379    enum_cases(Key, Val, L, K, V, R).
  380enum(Key, Val, red(L,K,V,R)) =>
  381    enum_cases(Key, Val, L, K, V, R).
  382enum(_Key, _Val, _Tree) => fail.
  383
  384enum_cases(Key, Val, L, _, _, _) :-
  385    enum(Key, Val, L).
  386enum_cases(Key, Val, _, Key, Val, _).
  387enum_cases(Key, Val, _, _, _, R) :-
  388    enum(Key, Val, R).
  389
  390
  391
  392                 /*******************************
  393                 *       TREE INSERTION         *
  394                 *******************************/
  395
  396% We don't use parent nodes, so we may have to fix the root.

 rb_insert(+Tree, +Key, ?Value, -NewTree) is det

Add an element with key Key and Value to the tree Tree creating a new red-black tree NewTree. If Key is a key in Tree, the associated value is replaced by Value. See also rb_insert_new/4. Does not validate that Key is sufficiently instantiated to ensure the tree remains valid if a key is further instantiated.

  406:- det(rb_insert/4).  407rb_insert(t(Nil,Tree0),Key,Val,NewTree) =>
  408    NewTree = t(Nil,Tree),
  409    insert(Tree0,Key,Val,Nil,Tree).
  410
  411
  412insert(Tree0,Key,Val,Nil,Tree) :-
  413    insert2(Tree0,Key,Val,Nil,TreeI,_),
  414    fix_root(TreeI,Tree).
  415
  416%
  417% Cormen et al present the algorithm as
  418% (1) standard tree insertion;
  419% (2) from the viewpoint of the newly inserted node:
  420%     partially fix the tree;
  421%     move upwards
  422% until reaching the root.
  423%
  424% We do it a little bit different:
  425%
  426% (1) standard tree insertion;
  427% (2) move upwards:
  428%      when reaching a black node;
  429%        if the tree below may be broken, fix it.
  430% We take advantage of Prolog unification
  431% to do several operations in a single go.
  432%
  433
  434
  435
  436%
  437% actual insertion
  438%
  439insert2(black('',_,_,''), K, V, Nil, T, Status) =>
  440    T = red(Nil,K,V,Nil),
  441    Status = not_done.
  442insert2(red(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  443    (   K @< K0
  444    ->  NT = red(NL,K0,V0,R),
  445        insert2(L, K, V, Nil, NL, Flag)
  446    ;   K == K0
  447    ->  NT = red(L,K0,V,R),
  448        Flag = done
  449    ;   NT = red(L,K0,V0,NR),
  450        insert2(R, K, V, Nil, NR, Flag)
  451    ).
  452insert2(black(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  453    (   K @< K0
  454    ->  insert2(L, K, V, Nil, IL, Flag0),
  455        fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
  456    ;   K == K0
  457    ->  NT = black(L,K0,V,R),
  458        Flag = done
  459    ;   insert2(R, K, V, Nil, IR, Flag0),
  460        fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
  461    ).
  462
  463% We don't use parent nodes, so we may have to fix the root.

 rb_insert_new(+Tree, +Key, ?Value, -NewTree) is semidet

Add a new element with key Key and Value to the tree Tree creating a new red-black tree NewTree. Fails if Key is a key in Tree. Does not validate that Key is sufficiently instantiated to ensure the tree remains valid if a key is further instantiated.

  472rb_insert_new(t(Nil,Tree0),Key,Val,NewTree) =>
  473    NewTree = t(Nil,Tree),
  474    insert_new(Tree0,Key,Val,Nil,Tree).
  475
  476insert_new(Tree0,Key,Val,Nil,Tree) :-
  477    insert_new_2(Tree0,Key,Val,Nil,TreeI,_),
  478    fix_root(TreeI,Tree).
  479
  480%
  481% actual insertion, copied from insert2
  482%
  483insert_new_2(black('',_,_,''), K, V, Nil, T, Status) =>
  484    T = red(Nil,K,V,Nil),
  485    Status = not_done.
  486insert_new_2(red(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  487    (   K @< K0
  488    ->  NT = red(NL,K0,V0,R),
  489        insert_new_2(L, K, V, Nil, NL, Flag)
  490    ;   K == K0
  491    ->  fail
  492    ;   NT = red(L,K0,V0,NR),
  493        insert_new_2(R, K, V, Nil, NR, Flag)
  494    ).
  495insert_new_2(black(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  496    (   K @< K0
  497    ->  insert_new_2(L, K, V, Nil, IL, Flag0),
  498        fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
  499    ;   K == K0
  500    ->  fail
  501    ;   insert_new_2(R, K, V, Nil, IR, Flag0),
  502        fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
  503    ).
  504
  505%
  506% make sure the root is always black.
  507%
  508:- det(fix_root/2).  509fix_root(black(L,K,V,R), Root) => Root = black(L,K,V,R).
  510fix_root(red(L,K,V,R), Root) => Root = black(L,K,V,R).
  511
  512%
  513% How to fix if we have inserted on the left
  514%
  515:- det(fix_left/4).  516fix_left(done,T0,T,Done) => T = T0, Done = done.
  517fix_left(not_done,Tmp,Final,Done) =>
  518    fix_left(Tmp,Final,Done).
  519
  520:- det(fix_left/3).  521%
  522% case 1 of RB: just need to change colors.
  523%
  524fix_left(black(red(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,red(De,KD,VD,Ep)),
  525        red(black(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,black(De,KD,VD,Ep)),
  526        not_done) :- !.
  527fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,red(De,KD,VD,Ep)),
  528        red(black(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,Ep)),
  529        not_done) :- !.
  530%
  531% case 2 of RB: got a knee so need to do rotations
  532%
  533fix_left(black(red(Al,KA,VA,red(Be,KB,VB,Ga)),KC,VC,De),
  534        black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
  535        done) :- !.
  536%
  537% case 3 of RB: got a line
  538%
  539fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,De),
  540        black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
  541        done) :- !.
  542%
  543% case 4 of RB: nothing to do
  544%
  545fix_left(T,T,done).
  546
  547%
  548% How to fix if we have inserted on the right
  549%
  550:- det(fix_right/4).  551fix_right(done,T0,T,Done) => T0 = T, Done = done.
  552fix_right(not_done,Tmp,Final,Done) =>
  553    fix_right(Tmp,Final,Done).
  554
  555:- det(fix_right/3).  556%
  557% case 1 of RB: just need to change colors.
  558%
  559fix_right(black(red(Ep,KD,VD,De),KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
  560          red(black(Ep,KD,VD,De),KC,VC,black(red(Ga,KB,VB,Be),KA,VA,Al)),
  561          not_done) :- !.
  562fix_right(black(red(Ep,KD,VD,De),KC,VC,red(Ga,Ka,Va,red(Be,KB,VB,Al))),
  563          red(black(Ep,KD,VD,De),KC,VC,black(Ga,Ka,Va,red(Be,KB,VB,Al))),
  564          not_done) :- !.
  565%
  566% case 2 of RB: got a knee so need to do rotations
  567%
  568fix_right(black(De,KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
  569          black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
  570          done) :- !.
  571%
  572% case 3 of RB: got a line
  573%
  574fix_right(black(De,KC,VC,red(Ga,KB,VB,red(Be,KA,VA,Al))),
  575          black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
  576          done) :- !.
  577%
  578% case 4 of RB: nothing to do.
  579%
  580fix_right(T,T,done).

 rb_delete(+Tree, +Key, -NewTree)

Delete element with key Key from the tree Tree, returning the value Val associated with the key and a new tree NewTree. Fails if Key is not in Tree (using (==)/2).

See also

- rb_in/3 for backtracking over keys.

  591rb_delete(t(Nil,T), K, NewTree) =>
  592    NewTree = t(Nil,NT),
  593    delete(T, K, _, NT, _).

 rb_delete(+Tree, +Key, -Val, -NewTree)

Same as rb_delete(Tree, Key, NewTree), but also unifies Val with the value associated with Key in Tree.

  600rb_delete(t(Nil,T), K, V, NewTree) =>
  601    NewTree = t(Nil,NT),
  602    delete(T, K, V0, NT, _),
  603    V = V0.
  604
  605%
  606% I am afraid our representation is not as nice for delete
  607%
  608delete(red(L,K0,V0,R), K, V, NT, Flag) =>
  609    delete_red(L,K0,V0,R, K, V, NT, Flag).
  610delete(black(L,K0,V0,R), K, V, NT, Flag) =>
  611    delete_black(L,K0,V0,R, K, V, NT, Flag).
  612delete('', _K, _V, _NT, _Flag) =>
  613    fail.
  614
  615delete_red(L,K0,V0,R, K, V, NT, Flag), K @< K0 =>
  616    delete(L, K, V, NL, Flag0),
  617    fixup_left(Flag0,red(NL,K0,V0,R),NT, Flag).
  618delete_red(L,K0,V0,R, K, V, NT, Flag), K @> K0 =>
  619    delete(R, K, V, NR, Flag0),
  620    fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
  621delete_red(L,_,V0,R, _, V, Out, Flag) => % K == K0,
  622    V0 = V,
  623    delete_red_node(L,R,Out,Flag).
  624
  625delete_black(L,K0,V0,R, K, V, NT, Flag), K @< K0 =>
  626    delete(L, K, V, NL, Flag0),
  627    fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
  628delete_black(L,K0,V0,R, K, V, NT, Flag), K @> K0 =>
  629    delete(R, K, V, NR, Flag0),
  630    fixup_right(Flag0,black(L,K0,V0,NR),NT, Flag).
  631delete_black(L,_,V0,R, _, V, Out, Flag) => % K == K0,
  632    V0 = V,
  633    delete_black_node(L,R,Out,Flag).

 rb_del_min(+Tree, -Key, -Val, -NewTree)

Delete the least element from the tree Tree, returning the key Key, the value Val associated with the key and a new tree NewTree. Fails if Tree is empty.

  641rb_del_min(t(Nil,T), K, Val, NewTree) =>
  642    NewTree = t(Nil,NT),
  643    del_min(T, K, Val, Nil, NT, _).
  644
  645del_min(red(black('',_,_,_),K,V,R), K, V, Nil, Out, Flag) :-
  646    !,
  647    delete_red_node(Nil,R,Out,Flag).
  648del_min(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  649    del_min(L, K, V, Nil, NL, Flag0),
  650    fixup_left(Flag0,red(NL,K0,V0,R), NT, Flag).
  651del_min(black(black('',_,_,_),K,V,R), K, V, Nil, Out, Flag) :-
  652    !,
  653    delete_black_node(Nil,R,Out,Flag).
  654del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  655    del_min(L, K, V, Nil, NL, Flag0),
  656    fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).

 rb_del_max(+Tree, -Key, -Val, -NewTree)

Delete the largest element from the tree Tree, returning the key Key, the value Val associated with the key and a new tree NewTree. Fails if Tree is empty.

  665rb_del_max(t(Nil,T), K, Val, NewTree) =>
  666    NewTree = t(Nil,NT),
  667    del_max(T, K, Val, Nil, NT, _).
  668
  669del_max(red(L,K,V,black('',_,_,_)), K, V, Nil, Out, Flag) :-
  670    !,
  671    delete_red_node(L,Nil,Out,Flag).
  672del_max(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  673    del_max(R, K, V, Nil, NR, Flag0),
  674    fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
  675del_max(black(L,K,V,black('',_,_,_)), K, V, Nil, Out, Flag) :-
  676    !,
  677    delete_black_node(L,Nil,Out,Flag).
  678del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  679    del_max(R, K, V, Nil, NR, Flag0),
  680    fixup_right(Flag0,black(L,K0,V0,NR), NT, Flag).
  681
  682delete_red_node(L1,L2,L1,done) :- L1 == L2, !.
  683delete_red_node(black('',_,_,''),R,R,done) :-  !.
  684delete_red_node(L,black('',_,_,''),L,done) :-  !.
  685delete_red_node(L,R,Out,Done) :-
  686    delete_next(R,NK,NV,NR,Done0),
  687    fixup_right(Done0,red(L,NK,NV,NR),Out,Done).
  688
  689delete_black_node(L1,L2,L1,not_done) :-         L1 == L2, !.
  690delete_black_node(black('',_,_,''),red(L,K,V,R),black(L,K,V,R),done) :- !.
  691delete_black_node(black('',_,_,''),R,R,not_done) :- !.
  692delete_black_node(red(L,K,V,R),black('',_,_,''),black(L,K,V,R),done) :- !.
  693delete_black_node(L,black('',_,_,''),L,not_done) :- !.
  694delete_black_node(L,R,Out,Done) :-
  695    delete_next(R,NK,NV,NR,Done0),
  696    fixup_right(Done0,black(L,NK,NV,NR),Out,Done).
  697
  698delete_next(red(black('',_,_,''),K,V,R),K,V,R,done) :-  !.
  699delete_next(black(black('',_,_,''),K,V,red(L1,K1,V1,R1)),
  700        K,V,black(L1,K1,V1,R1),done) :- !.
  701delete_next(black(black('',_,_,''),K,V,R),K,V,R,not_done) :- !.
  702delete_next(red(L,K,V,R),K0,V0,Out,Done) :-
  703    delete_next(L,K0,V0,NL,Done0),
  704    fixup_left(Done0,red(NL,K,V,R),Out,Done).
  705delete_next(black(L,K,V,R),K0,V0,Out,Done) :-
  706    delete_next(L,K0,V0,NL,Done0),
  707    fixup_left(Done0,black(NL,K,V,R),Out,Done).
  708
  709fixup_left(done,T,T,done).
  710fixup_left(not_done,T,NT,Done) :-
  711    fixup2(T,NT,Done).
  712
  713%
  714% case 1: x moves down, so we have to try to fix it again.
  715% case 1 -> 2,3,4 -> done
  716%
  717fixup2(black(black(Al,KA,VA,Be),KB,VB,
  718             red(black(Ga,KC,VC,De),KD,VD,
  719                 black(Ep,KE,VE,Fi))),
  720        black(T1,KD,VD,black(Ep,KE,VE,Fi)),done) :-
  721    !,
  722    fixup2(red(black(Al,KA,VA,Be),KB,VB,black(Ga,KC,VC,De)),
  723            T1,
  724            _).
  725%
  726% case 2: x moves up, change one to red
  727%
  728fixup2(red(black(Al,KA,VA,Be),KB,VB,
  729           black(black(Ga,KC,VC,De),KD,VD,
  730                 black(Ep,KE,VE,Fi))),
  731        black(black(Al,KA,VA,Be),KB,VB,
  732              red(black(Ga,KC,VC,De),KD,VD,
  733                  black(Ep,KE,VE,Fi))),done) :- !.
  734fixup2(black(black(Al,KA,VA,Be),KB,VB,
  735             black(black(Ga,KC,VC,De),KD,VD,
  736                   black(Ep,KE,VE,Fi))),
  737        black(black(Al,KA,VA,Be),KB,VB,
  738              red(black(Ga,KC,VC,De),KD,VD,
  739                  black(Ep,KE,VE,Fi))),not_done) :- !.
  740%
  741% case 3: x stays put, shift left and do a 4
  742%
  743fixup2(red(black(Al,KA,VA,Be),KB,VB,
  744           black(red(Ga,KC,VC,De),KD,VD,
  745                 black(Ep,KE,VE,Fi))),
  746        red(black(black(Al,KA,VA,Be),KB,VB,Ga),KC,VC,
  747            black(De,KD,VD,black(Ep,KE,VE,Fi))),
  748        done) :- !.
  749fixup2(black(black(Al,KA,VA,Be),KB,VB,
  750             black(red(Ga,KC,VC,De),KD,VD,
  751                   black(Ep,KE,VE,Fi))),
  752        black(black(black(Al,KA,VA,Be),KB,VB,Ga),KC,VC,
  753              black(De,KD,VD,black(Ep,KE,VE,Fi))),
  754        done) :- !.
  755%
  756% case 4: rotate left, get rid of red
  757%
  758fixup2(red(black(Al,KA,VA,Be),KB,VB,
  759           black(C,KD,VD,red(Ep,KE,VE,Fi))),
  760        red(black(black(Al,KA,VA,Be),KB,VB,C),KD,VD,
  761            black(Ep,KE,VE,Fi)),
  762        done).
  763fixup2(black(black(Al,KA,VA,Be),KB,VB,
  764             black(C,KD,VD,red(Ep,KE,VE,Fi))),
  765       black(black(black(Al,KA,VA,Be),KB,VB,C),KD,VD,
  766             black(Ep,KE,VE,Fi)),
  767       done).
  768
  769fixup_right(done,T,T,done).
  770fixup_right(not_done,T,NT,Done) :-
  771    fixup3(T,NT,Done).
  772
  773% case 1: x moves down, so we have to try to fix it again.
  774% case 1 -> 2,3,4 -> done
  775%
  776fixup3(black(red(black(Fi,KE,VE,Ep),KD,VD,
  777                 black(De,KC,VC,Ga)),KB,VB,
  778             black(Be,KA,VA,Al)),
  779        black(black(Fi,KE,VE,Ep),KD,VD,T1),done) :-
  780    !,
  781    fixup3(red(black(De,KC,VC,Ga),KB,VB,
  782               black(Be,KA,VA,Al)),T1,_).
  783
  784%
  785% case 2: x moves up, change one to red
  786%
  787fixup3(red(black(black(Fi,KE,VE,Ep),KD,VD,
  788                 black(De,KC,VC,Ga)),KB,VB,
  789           black(Be,KA,VA,Al)),
  790       black(red(black(Fi,KE,VE,Ep),KD,VD,
  791                 black(De,KC,VC,Ga)),KB,VB,
  792             black(Be,KA,VA,Al)),
  793       done) :- !.
  794fixup3(black(black(black(Fi,KE,VE,Ep),KD,VD,
  795                   black(De,KC,VC,Ga)),KB,VB,
  796             black(Be,KA,VA,Al)),
  797       black(red(black(Fi,KE,VE,Ep),KD,VD,
  798                 black(De,KC,VC,Ga)),KB,VB,
  799             black(Be,KA,VA,Al)),
  800       not_done):- !.
  801%
  802% case 3: x stays put, shift left and do a 4
  803%
  804fixup3(red(black(black(Fi,KE,VE,Ep),KD,VD,
  805                 red(De,KC,VC,Ga)),KB,VB,
  806           black(Be,KA,VA,Al)),
  807       red(black(black(Fi,KE,VE,Ep),KD,VD,De),KC,VC,
  808           black(Ga,KB,VB,black(Be,KA,VA,Al))),
  809       done) :- !.
  810fixup3(black(black(black(Fi,KE,VE,Ep),KD,VD,
  811                   red(De,KC,VC,Ga)),KB,VB,
  812             black(Be,KA,VA,Al)),
  813       black(black(black(Fi,KE,VE,Ep),KD,VD,De),KC,VC,
  814             black(Ga,KB,VB,black(Be,KA,VA,Al))),
  815       done) :- !.
  816%
  817% case 4: rotate right, get rid of red
  818%
  819fixup3(red(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
  820       red(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
  821       done).
  822fixup3(black(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
  823       black(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
  824       done).

 rb_visit(+Tree, -Pairs) is det

Pairs is an infix visit of tree Tree, where each element of Pairs is of the form Key-Value.

  831:- det(rb_visit/2).  832rb_visit(t(_,T),Lf) =>
  833    visit(T,[],Lf).
  834
  835visit(black('',_,_,_),L0,L) => L0 = L.
  836visit(red(L,K,V,R),L0,Lf) =>
  837    visit(L,[K-V|L1],Lf),
  838    visit(R,L0,L1).
  839visit(black(L,K,V,R),L0,Lf) =>
  840    visit(L,[K-V|L1],Lf),
  841    visit(R,L0,L1).
  842
  843:- meta_predicate map(?,2,?,?).  % this is required.

 rb_map(+T, :Goal) is semidet

True if call(Goal, Value) is true for all nodes in T.

  849rb_map(t(Nil,Tree),Goal,NewTree2) =>
  850    NewTree2 = t(Nil,NewTree),
  851    map(Tree,Goal,NewTree,Nil).
  852
  853
  854map(black('',_,_,''),_,Nil0,Nil) => Nil0 = Nil.
  855map(red(L,K,V,R),Goal,NewTree,Nil) =>
  856    NewTree = red(NL,K,NV,NR),
  857    call(Goal,V,NV),
  858    map(L,Goal,NL,Nil),
  859    map(R,Goal,NR,Nil).
  860map(black(L,K,V,R),Goal,NewTree,Nil) =>
  861    NewTree = black(NL,K,NV,NR),
  862    call(Goal,V,NV),
  863    map(L,Goal,NL,Nil),
  864    map(R,Goal,NR,Nil).
  865
  866:- meta_predicate map(?,1).  % this is required.

 rb_map(+Tree, :G, -NewTree) is semidet

For all nodes Key in the tree Tree, if the value associated with key Key is Val0 in tree Tree, and if call(G,Val0,ValF) holds, then the value associated with Key in NewTree is ValF. Fails if call(G,Val0,ValF) is not satisfiable for all Val0. If G is non-deterministic, rb_map/3 will backtrack over all possible values from call(G,Val0,ValF). You should not depend on the order of tree traversal (currently: key order).

  878rb_map(t(_,Tree),Goal) =>
  879    map(Tree,Goal).
  880
  881
  882map(black('',_,_,''),_) => true.
  883map(red(L,_,V,R),Goal) =>
  884    call(Goal,V),
  885    map(L,Goal),
  886    map(R,Goal).
  887map(black(L,_,V,R),Goal) =>
  888    call(Goal,V),
  889    map(L,Goal),
  890    map(R,Goal).

 rb_fold(:Goal, +Tree, +State0, -State)

Fold the given predicate over all the key-value pairs in Tree, starting with initial state State0 and returning the final state State. Pred is called as

call(Pred, Key-Value, State1, State2)

Determinism depends on Goal.

  902rb_fold(Pred, t(_,T), S1, S2) =>
  903    fold(T, Pred, S1, S2).
  904
  905fold(black(L,K,V,R), Pred) -->
  906    (   {L == ''}
  907    ->  []
  908    ;   fold_parts(Pred, L, K-V, R)
  909    ).
  910fold(red(L,K,V,R), Pred) -->
  911    fold_parts(Pred, L, K-V, R).
  912
  913fold_parts(Pred, L, KV, R) -->
  914    fold(L, Pred),
  915    call(Pred, KV),
  916    fold(R, Pred).

 rb_clone(+TreeIn, -TreeOut, -Pairs) is det

`Clone' the red-back tree TreeIn into a new tree TreeOut with the same keys as the original but with all values set to unbound values. Pairs is a list containing all new nodes as pairs K-V.

  924:- det(rb_clone/3).  925rb_clone(t(Nil,T),TreeOut,Ns) =>
  926    TreeOut = t(Nil,NT),
  927    clone(T,Nil,NT,Ns,[]).
  928
  929clone(black('',_,_,''),Nil0,Nil,Ns0,Ns) => Nil0=Nil, Ns0=Ns.
  930clone(red(L,K,_,R),Nil,TreeOut,NsF,Ns0) =>
  931    TreeOut = red(NL,K,NV,NR),
  932    clone(L,Nil,NL,NsF,[K-NV|Ns1]),
  933    clone(R,Nil,NR,Ns1,Ns0).
  934clone(black(L,K,_,R),Nil,TreeOut,NsF,Ns0) =>
  935    TreeOut = black(NL,K,NV,NR),
  936    clone(L,Nil,NL,NsF,[K-NV|Ns1]),
  937    clone(R,Nil,NR,Ns1,Ns0).

 rb_partial_map(+Tree, +Keys, :G, -NewTree)

For all nodes Key in Keys, if the value associated with key Key is Val0 in tree Tree, and if call(G,Val0,ValF) holds, then the value associated with Key in NewTree is ValF, otherwise it is the value associated with the key in Tree. Fails if Key isn't in Tree or if call(G,Val0,ValF) is not satisfiable for all Val0 in Keys. Assumes keys are sorted and not repeated (fails if this is not true).

  948rb_partial_map(t(Nil,T0), Map, Goal, NewTree) =>
  949    NewTree = t(Nil,TF),
  950    partial_map(T0, Map, [], Nil, Goal, TF).
  951
  952partial_map(T,[],[],_,_,T) :- !.
  953partial_map(black('',_,_,_),Map,Map,Nil,_,Nil) :- !.
  954partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :-
  955    partial_map(L,Map,MapI,Nil,Goal,NL),
  956    (   MapI == []
  957    ->  NR = R, NV = V, MapF = []
  958    ;   MapI = [K1|MapR],
  959        (   K == K1
  960        ->  (   call(Goal,V,NV)
  961            ->  true
  962            ;   NV = V
  963            ),
  964            MapN = MapR
  965        ;   NV = V,
  966            MapN = MapI
  967        ),
  968        partial_map(R,MapN,MapF,Nil,Goal,NR)
  969    ).
  970partial_map(black(L,K,V,R),Map,MapF,Nil,Goal,black(NL,K,NV,NR)) :-
  971    partial_map(L,Map,MapI,Nil,Goal,NL),
  972    (   MapI == []
  973    ->  NR = R, NV = V, MapF = []
  974    ;   MapI = [K1|MapR],
  975        (   K == K1
  976        ->  (   call(Goal,V,NV)
  977            ->  true
  978            ;   NV = V
  979            ),
  980            MapN = MapR
  981        ;   NV = V,
  982            MapN = MapI
  983        ),
  984        partial_map(R,MapN,MapF,Nil,Goal,NR)
  985    ).

 rb_keys(+Tree, -Keys) is det

Keys is unified with an ordered list of all keys in the Red-Black tree Tree.

  993:- det(rb_keys/2).  994rb_keys(t(_,T),Lf) =>
  995    keys(T,[],Lf).
  996
  997keys(black('',_,_,''),L0,L) => L0 = L.
  998keys(red(L,K,_,R),L0,Lf) =>
  999    keys(L,[K|L1],Lf),
 1000    keys(R,L0,L1).
 1001keys(black(L,K,_,R),L0,Lf) =>
 1002    keys(L,[K|L1],Lf),
 1003    keys(R,L0,L1).

 list_to_rbtree(+List, -Tree) is det

Tree is the red-black tree corresponding to the mapping in List, which should be a list of Key-Value pairs. List should not contain more than one entry for each distinct key, but this is not validated by list_to_rbtree/2.

 1013:- det(list_to_rbtree/2). 1014list_to_rbtree(List, T) :-
 1015    sort(List,Sorted),
 1016    ord_list_to_rbtree(Sorted, T).

 ord_list_to_rbtree(+List, -Tree) is det

Tree is the red-black tree corresponding to the mapping in list List, which should be a list of Key-Value pairs. List should not contain more than one entry for each distinct key, but this is not validated by ord_list_to_rbtree/2. List is assumed to be sorted according to the standard order of terms.

 1026:- det(ord_list_to_rbtree/2). 1027ord_list_to_rbtree([], Tree) =>
 1028    Tree = t(Nil,Nil),
 1029    Nil = black('', _, _, '').
 1030ord_list_to_rbtree([K-V], Tree) =>
 1031    Tree = t(Nil,black(Nil,K,V,Nil)),
 1032    Nil = black('', _, _, '').
 1033ord_list_to_rbtree(List, Tree2) =>
 1034    Tree2 = t(Nil,Tree),
 1035    Nil = black('', _, _, ''),
 1036    Ar =.. [seq|List],
 1037    functor(Ar,_,L),
 1038    Height is truncate(log(L)/log(2)),
 1039    construct_rbtree(1, L, Ar, Height, Nil, Tree).
 1040
 1041construct_rbtree(L, M, _, _, Nil, Nil) :- M < L, !.
 1042construct_rbtree(L, L, Ar, Depth, Nil, Node) :-
 1043    !,
 1044    arg(L, Ar, K-Val),
 1045    build_node(Depth, Nil, K, Val, Nil, Node).
 1046construct_rbtree(I0, Max, Ar, Depth, Nil, Node) :-
 1047    I is (I0+Max)//2,
 1048    arg(I, Ar, K-Val),
 1049    build_node(Depth, Left, K, Val, Right, Node),
 1050    I1 is I-1,
 1051    NewDepth is Depth-1,
 1052    construct_rbtree(I0, I1, Ar, NewDepth, Nil, Left),
 1053    I2 is I+1,
 1054    construct_rbtree(I2, Max, Ar, NewDepth, Nil, Right).
 1055
 1056build_node( 0, Left, K, Val, Right, red(Left, K, Val, Right)) :- !.
 1057build_node( _, Left, K, Val, Right, black(Left, K, Val, Right)).

 rb_size(+Tree, -Size) is det

Size is the number of elements in Tree.

 1064:- det(rb_size/2). 1065rb_size(t(_,T),Size) =>
 1066    size(T,0,Size).
 1067
 1068size(black('',_,_,_),Sz,Sz) :- !.
 1069size(red(L,_,_,R),Sz0,Szf) :-
 1070    Sz1 is Sz0+1,
 1071    size(L,Sz1,Sz2),
 1072    size(R,Sz2,Szf).
 1073size(black(L,_,_,R),Sz0,Szf) :-
 1074    Sz1 is Sz0+1,
 1075    size(L,Sz1,Sz2),
 1076    size(R,Sz2,Szf).

 is_rbtree(@Term) is semidet

True if Term is a valid Red-Black tree. Processes the entire tree, checking the coloring of the nodes, the balance and the ordering of keys. Does not validate that keys are sufficiently instantiated to ensure the tree remains valid if a key is further instantiated.

 1085is_rbtree(X), var(X) =>
 1086    fail.
 1087is_rbtree(t(Nil,Nil)) => true.
 1088is_rbtree(t(_,T)) =>
 1089    Err = error(_,_),
 1090    catch(check_rbtree(T), Err, is_rbtree_error(Err)).
 1091is_rbtree(_) =>
 1092    fail.
 1093
 1094is_rbtree_error(Err), Err = error(resource_error(_),_) => throw(Err).
 1095is_rbtree_error(_) => fail.
 1096
 1097% This code checks if a tree is ordered and a rbtree
 1098
 1099check_rbtree(black(L,K,_,R)) =>
 1100    find_path_blacks(L, 0, Bls),
 1101    check_rbtree(L,-inf,K,Bls),
 1102    check_rbtree(R,K,+inf,Bls).
 1103check_rbtree(Node), Node = red(_,_,_,_) =>
 1104    domain_error(rb_black, Node).
 1105
 1106
 1107find_path_blacks(black('',_,_,''), Bls0, Bls) => Bls = Bls0.
 1108find_path_blacks(black(L,_,_,_), Bls0, Bls) =>
 1109    Bls1 is Bls0+1,
 1110    find_path_blacks(L, Bls1, Bls).
 1111find_path_blacks(red(L,_,_,_), Bls0, Bls) =>
 1112    find_path_blacks(L, Bls0, Bls).
 1113
 1114check_rbtree(black('',_,_,''),Min,Max,Bls0) =>
 1115    check_height(Bls0,Min,Max).
 1116check_rbtree(red(L,K,_,R),Min,Max,Bls) =>
 1117    check_val(K,Min,Max),
 1118    check_red_child(L),
 1119    check_red_child(R),
 1120    check_rbtree(L,Min,K,Bls),
 1121    check_rbtree(R,K,Max,Bls).
 1122check_rbtree(black(L,K,_,R),Min,Max,Bls0) =>
 1123    check_val(K,Min,Max),
 1124    Bls is Bls0-1,
 1125    check_rbtree(L,Min,K,Bls),
 1126    check_rbtree(R,K,Max,Bls).
 1127
 1128check_height(0,_,_) => true.
 1129check_height(Bls0,Min,Max) =>
 1130    throw(error(rbtree(balance(Bls0, Min, Max)), _)).
 1131
 1132check_val(K, Min, Max), (K @> Min ; Min == -inf), (K @< Max ; Max == +inf) =>
 1133    true.
 1134check_val(K, Min, Max) =>
 1135    throw(error(rbtree(order(K, Min, Max)), _)).
 1136
 1137check_red_child(black(_,_,_,_)) => true.
 1138check_red_child(Node), Node = red(_,_,_,_) =>
 1139    domain_error(rb_black, Node).
 1140
 1141
 1142		 /*******************************
 1143		 *            MESSAGES		*
 1144		 *******************************/
 1145
 1146:- multifile
 1147    prolog:error_message//1. 1148
 1149prolog:error_message(rbtree(balance(Bls0, Min, Max))) -->
 1150    [ 'Unbalance ~d between ~w and ~w'-[Bls0,Min,Max] ].
 1151prolog:error_message(rbtree(order(K, Min, Max))) -->
 1152    [ 'not ordered: ~w not between ~w and ~w'-[K,Min,Max] ]