View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        R.A.O'Keefe, L.Damas, V.S.Costa, Glenn Burgess,
    4                   Jiri Spitz and Jan Wielemaker
    5    E-mail:        J.Wielemaker@vu.nl
    6    WWW:           http://www.swi-prolog.org
    7    Copyright (c)  2004-2018, various people and institutions
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(assoc,
   37          [ empty_assoc/1,              % -Assoc
   38            is_assoc/1,                 % +Assoc
   39            assoc_to_list/2,            % +Assoc, -Pairs
   40            assoc_to_keys/2,            % +Assoc, -List
   41            assoc_to_values/2,          % +Assoc, -List
   42            gen_assoc/3,                % ?Key, +Assoc, ?Value
   43            get_assoc/3,                % +Key, +Assoc, ?Value
   44            get_assoc/5,                % +Key, +Assoc0, ?Val0, ?Assoc, ?Val
   45            list_to_assoc/2,            % +List, ?Assoc
   46            map_assoc/2,                % :Goal, +Assoc
   47            map_assoc/3,                % :Goal, +Assoc0, ?Assoc
   48            max_assoc/3,                % +Assoc, ?Key, ?Value
   49            min_assoc/3,                % +Assoc, ?Key, ?Value
   50            ord_list_to_assoc/2,        % +List, ?Assoc
   51            put_assoc/4,                % +Key, +Assoc0, +Value, ?Assoc
   52            del_assoc/4,                % +Key, +Assoc0, ?Value, ?Assoc
   53            del_min_assoc/4,            % +Assoc0, ?Key, ?Value, ?Assoc
   54            del_max_assoc/4             % +Assoc0, ?Key, ?Value, ?Assoc
   55          ]).   56:- autoload(library(error),[must_be/2,domain_error/2]).

Binary associations

Assocs are Key-Value associations implemented as a balanced binary tree (AVL tree).

author
- R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker */
See also
- library(pairs), library(rbtrees)
   68:- meta_predicate
   69    map_assoc(1, ?),
   70    map_assoc(2, ?, ?).
 empty_assoc(?Assoc) is semidet
Is true if Assoc is the empty association list.
   76empty_assoc(t).
 assoc_to_list(+Assoc, -Pairs) is det
Translate Assoc to a list Pairs of Key-Value pairs. The keys in Pairs are sorted in ascending order.
   83assoc_to_list(Assoc, List) :-
   84    assoc_to_list(Assoc, List, []).
   85
   86assoc_to_list(t(Key,Val,_,L,R), List, Rest) :-
   87    assoc_to_list(L, List, [Key-Val|More]),
   88    assoc_to_list(R, More, Rest).
   89assoc_to_list(t, List, List).
 assoc_to_keys(+Assoc, -Keys) is det
True if Keys is the list of keys in Assoc. The keys are sorted in ascending order.
   97assoc_to_keys(Assoc, List) :-
   98    assoc_to_keys(Assoc, List, []).
   99
  100assoc_to_keys(t(Key,_,_,L,R), List, Rest) :-
  101    assoc_to_keys(L, List, [Key|More]),
  102    assoc_to_keys(R, More, Rest).
  103assoc_to_keys(t, List, List).
 assoc_to_values(+Assoc, -Values) is det
True if Values is the list of values in Assoc. Values are ordered in ascending order of the key to which they were associated. Values may contain duplicates.
  112assoc_to_values(Assoc, List) :-
  113    assoc_to_values(Assoc, List, []).
  114
  115assoc_to_values(t(_,Value,_,L,R), List, Rest) :-
  116    assoc_to_values(L, List, [Value|More]),
  117    assoc_to_values(R, More, Rest).
  118assoc_to_values(t, List, List).
 is_assoc(+Assoc) is semidet
True if Assoc is an association list. This predicate checks that the structure is valid, elements are in order, and tree is balanced to the extent guaranteed by AVL trees. I.e., branches of each subtree differ in depth by at most 1.
  127is_assoc(Assoc) :-
  128    is_assoc(Assoc, _Min, _Max, _Depth).
  129
  130is_assoc(t,X,X,0) :- !.
  131is_assoc(t(K,_,-,t,t),K,K,1) :- !, ground(K).
  132is_assoc(t(K,_,>,t,t(RK,_,-,t,t)),K,RK,2) :-
  133    % Ensure right side Key is 'greater' than K
  134    !, ground((K,RK)), K @< RK.
  135
  136is_assoc(t(K,_,<,t(LK,_,-,t,t),t),LK,K,2) :-
  137    % Ensure left side Key is 'less' than K
  138    !, ground((LK,K)), LK @< K.
  139
  140is_assoc(t(K,_,B,L,R),Min,Max,Depth) :-
  141    is_assoc(L,Min,LMax,LDepth),
  142    is_assoc(R,RMin,Max,RDepth),
  143    % Ensure Balance matches depth
  144    compare(Rel,RDepth,LDepth),
  145    balance(Rel,B),
  146    % Ensure ordering
  147    ground((LMax,K,RMin)),
  148    LMax @< K,
  149    K @< RMin,
  150    Depth is max(LDepth, RDepth)+1.
  151
  152% Private lookup table matching comparison operators to Balance operators used in tree
  153balance(=,-).
  154balance(<,<).
  155balance(>,>).
 gen_assoc(?Key, +Assoc, ?Value) is nondet
True if Key-Value is an association in Assoc. Enumerates keys in ascending order on backtracking.
See also
- get_assoc/3.
  165gen_assoc(Key, Assoc, Value) :-
  166    (   ground(Key)
  167    ->  get_assoc(Key, Assoc, Value)
  168    ;   gen_assoc_(Key, Assoc, Value)
  169    ).
  170
  171gen_assoc_(Key, t(_,_,_,L,_), Val) =>
  172    gen_assoc_(Key, L, Val).
  173gen_assoc_(Key, t(Key,Val0,_,_,_), Val) =>
  174    Val = Val0.
  175gen_assoc_(Key, t(_,_,_,_,R), Val) =>
  176    gen_assoc_(Key, R, Val).
  177gen_assoc_(_, t, _) =>
  178    fail.
 get_assoc(+Key, +Assoc, -Value) is semidet
True if Key-Value is an association in Assoc.
Errors
- type_error(assoc, Assoc) if Assoc is not an association list.
  187get_assoc(Key, Assoc, Val) :-
  188    must_be(assoc, Assoc),
  189    get_assoc_(Key, Assoc, Val).
  190
  191:- if(current_predicate('$btree_find_node'/5)).  192get_assoc_(Key, Tree, Val) :-
  193    Tree \== t,
  194    '$btree_find_node'(Key, Tree, 0x010405, Node, =),
  195    arg(2, Node, Val).
  196:- else.  197get_assoc_(Key, t(K,V,_,L,R), Val) :-
  198    compare(Rel, Key, K),
  199    get_assoc(Rel, Key, V, L, R, Val).
  200
  201get_assoc(=, _, Val, _, _, Val).
  202get_assoc(<, Key, _, Tree, _, Val) :-
  203    get_assoc(Key, Tree, Val).
  204get_assoc(>, Key, _, _, Tree, Val) :-
  205    get_assoc(Key, Tree, Val).
  206:- endif.
 get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet
True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
  213get_assoc(Key, t(K,V,B,L,R), Val, Assoc, NVal) =>
  214    Assoc = t(K,NV,B,NL,NR),
  215    compare(Rel, Key, K),
  216    get_assoc(Rel, Key, V, L, R, Val, NV, NL, NR, NVal).
  217get_assoc(_Key, t, _Val, _, _) =>
  218    fail.
  219
  220get_assoc(=, _, Val, L, R, Val, NVal, L, R, NVal).
  221get_assoc(<, Key, V, L, R, Val, V, NL, R, NVal) :-
  222    get_assoc(Key, L, Val, NL, NVal).
  223get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
  224    get_assoc(Key, R, Val, NR, NVal).
 list_to_assoc(+Pairs, -Assoc) is det
Create an association from a list Pairs of Key-Value pairs. List must not contain duplicate keys.
Errors
- domain_error(unique_key_pairs, List) if List contains duplicate keys
  234list_to_assoc(List, Assoc) :-
  235    (   List == []
  236    ->  Assoc = t
  237    ;   keysort(List, Sorted),
  238        (  ord_pairs(Sorted)
  239        -> length(Sorted, N),
  240           list_to_assoc(N, Sorted, [], _, Assoc)
  241        ;  domain_error(unique_key_pairs, List)
  242        )
  243    ).
  244
  245list_to_assoc(1, [K-V|More], More, 1, t(K,V,-,t,t)) :- !.
  246list_to_assoc(2, [K1-V1,K2-V2|More], More, 2, t(K2,V2,<,t(K1,V1,-,t,t),t)) :- !.
  247list_to_assoc(N, List, More, Depth, t(K,V,Balance,L,R)) :-
  248    N0 is N - 1,
  249    RN is N0 div 2,
  250    Rem is N0 mod 2,
  251    LN is RN + Rem,
  252    list_to_assoc(LN, List, [K-V|Upper], LDepth, L),
  253    list_to_assoc(RN, Upper, More, RDepth, R),
  254    Depth is LDepth + 1,
  255    compare(B, RDepth, LDepth), balance(B, Balance).
 ord_list_to_assoc(+Pairs, -Assoc) is det
Assoc is created from an ordered list Pairs of Key-Value pairs. The pairs must occur in strictly ascending order of their keys.
Errors
- domain_error(key_ordered_pairs, List) if pairs are not ordered.
  265ord_list_to_assoc(Sorted, Assoc) :-
  266    (   Sorted == []
  267    ->  Assoc = t
  268    ;   (  ord_pairs(Sorted)
  269        -> length(Sorted, N),
  270           list_to_assoc(N, Sorted, [], _, Assoc)
  271        ;  domain_error(key_ordered_pairs, Sorted)
  272        )
  273    ).
 ord_pairs(+Pairs) is semidet
True if Pairs is a list of Key-Val pairs strictly ordered by key.
  279ord_pairs([K-_V|Rest]) :-
  280    ord_pairs(Rest, K).
  281ord_pairs([], _K).
  282ord_pairs([K-_V|Rest], K0) :-
  283    K0 @< K,
  284    ord_pairs(Rest, K).
 map_assoc(:Pred, +Assoc) is semidet
True if Pred(Value) is true for all values in Assoc.
  290map_assoc(Pred, T) :-
  291    map_assoc_(T, Pred).
  292
  293map_assoc_(t, _) =>
  294    true.
  295map_assoc_(t(_,Val,_,L,R), Pred) =>
  296    map_assoc_(L, Pred),
  297    call(Pred, Val),
  298    map_assoc_(R, Pred).
 map_assoc(:Pred, +Assoc0, ?Assoc) is semidet
Map corresponding values. True if Assoc is Assoc0 with Pred applied to all corresponding pairs of of values.
  305map_assoc(Pred, T0, T) :-
  306    map_assoc_(T0, Pred, T).
  307
  308map_assoc_(t, _, Assoc) =>
  309    Assoc = t.
  310map_assoc_(t(Key,Val,B,L0,R0), Pred, Assoc) =>
  311    Assoc = t(Key,Ans,B,L1,R1),
  312    map_assoc_(L0, Pred, L1),
  313    call(Pred, Val, Ans),
  314    map_assoc_(R0, Pred, R1).
 max_assoc(+Assoc, -Key, -Value) is semidet
True if Key-Value is in Assoc and Key is the largest key.
  321max_assoc(t(K,V,_,_,R), Key, Val) =>
  322    max_assoc(R, K, V, Key, Val).
  323max_assoc(t, _, _) =>
  324    fail.
  325
  326max_assoc(t, K, V, K, V).
  327max_assoc(t(K,V,_,_,R), _, _, Key, Val) :-
  328    max_assoc(R, K, V, Key, Val).
 min_assoc(+Assoc, -Key, -Value) is semidet
True if Key-Value is in assoc and Key is the smallest key.
  335min_assoc(t(K,V,_,L,_), Key, Val) =>
  336    min_assoc(L, K, V, Key, Val).
  337min_assoc(t, _, _) =>
  338    fail.
  339
  340min_assoc(t, K, V, K, V).
  341min_assoc(t(K,V,_,L,_), _, _, Key, Val) :-
  342    min_assoc(L, K, V, Key, Val).
 put_assoc(+Key, +Assoc0, +Value, -Assoc) is det
Assoc is Assoc0, except that Key is associated with Value. This can be used to insert and change associations.
  350put_assoc(Key, A0, Value, A) :-
  351    insert(A0, Key, Value, A, _).
  352
  353insert(t, Key, Val, Assoc, Changed) =>
  354    Assoc = t(Key,Val,-,t,t),
  355    Changed = yes.
  356insert(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) =>
  357    compare(Rel, K, Key),
  358    insert(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
  359
  360insert(=, t(Key,_,B,L,R), _, V, t(Key,V,B,L,R), no).
  361insert(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  362    insert(L, K, V, NewL, LeftHasChanged),
  363    adjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
  364insert(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  365    insert(R, K, V, NewR, RightHasChanged),
  366    adjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
  367
  368adjust(no, Oldree, _, Oldree, no).
  369adjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, WhatHasChanged) :-
  370    table(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
  371    rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, _, _).
  372
  373%     balance  where     balance  whole tree  to be
  374%     before   inserted  after    increased   rebalanced
  375table(-      , left    , <      , yes       , no    ) :- !.
  376table(-      , right   , >      , yes       , no    ) :- !.
  377table(<      , left    , -      , no        , yes   ) :- !.
  378table(<      , right   , -      , no        , no    ) :- !.
  379table(>      , left    , -      , no        , no    ) :- !.
  380table(>      , right   , -      , no        , yes   ) :- !.
 del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet
True if Key-Value is in Assoc0 and Key is the smallest key. Assoc is Assoc0 with Key-Value removed. Warning: This will succeed with no bindings for Key or Val if Assoc0 is empty.
  388del_min_assoc(Tree, Key, Val, NewTree) :-
  389    del_min_assoc(Tree, Key, Val, NewTree, _DepthChanged).
  390
  391del_min_assoc(t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
  392del_min_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
  393    del_min_assoc(L, Key, Val, NewL, LeftChanged),
  394    deladjust(LeftChanged, t(K,V,B,NewL,R), left, NewTree, Changed).
 del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet
True if Key-Value is in Assoc0 and Key is the greatest key. Assoc is Assoc0 with Key-Value removed. Warning: This will succeed with no bindings for Key or Val if Assoc0 is empty.
  402del_max_assoc(Tree, Key, Val, NewTree) :-
  403    del_max_assoc(Tree, Key, Val, NewTree, _DepthChanged).
  404
  405del_max_assoc(t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
  406del_max_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
  407    del_max_assoc(R, Key, Val, NewR, RightChanged),
  408    deladjust(RightChanged, t(K,V,B,L,NewR), right, NewTree, Changed).
 del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet
True if Key-Value is in Assoc0. Assoc is Assoc0 with Key-Value removed.
  415del_assoc(Key, A0, Value, A) :-
  416    delete(A0, Key, Value, A, _).
  417
  418% delete(+Subtree, +SearchedKey, ?SearchedValue, ?SubtreeOut, ?WhatHasChanged)
  419delete(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) =>
  420    compare(Rel, K, Key),
  421    delete(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
  422delete(t, _, _, _, _) =>
  423    fail.
  424
  425% delete(+KeySide, +Subtree, +SearchedKey, ?SearchedValue, ?SubtreeOut, ?WhatHasChanged)
  426% KeySide is an operator {<,=,>} indicating which branch should be searched for the key.
  427% WhatHasChanged {yes,no} indicates whether the NewTree has changed in depth.
  428delete(=, t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
  429delete(=, t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
  430delete(=, t(Key,Val,>,L,R), Key, Val, NewTree, WhatHasChanged) :-
  431    % Rh tree is deeper, so rotate from R to L
  432    del_min_assoc(R, K, V, NewR, RightHasChanged),
  433    deladjust(RightHasChanged, t(K,V,>,L,NewR), right, NewTree, WhatHasChanged),
  434    !.
  435delete(=, t(Key,Val,B,L,R), Key, Val, NewTree, WhatHasChanged) :-
  436    % Rh tree is not deeper, so rotate from L to R
  437    del_max_assoc(L, K, V, NewL, LeftHasChanged),
  438    deladjust(LeftHasChanged, t(K,V,B,NewL,R), left, NewTree, WhatHasChanged),
  439    !.
  440
  441delete(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  442    delete(L, K, V, NewL, LeftHasChanged),
  443    deladjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
  444delete(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  445    delete(R, K, V, NewR, RightHasChanged),
  446    deladjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
  447
  448deladjust(no, OldTree, _, OldTree, no).
  449deladjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, RealChange) :-
  450    deltable(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
  451    rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, WhatHasChanged, RealChange).
  452
  453%     balance  where     balance  whole tree  to be
  454%     before   deleted   after    changed   rebalanced
  455deltable(-      , right   , <      , no        , no    ) :- !.
  456deltable(-      , left    , >      , no        , no    ) :- !.
  457deltable(<      , right   , -      , yes       , yes   ) :- !.
  458deltable(<      , left    , -      , yes       , no    ) :- !.
  459deltable(>      , right   , -      , yes       , no    ) :- !.
  460deltable(>      , left    , -      , yes       , yes   ) :- !.
  461% It depends on the tree pattern in avl_geq whether it really decreases.
  462
  463% Single and double tree rotations - these are common for insert and delete.
  464/* The patterns (>)-(>), (>)-( <), ( <)-( <) and ( <)-(>) on the LHS
  465   always change the tree height and these are the only patterns which can
  466   happen after an insertion. That's the reason why we can use a table only to
  467   decide the needed changes.
  468
  469   The patterns (>)-( -) and ( <)-( -) do not change the tree height. After a
  470   deletion any pattern can occur and so we return yes or no as a flag of a
  471   height change.  */
  472
  473
  474rebalance(no, t(K,V,_,L,R), B, t(K,V,B,L,R), Changed, Changed).
  475rebalance(yes, OldTree, _, NewTree, _, RealChange) :-
  476    avl_geq(OldTree, NewTree, RealChange).
  477
  478avl_geq(t(A,VA,>,Alpha,t(B,VB,>,Beta,Gamma)),
  479        t(B,VB,-,t(A,VA,-,Alpha,Beta),Gamma), yes) :- !.
  480avl_geq(t(A,VA,>,Alpha,t(B,VB,-,Beta,Gamma)),
  481        t(B,VB,<,t(A,VA,>,Alpha,Beta),Gamma), no) :- !.
  482avl_geq(t(B,VB,<,t(A,VA,<,Alpha,Beta),Gamma),
  483        t(A,VA,-,Alpha,t(B,VB,-,Beta,Gamma)), yes) :- !.
  484avl_geq(t(B,VB,<,t(A,VA,-,Alpha,Beta),Gamma),
  485        t(A,VA,>,Alpha,t(B,VB,<,Beta,Gamma)), no) :- !.
  486avl_geq(t(A,VA,>,Alpha,t(B,VB,<,t(X,VX,B1,Beta,Gamma),Delta)),
  487        t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
  488    !,
  489    table2(B1, B2, B3).
  490avl_geq(t(B,VB,<,t(A,VA,>,Alpha,t(X,VX,B1,Beta,Gamma)),Delta),
  491        t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
  492    !,
  493    table2(B1, B2, B3).
  494
  495table2(< ,- ,> ).
  496table2(> ,< ,- ).
  497table2(- ,- ,- ).
  498
  499
  500                 /*******************************
  501                 *            ERRORS            *
  502                 *******************************/
  503
  504:- multifile
  505    error:has_type/2.  506
  507error:has_type(assoc, X) :-
  508    (   X == t
  509    ->  true
  510    ;   compound(X),
  511        functor(X, t, 5)
  512    )