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:- meta_predicate apply(+,?,2,-).  332%apply(black('',_,_,''), _, _, _) :- !, fail.
  333apply(black(Left,Key0,Val0,Right), Key, Goal,
  334      black(NewLeft,Key0,Val,NewRight)) :-
  335    Left \= [],
  336    compare(Cmp,Key0,Key),
  337    (   Cmp == (=)
  338    ->  NewLeft = Left,
  339        NewRight = Right,
  340        call(Goal,Val0,Val)
  341    ;   Cmp == (>)
  342    ->  NewRight = Right,
  343        Val = Val0,
  344        apply(Left, Key, Goal, NewLeft)
  345    ;   NewLeft = Left,
  346        Val = Val0,
  347        apply(Right, Key, Goal, NewRight)
  348    ).
  349apply(red(Left,Key0,Val0,Right), Key, Goal,
  350      red(NewLeft,Key0,Val,NewRight)) :-
  351    compare(Cmp,Key0,Key),
  352    (   Cmp == (=)
  353    ->  NewLeft = Left,
  354        NewRight = Right,
  355        call(Goal,Val0,Val)
  356    ;   Cmp == (>)
  357    ->  NewRight = Right,
  358        Val = Val0,
  359        apply(Left, Key, Goal, NewLeft)
  360    ;   NewLeft = Left,
  361        Val = Val0,
  362        apply(Right, Key, Goal, NewRight)
  363    ).

 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.

  375rb_in(Key, Val, t(_,T)) =>
  376    enum(Key, Val, T).
  377
  378enum(Key, Val, black(L,K,V,R)) =>
  379    L \= '',
  380    enum_cases(Key, Val, L, K, V, R).
  381enum(Key, Val, red(L,K,V,R)) =>
  382    enum_cases(Key, Val, L, K, V, R).
  383enum(_Key, _Val, _Tree) => fail.
  384
  385enum_cases(Key, Val, L, _, _, _) :-
  386    enum(Key, Val, L).
  387enum_cases(Key, Val, _, Key, Val, _).
  388enum_cases(Key, Val, _, _, _, R) :-
  389    enum(Key, Val, R).
  390
  391
  392
  393                 /*******************************
  394                 *       TREE INSERTION         *
  395                 *******************************/
  396
  397% 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.

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

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

  592rb_delete(t(Nil,T), K, NewTree) =>
  593    NewTree = t(Nil,NT),
  594    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.

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

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

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

  832:- det(rb_visit/2).  833rb_visit(t(_,T),Lf) =>
  834    visit(T,[],Lf).
  835
  836visit(black('',_,_,_),L0,L) => L0 = L.
  837visit(red(L,K,V,R),L0,Lf) =>
  838    visit(L,[K-V|L1],Lf),
  839    visit(R,L0,L1).
  840visit(black(L,K,V,R),L0,Lf) =>
  841    visit(L,[K-V|L1],Lf),
  842    visit(R,L0,L1).
  843
  844:- 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.

  850rb_map(t(Nil,Tree),Goal,NewTree2) =>
  851    NewTree2 = t(Nil,NewTree),
  852    map(Tree,Goal,NewTree,Nil).
  853
  854
  855map(black('',_,_,''),_,Nil0,Nil) => Nil0 = Nil.
  856map(red(L,K,V,R),Goal,NewTree,Nil) =>
  857    NewTree = red(NL,K,NV,NR),
  858    call(Goal,V,NV),
  859    map(L,Goal,NL,Nil),
  860    map(R,Goal,NR,Nil).
  861map(black(L,K,V,R),Goal,NewTree,Nil) =>
  862    NewTree = black(NL,K,NV,NR),
  863    call(Goal,V,NV),
  864    map(L,Goal,NL,Nil),
  865    map(R,Goal,NR,Nil).
  866
  867:- 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).

  879rb_map(t(_,Tree),Goal) =>
  880    map(Tree,Goal).
  881
  882
  883map(black('',_,_,''),_) => true.
  884map(red(L,_,V,R),Goal) =>
  885    call(Goal,V),
  886    map(L,Goal),
  887    map(R,Goal).
  888map(black(L,_,V,R),Goal) =>
  889    call(Goal,V),
  890    map(L,Goal),
  891    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.

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

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

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

 rb_keys(+Tree, -Keys) is det

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

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

 1014:- det(list_to_rbtree/2). 1015list_to_rbtree(List, T) :-
 1016    sort(List,Sorted),
 1017    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.

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

 rb_size(+Tree, -Size) is det

Size is the number of elements in Tree.

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

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