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-2016, 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:- use_module(library(error)).

   67:- meta_predicate
   68    map_assoc(1, ?),
   69    map_assoc(2, ?, ?).

 empty_assoc(?Assoc) is semidet

Is true if Assoc is the empty association list.

   75empty_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.

   82assoc_to_list(Assoc, List) :-
   83    assoc_to_list(Assoc, List, []).
   84
   85assoc_to_list(t(Key,Val,_,L,R), List, Rest) :-
   86    assoc_to_list(L, List, [Key-Val|More]),
   87    assoc_to_list(R, More, Rest).
   88assoc_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.

   96assoc_to_keys(Assoc, List) :-
   97    assoc_to_keys(Assoc, List, []).
   98
   99assoc_to_keys(t(Key,_,_,L,R), List, Rest) :-
  100    assoc_to_keys(L, List, [Key|More]),
  101    assoc_to_keys(R, More, Rest).
  102assoc_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.

  111assoc_to_values(Assoc, List) :-
  112    assoc_to_values(Assoc, List, []).
  113
  114assoc_to_values(t(_,Value,_,L,R), List, Rest) :-
  115    assoc_to_values(L, List, [Value|More]),
  116    assoc_to_values(R, More, Rest).
  117assoc_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.

  126is_assoc(Assoc) :-
  127    is_assoc(Assoc, _Min, _Max, _Depth).
  128
  129is_assoc(t,X,X,0) :- !.
  130is_assoc(t(K,_,-,t,t),K,K,1) :- !, ground(K).
  131is_assoc(t(K,_,>,t,t(RK,_,-,t,t)),K,RK,2) :-
  132    % Ensure right side Key is 'greater' than K
  133    !, ground((K,RK)), K @< RK.
  134
  135is_assoc(t(K,_,<,t(LK,_,-,t,t),t),LK,K,2) :-
  136    % Ensure left side Key is 'less' than K
  137    !, ground((LK,K)), LK @< K.
  138
  139is_assoc(t(K,_,B,L,R),Min,Max,Depth) :-
  140    is_assoc(L,Min,LMax,LDepth),
  141    is_assoc(R,RMin,Max,RDepth),
  142    % Ensure Balance matches depth
  143    compare(Rel,RDepth,LDepth),
  144    balance(Rel,B),
  145    % Ensure ordering
  146    ground((LMax,K,RMin)),
  147    LMax @< K,
  148    K @< RMin,
  149    Depth is max(LDepth, RDepth)+1.
  150
  151% Private lookup table matching comparison operators to Balance operators used in tree
  152balance(=,-).
  153balance(<,<).
  154balance(>,>).

 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.

  164gen_assoc(Key, t(_,_,_,L,_), Val) :-
  165    gen_assoc(Key, L, Val).
  166gen_assoc(Key, t(Key,Val,_,_,_), Val).
  167gen_assoc(Key, t(_,_,_,_,R), Val) :-
  168    gen_assoc(Key, R, Val).

 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.

  177get_assoc(Key, Assoc, Val) :-
  178    must_be(assoc, Assoc),
  179    Assoc = t(K,V,_,L,R),
  180    compare(Rel, Key, K),
  181    get_assoc(Rel, Key, V, L, R, Val).
  182
  183get_assoc(=, _, Val, _, _, Val).
  184get_assoc(<, Key, _, Tree, _, Val) :-
  185    get_assoc(Key, Tree, Val).
  186get_assoc(>, Key, _, _, Tree, Val) :-
  187    get_assoc(Key, Tree, Val).

 get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet

True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.

  194get_assoc(Key, t(K,V,B,L,R), Val, t(K,NV,B,NL,NR), NVal) :-
  195    compare(Rel, Key, K),
  196    get_assoc(Rel, Key, V, L, R, Val, NV, NL, NR, NVal).
  197
  198get_assoc(=, _, Val, L, R, Val, NVal, L, R, NVal).
  199get_assoc(<, Key, V, L, R, Val, V, NL, R, NVal) :-
  200    get_assoc(Key, L, Val, NL, NVal).
  201get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
  202    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

  212list_to_assoc(List, Assoc) :-
  213    (  List = [] -> Assoc = t
  214    ;  keysort(List, Sorted),
  215           (  ord_pairs(Sorted)
  216           -> length(Sorted, N),
  217              list_to_assoc(N, Sorted, [], _, Assoc)
  218           ;  domain_error(unique_key_pairs, List)
  219           )
  220    ).
  221
  222list_to_assoc(1, [K-V|More], More, 1, t(K,V,-,t,t)) :- !.
  223list_to_assoc(2, [K1-V1,K2-V2|More], More, 2, t(K2,V2,<,t(K1,V1,-,t,t),t)) :- !.
  224list_to_assoc(N, List, More, Depth, t(K,V,Balance,L,R)) :-
  225    N0 is N - 1,
  226    RN is N0 div 2,
  227    Rem is N0 mod 2,
  228    LN is RN + Rem,
  229    list_to_assoc(LN, List, [K-V|Upper], LDepth, L),
  230    list_to_assoc(RN, Upper, More, RDepth, R),
  231    Depth is LDepth + 1,
  232    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.

  242ord_list_to_assoc(Sorted, Assoc) :-
  243    (  Sorted = [] -> Assoc = t
  244    ;  (  ord_pairs(Sorted)
  245           -> length(Sorted, N),
  246              list_to_assoc(N, Sorted, [], _, Assoc)
  247           ;  domain_error(key_ordered_pairs, Sorted)
  248           )
  249    ).

 ord_pairs(+Pairs) is semidet

True if Pairs is a list of Key-Val pairs strictly ordered by key.

  255ord_pairs([K-_V|Rest]) :-
  256    ord_pairs(Rest, K).
  257ord_pairs([], _K).
  258ord_pairs([K-_V|Rest], K0) :-
  259    K0 @< K,
  260    ord_pairs(Rest, K).

 map_assoc(:Pred, +Assoc) is semidet

True if Pred(Value) is true for all values in Assoc.

  266map_assoc(Pred, T) :-
  267    map_assoc_(T, Pred).
  268
  269map_assoc_(t, _).
  270map_assoc_(t(_,Val,_,L,R), Pred) :-
  271    map_assoc_(L, Pred),
  272    call(Pred, Val),
  273    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.

  280map_assoc(Pred, T0, T) :-
  281    map_assoc_(T0, Pred, T).
  282
  283map_assoc_(t, _, t).
  284map_assoc_(t(Key,Val,B,L0,R0), Pred, t(Key,Ans,B,L1,R1)) :-
  285    map_assoc_(L0, Pred, L1),
  286    call(Pred, Val, Ans),
  287    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.

  294max_assoc(t(K,V,_,_,R), Key, Val) :-
  295    max_assoc(R, K, V, Key, Val).
  296
  297max_assoc(t, K, V, K, V).
  298max_assoc(t(K,V,_,_,R), _, _, Key, Val) :-
  299    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.

  306min_assoc(t(K,V,_,L,_), Key, Val) :-
  307    min_assoc(L, K, V, Key, Val).
  308
  309min_assoc(t, K, V, K, V).
  310min_assoc(t(K,V,_,L,_), _, _, Key, Val) :-
  311    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.

  319put_assoc(Key, A0, Value, A) :-
  320    insert(A0, Key, Value, A, _).
  321
  322insert(t, Key, Val, t(Key,Val,-,t,t), yes).
  323insert(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  324    compare(Rel, K, Key),
  325    insert(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
  326
  327insert(=, t(Key,_,B,L,R), _, V, t(Key,V,B,L,R), no).
  328insert(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  329    insert(L, K, V, NewL, LeftHasChanged),
  330    adjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
  331insert(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  332    insert(R, K, V, NewR, RightHasChanged),
  333    adjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
  334
  335adjust(no, Oldree, _, Oldree, no).
  336adjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, WhatHasChanged) :-
  337    table(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
  338    rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, _, _).
  339
  340%     balance  where     balance  whole tree  to be
  341%     before   inserted  after    increased   rebalanced
  342table(-      , left    , <      , yes       , no    ) :- !.
  343table(-      , right   , >      , yes       , no    ) :- !.
  344table(<      , left    , -      , no        , yes   ) :- !.
  345table(<      , right   , -      , no        , no    ) :- !.
  346table(>      , left    , -      , no        , no    ) :- !.
  347table(>      , 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.

  355del_min_assoc(Tree, Key, Val, NewTree) :-
  356    del_min_assoc(Tree, Key, Val, NewTree, _DepthChanged).
  357
  358del_min_assoc(t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
  359del_min_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
  360    del_min_assoc(L, Key, Val, NewL, LeftChanged),
  361    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.

  369del_max_assoc(Tree, Key, Val, NewTree) :-
  370    del_max_assoc(Tree, Key, Val, NewTree, _DepthChanged).
  371
  372del_max_assoc(t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
  373del_max_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
  374    del_max_assoc(R, Key, Val, NewR, RightChanged),
  375    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.

  382del_assoc(Key, A0, Value, A) :-
  383    delete(A0, Key, Value, A, _).
  384
  385% delete(+Subtree, +SearchedKey, ?SearchedValue, ?SubtreeOut, ?WhatHasChanged)
  386delete(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  387    compare(Rel, K, Key),
  388    delete(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
  389
  390% delete(+KeySide, +Subtree, +SearchedKey, ?SearchedValue, ?SubtreeOut, ?WhatHasChanged)
  391% KeySide is an operator {<,=,>} indicating which branch should be searched for the key.
  392% WhatHasChanged {yes,no} indicates whether the NewTree has changed in depth.
  393delete(=, t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
  394delete(=, t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
  395delete(=, t(Key,Val,>,L,R), Key, Val, NewTree, WhatHasChanged) :-
  396    % Rh tree is deeper, so rotate from R to L
  397    del_min_assoc(R, K, V, NewR, RightHasChanged),
  398    deladjust(RightHasChanged, t(K,V,>,L,NewR), right, NewTree, WhatHasChanged),
  399    !.
  400delete(=, t(Key,Val,B,L,R), Key, Val, NewTree, WhatHasChanged) :-
  401    % Rh tree is not deeper, so rotate from L to R
  402    del_max_assoc(L, K, V, NewL, LeftHasChanged),
  403    deladjust(LeftHasChanged, t(K,V,B,NewL,R), left, NewTree, WhatHasChanged),
  404    !.
  405
  406delete(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  407    delete(L, K, V, NewL, LeftHasChanged),
  408    deladjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
  409delete(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  410    delete(R, K, V, NewR, RightHasChanged),
  411    deladjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
  412
  413deladjust(no, OldTree, _, OldTree, no).
  414deladjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, RealChange) :-
  415    deltable(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
  416    rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, WhatHasChanged, RealChange).
  417
  418%     balance  where     balance  whole tree  to be
  419%     before   deleted   after    changed   rebalanced
  420deltable(-      , right   , <      , no        , no    ) :- !.
  421deltable(-      , left    , >      , no        , no    ) :- !.
  422deltable(<      , right   , -      , yes       , yes   ) :- !.
  423deltable(<      , left    , -      , yes       , no    ) :- !.
  424deltable(>      , right   , -      , yes       , no    ) :- !.
  425deltable(>      , left    , -      , yes       , yes   ) :- !.
  426% It depends on the tree pattern in avl_geq whether it really decreases.
  427
  428% Single and double tree rotations - these are common for insert and delete.
  429/* The patterns (>)-(>), (>)-( <), ( <)-( <) and ( <)-(>) on the LHS
  430   always change the tree height and these are the only patterns which can
  431   happen after an insertion. That's the reason why we can use a table only to
  432   decide the needed changes.
  433
  434   The patterns (>)-( -) and ( <)-( -) do not change the tree height. After a
  435   deletion any pattern can occur and so we return yes or no as a flag of a
  436   height change.  */
  437
  438
  439rebalance(no, t(K,V,_,L,R), B, t(K,V,B,L,R), Changed, Changed).
  440rebalance(yes, OldTree, _, NewTree, _, RealChange) :-
  441    avl_geq(OldTree, NewTree, RealChange).
  442
  443avl_geq(t(A,VA,>,Alpha,t(B,VB,>,Beta,Gamma)),
  444        t(B,VB,-,t(A,VA,-,Alpha,Beta),Gamma), yes) :- !.
  445avl_geq(t(A,VA,>,Alpha,t(B,VB,-,Beta,Gamma)),
  446        t(B,VB,<,t(A,VA,>,Alpha,Beta),Gamma), no) :- !.
  447avl_geq(t(B,VB,<,t(A,VA,<,Alpha,Beta),Gamma),
  448        t(A,VA,-,Alpha,t(B,VB,-,Beta,Gamma)), yes) :- !.
  449avl_geq(t(B,VB,<,t(A,VA,-,Alpha,Beta),Gamma),
  450        t(A,VA,>,Alpha,t(B,VB,<,Beta,Gamma)), no) :- !.
  451avl_geq(t(A,VA,>,Alpha,t(B,VB,<,t(X,VX,B1,Beta,Gamma),Delta)),
  452        t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
  453    !,
  454    table2(B1, B2, B3).
  455avl_geq(t(B,VB,<,t(A,VA,>,Alpha,t(X,VX,B1,Beta,Gamma)),Delta),
  456        t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
  457    !,
  458    table2(B1, B2, B3).
  459
  460table2(< ,- ,> ).
  461table2(> ,< ,- ).
  462table2(- ,- ,- ).
  463
  464
  465                 /*******************************
  466                 *            ERRORS            *
  467                 *******************************/
  468
  469:- multifile
  470    error:has_type/2.  471
  472error:has_type(assoc, X) :-
  473    (   X == t
  474    ->  true
  475    ;   compound(X),
  476        functor(X, t, 5)
  477    )