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_visit_range/4,           % +Tree, +Min, +Max, -Pairs
   48            rb_keys/2,                  % +Tree, +Keys
   49            rb_map/2,                   % +Tree, :Goal
   50            rb_map/3,                   % +Tree, :Goal, -MappedTree
   51            rb_partial_map/4,           % +Tree, +Keys, :Goal, -MappedTree
   52            rb_fold/4,                  % :Goal, +Tree, +State0, -State
   53            rb_clone/3,                 % +TreeIn, -TreeOut, -Pairs
   54            rb_min/3,                   % +Tree, -Key, -Value
   55            rb_max/3,                   % +Tree, -Key, -Value
   56            rb_del_min/4,               % +Tree, -Key, -Val, -TreeDel
   57            rb_del_max/4,               % +Tree, -Key, -Val, -TreeDel
   58            rb_next/4,                  % +Tree, +Key, -Next, -Value
   59            rb_previous/4,              % +Tree, +Key, -Next, -Value
   60            list_to_rbtree/2,           % +Pairs, -Tree
   61            ord_list_to_rbtree/2,       % +Pairs, -Tree
   62            is_rbtree/1,                % @Tree
   63            rb_size/2,                  % +Tree, -Size
   64            rb_in/3                     % ?Key, ?Value, +Tree
   65          ]).   66:- autoload(library(error), [domain_error/2]).

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

 rb_new(-Tree) is det

Create a new Red-Black tree Tree.

deprecated

- Use rb_empty/1.

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

 rb_empty(?Tree) is semidet

Succeeds if Tree is an empty Red-Black tree.

  158rb_empty(t(Nil,Nil)) :-
  159    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.

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

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

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

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

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

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

  207rb_max(t(_,Tree), Key, Val) =>
  208    max(Tree, Key, Val).
  209
  210max(red(_,Key0,Val0,black('',_,_,_)), Key, Val) => Key0=Key, Val0=Val.
  211max(black(_,Key0,Val0,black('',_,_,_)), Key, Val) =>Key0=Key, Val0=Val.
  212max(red(_,_,_,Left), Key, Val) =>
  213    max(Left,Key,Val).
  214max(black(_,_,_,Left), Key, Val) =>
  215    max(Left,Key,Val).
  216max('', _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.

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

 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.

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

 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.

  284rb_update(t(Nil,OldTree), Key, OldVal, Val, NewTree2) =>
  285    NewTree2 = t(Nil,NewTree),
  286    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.

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

 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.

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

 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.

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

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

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

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

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

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

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

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

 rb_visit_range(+Tree, +Min, +Max, -Pairs) is det

Retrieves a range of pairs with keys between Min and Max (inclusive) from a Tree using standard term comparison.

  850:- det(rb_visit_range/4).  851rb_visit_range(t(_,T), Min, Max, Pairs) =>
  852   visit_range(T, Min, Max, [], Pairs).
  853
  854visit_range(black('',_,_,_), _Min, _Max, L0, Lf) => 
  855   L0 = Lf.
  856visit_range(red(L,K,V,R), Min, Max, L0, Lf) =>
  857   (   K @< Min
  858   ->  visit_range(R, Min, Max, L0, Lf)
  859   ;   K @> Max
  860   ->  visit_range(L, Min, Max, L0, Lf)
  861   ;   visit_range(L, Min, Max, [K-V|L1], Lf),
  862       visit_range(R, Min, Max, L0, L1)
  863   ).
  864visit_range(black(L,K,V,R), Min, Max, L0, Lf) =>
  865   (   K @< Min
  866   ->  visit_range(R, Min, Max, L0, Lf)
  867   ;   K @> Max
  868   ->  visit_range(L, Min, Max, L0, Lf)
  869   ;   visit_range(L, Min, Max, [K-V|L1], Lf),
  870       visit_range(R, Min, Max, L0, L1)
  871   ).
  872
  873:- meta_predicate map(?,2,?,?).  % 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).

  885rb_map(t(Nil,Tree),Goal,NewTree2) =>
  886    NewTree2 = t(Nil,NewTree),
  887    map(Tree,Goal,NewTree,Nil).
  888
  889
  890map(black('',_,_,''),_,Nil0,Nil) => Nil0 = Nil.
  891map(red(L,K,V,R),Goal,NewTree,Nil) =>
  892    NewTree = red(NL,K,NV,NR),
  893    call(Goal,V,NV),
  894    map(L,Goal,NL,Nil),
  895    map(R,Goal,NR,Nil).
  896map(black(L,K,V,R),Goal,NewTree,Nil) =>
  897    NewTree = black(NL,K,NV,NR),
  898    call(Goal,V,NV),
  899    map(L,Goal,NL,Nil),
  900    map(R,Goal,NR,Nil).
  901
  902:- meta_predicate map(?,1).  % this is required.

 rb_map(+T, :Goal) is semidet

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

  908rb_map(t(_,Tree),Goal) =>
  909    map(Tree,Goal).
  910
  911
  912map(black('',_,_,''),_) => true.
  913map(red(L,_,V,R),Goal) =>
  914    call(Goal,V),
  915    map(L,Goal),
  916    map(R,Goal).
  917map(black(L,_,V,R),Goal) =>
  918    call(Goal,V),
  919    map(L,Goal),
  920    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.

  932rb_fold(Pred, t(_,T), S1, S2) =>
  933    fold(T, Pred, S1, S2).
  934
  935fold(black(L,K,V,R), Pred) -->
  936    (   {L == ''}
  937    ->  []
  938    ;   fold_parts(Pred, L, K-V, R)
  939    ).
  940fold(red(L,K,V,R), Pred) -->
  941    fold_parts(Pred, L, K-V, R).
  942
  943fold_parts(Pred, L, KV, R) -->
  944    fold(L, Pred),
  945    call(Pred, KV),
  946    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.

  954:- det(rb_clone/3).  955rb_clone(t(Nil,T),TreeOut,Ns) =>
  956    TreeOut = t(Nil,NT),
  957    clone(T,Nil,NT,Ns,[]).
  958
  959clone(black('',_,_,''),Nil0,Nil,Ns0,Ns) => Nil0=Nil, Ns0=Ns.
  960clone(red(L,K,_,R),Nil,TreeOut,NsF,Ns0) =>
  961    TreeOut = red(NL,K,NV,NR),
  962    clone(L,Nil,NL,NsF,[K-NV|Ns1]),
  963    clone(R,Nil,NR,Ns1,Ns0).
  964clone(black(L,K,_,R),Nil,TreeOut,NsF,Ns0) =>
  965    TreeOut = black(NL,K,NV,NR),
  966    clone(L,Nil,NL,NsF,[K-NV|Ns1]),
  967    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).

  978rb_partial_map(t(Nil,T0), Map, Goal, NewTree) =>
  979    NewTree = t(Nil,TF),
  980    partial_map(T0, Map, [], Nil, Goal, TF).
  981
  982partial_map(T,[],[],_,_,T) :- !.
  983partial_map(black('',_,_,_),Map,Map,Nil,_,Nil) :- !.
  984partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :-
  985    partial_map(L,Map,MapI,Nil,Goal,NL),
  986    (   MapI == []
  987    ->  NR = R, NV = V, MapF = []
  988    ;   MapI = [K1|MapR],
  989        (   K == K1
  990        ->  (   call(Goal,V,NV)
  991            ->  true
  992            ;   NV = V
  993            ),
  994            MapN = MapR
  995        ;   NV = V,
  996            MapN = MapI
  997        ),
  998        partial_map(R,MapN,MapF,Nil,Goal,NR)
  999    ).
 1000partial_map(black(L,K,V,R),Map,MapF,Nil,Goal,black(NL,K,NV,NR)) :-
 1001    partial_map(L,Map,MapI,Nil,Goal,NL),
 1002    (   MapI == []
 1003    ->  NR = R, NV = V, MapF = []
 1004    ;   MapI = [K1|MapR],
 1005        (   K == K1
 1006        ->  (   call(Goal,V,NV)
 1007            ->  true
 1008            ;   NV = V
 1009            ),
 1010            MapN = MapR
 1011        ;   NV = V,
 1012            MapN = MapI
 1013        ),
 1014        partial_map(R,MapN,MapF,Nil,Goal,NR)
 1015    ).

 rb_keys(+Tree, -Keys) is det

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

 1023:- det(rb_keys/2). 1024rb_keys(t(_,T),Lf) =>
 1025    keys(T,[],Lf).
 1026
 1027keys(black('',_,_,''),L0,L) => L0 = L.
 1028keys(red(L,K,_,R),L0,Lf) =>
 1029    keys(L,[K|L1],Lf),
 1030    keys(R,L0,L1).
 1031keys(black(L,K,_,R),L0,Lf) =>
 1032    keys(L,[K|L1],Lf),
 1033    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.

 1043:- det(list_to_rbtree/2). 1044list_to_rbtree(List, T) :-
 1045    sort(List,Sorted),
 1046    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.

 1056:- det(ord_list_to_rbtree/2). 1057ord_list_to_rbtree([], Tree) =>
 1058    Tree = t(Nil,Nil),
 1059    Nil = black('', _, _, '').
 1060ord_list_to_rbtree([K-V], Tree) =>
 1061    Tree = t(Nil,black(Nil,K,V,Nil)),
 1062    Nil = black('', _, _, '').
 1063ord_list_to_rbtree(List, Tree2) =>
 1064    Tree2 = 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, !.
 1072construct_rbtree(L, L, Ar, Depth, Nil, Node) :-
 1073    !,
 1074    arg(L, Ar, K-Val),
 1075    build_node(Depth, Nil, K, Val, Nil, Node).
 1076construct_rbtree(I0, Max, Ar, Depth, Nil, Node) :-
 1077    I is (I0+Max)//2,
 1078    arg(I, Ar, K-Val),
 1079    build_node(Depth, Left, K, Val, Right, Node),
 1080    I1 is I-1,
 1081    NewDepth is Depth-1,
 1082    construct_rbtree(I0, I1, Ar, NewDepth, Nil, Left),
 1083    I2 is I+1,
 1084    construct_rbtree(I2, Max, Ar, NewDepth, Nil, Right).
 1085
 1086build_node( 0, Left, K, Val, Right, red(Left, K, Val, Right)) :- !.
 1087build_node( _, Left, K, Val, Right, black(Left, K, Val, Right)).

 rb_size(+Tree, -Size) is det

Size is the number of elements in Tree.

 1094:- det(rb_size/2). 1095rb_size(t(_,T),Size) =>
 1096    size(T,0,Size).
 1097
 1098size(black('',_,_,_),Sz,Sz) :- !.
 1099size(red(L,_,_,R),Sz0,Szf) :-
 1100    Sz1 is Sz0+1,
 1101    size(L,Sz1,Sz2),
 1102    size(R,Sz2,Szf).
 1103size(black(L,_,_,R),Sz0,Szf) :-
 1104    Sz1 is Sz0+1,
 1105    size(L,Sz1,Sz2),
 1106    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.

 1115is_rbtree(X), var(X) =>
 1116    fail.
 1117is_rbtree(t(Nil,Nil)) => true.
 1118is_rbtree(t(_,T)) =>
 1119    Err = error(_,_),
 1120    catch(check_rbtree(T), Err, is_rbtree_error(Err)).
 1121is_rbtree(_) =>
 1122    fail.
 1123
 1124is_rbtree_error(Err), Err = error(resource_error(_),_) => throw(Err).
 1125is_rbtree_error(_) => fail.
 1126
 1127% This code checks if a tree is ordered and a rbtree
 1128
 1129check_rbtree(black(L,K,_,R)) =>
 1130    find_path_blacks(L, 0, Bls),
 1131    check_rbtree(L,-inf,K,Bls),
 1132    check_rbtree(R,K,+inf,Bls).
 1133check_rbtree(Node), Node = red(_,_,_,_) =>
 1134    domain_error(rb_black, Node).
 1135
 1136
 1137find_path_blacks(black('',_,_,''), Bls0, Bls) => Bls = Bls0.
 1138find_path_blacks(black(L,_,_,_), Bls0, Bls) =>
 1139    Bls1 is Bls0+1,
 1140    find_path_blacks(L, Bls1, Bls).
 1141find_path_blacks(red(L,_,_,_), Bls0, Bls) =>
 1142    find_path_blacks(L, Bls0, Bls).
 1143
 1144check_rbtree(black('',_,_,''),Min,Max,Bls0) =>
 1145    check_height(Bls0,Min,Max).
 1146check_rbtree(red(L,K,_,R),Min,Max,Bls) =>
 1147    check_val(K,Min,Max),
 1148    check_red_child(L),
 1149    check_red_child(R),
 1150    check_rbtree(L,Min,K,Bls),
 1151    check_rbtree(R,K,Max,Bls).
 1152check_rbtree(black(L,K,_,R),Min,Max,Bls0) =>
 1153    check_val(K,Min,Max),
 1154    Bls is Bls0-1,
 1155    check_rbtree(L,Min,K,Bls),
 1156    check_rbtree(R,K,Max,Bls).
 1157
 1158check_height(0,_,_) => true.
 1159check_height(Bls0,Min,Max) =>
 1160    throw(error(rbtree(balance(Bls0, Min, Max)), _)).
 1161
 1162check_val(K, Min, Max), (K @> Min ; Min == -inf), (K @< Max ; Max == +inf) =>
 1163    true.
 1164check_val(K, Min, Max) =>
 1165    throw(error(rbtree(order(K, Min, Max)), _)).
 1166
 1167check_red_child(black(_,_,_,_)) => true.
 1168check_red_child(Node), Node = red(_,_,_,_) =>
 1169    domain_error(rb_black, Node).
 1170
 1171
 1172		 /*******************************
 1173		 *            MESSAGES		*
 1174		 *******************************/
 1175
 1176:- multifile
 1177    prolog:error_message//1. 1178
 1179prolog:error_message(rbtree(balance(Bls0, Min, Max))) -->
 1180    [ 'Unbalance ~d between ~w and ~w'-[Bls0,Min,Max] ].
 1181prolog:error_message(rbtree(order(K, Min, Max))) -->
 1182    [ 'not ordered: ~w not between ~w and ~w'-[K,Min,Max] ]