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)).
  57
  58/** <module> Binary associations
  59
  60Assocs are Key-Value associations implemented as  a balanced binary tree
  61(AVL tree).
  62
  63@see            library(pairs), library(rbtrees)
  64@author         R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
  65*/
  66
  67:- meta_predicate
  68    map_assoc(1, ?),
  69    map_assoc(2, ?, ?).
  70
  71%!  empty_assoc(?Assoc) is semidet.
  72%
  73%   Is true if Assoc is the empty association list.
  74
  75empty_assoc(t).
  76
  77%!  assoc_to_list(+Assoc, -Pairs) is det.
  78%
  79%   Translate Assoc to a list Pairs of Key-Value pairs.  The keys
  80%   in Pairs are sorted in ascending order.
  81
  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).
  89
  90
  91%!  assoc_to_keys(+Assoc, -Keys) is det.
  92%
  93%   True if Keys is the list of keys   in Assoc. The keys are sorted
  94%   in ascending order.
  95
  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).
 103
 104
 105%!  assoc_to_values(+Assoc, -Values) is det.
 106%
 107%   True if Values is the  list  of   values  in  Assoc.  Values are
 108%   ordered in ascending  order  of  the   key  to  which  they were
 109%   associated.  Values may contain duplicates.
 110
 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).
 118
 119%!  is_assoc(+Assoc) is semidet.
 120%
 121%   True if Assoc is an association list. This predicate checks
 122%   that the structure is valid, elements are in order, and tree
 123%   is balanced to the extent guaranteed by AVL trees.  I.e.,
 124%   branches of each subtree differ in depth by at most 1.
 125
 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(>,>).
 155
 156
 157%!  gen_assoc(?Key, +Assoc, ?Value) is nondet.
 158%
 159%   True if Key-Value is an association in Assoc. Enumerates keys in
 160%   ascending order on backtracking.
 161%
 162%   @see get_assoc/3.
 163
 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).
 169
 170
 171%!  get_assoc(+Key, +Assoc, -Value) is semidet.
 172%
 173%   True if Key-Value is an association in Assoc.
 174%
 175%   @error type_error(assoc, Assoc) if Assoc is not an association list.
 176
 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).
 188
 189
 190%!  get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet.
 191%
 192%   True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
 193
 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).
 203
 204
 205%!  list_to_assoc(+Pairs, -Assoc) is det.
 206%
 207%   Create an association from a list Pairs of Key-Value pairs. List
 208%   must not contain duplicate keys.
 209%
 210%   @error domain_error(unique_key_pairs, List) if List contains duplicate keys
 211
 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).
 233
 234%!  ord_list_to_assoc(+Pairs, -Assoc) is det.
 235%
 236%   Assoc is created from an ordered list Pairs of Key-Value
 237%   pairs. The pairs must occur in strictly ascending order of
 238%   their keys.
 239%
 240%   @error domain_error(key_ordered_pairs, List) if pairs are not ordered.
 241
 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    ).
 250
 251%!  ord_pairs(+Pairs) is semidet
 252%
 253%   True if Pairs is a list of Key-Val pairs strictly ordered by key.
 254
 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).
 261
 262%!  map_assoc(:Pred, +Assoc) is semidet.
 263%
 264%   True if Pred(Value) is true for all values in Assoc.
 265
 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).
 274
 275%!  map_assoc(:Pred, +Assoc0, ?Assoc) is semidet.
 276%
 277%   Map corresponding values. True if Assoc is Assoc0 with Pred
 278%   applied to all corresponding pairs of of values.
 279
 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).
 288
 289
 290%!  max_assoc(+Assoc, -Key, -Value) is semidet.
 291%
 292%   True if Key-Value is in Assoc and Key is the largest key.
 293
 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).
 300
 301
 302%!  min_assoc(+Assoc, -Key, -Value) is semidet.
 303%
 304%   True if Key-Value is in assoc and Key is the smallest key.
 305
 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).
 312
 313
 314%!  put_assoc(+Key, +Assoc0, +Value, -Assoc) is det.
 315%
 316%   Assoc is Assoc0, except that Key is associated with
 317%   Value. This can be used to insert and change associations.
 318
 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   ) :- !.
 348
 349%!  del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
 350%
 351%   True if Key-Value  is  in  Assoc0   and  Key  is  the smallest key.
 352%   Assoc is Assoc0 with Key-Value   removed. Warning: This will
 353%   succeed with _no_ bindings for Key or Val if Assoc0 is empty.
 354
 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).
 362
 363%!  del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
 364%
 365%   True if Key-Value  is  in  Assoc0   and  Key  is  the greatest key.
 366%   Assoc is Assoc0 with Key-Value   removed. Warning: This will
 367%   succeed with _no_ bindings for Key or Val if Assoc0 is empty.
 368
 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).
 376
 377%!  del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet.
 378%
 379%   True if Key-Value is  in  Assoc0.   Assoc  is  Assoc0 with
 380%   Key-Value removed.
 381
 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    ).