View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2015-2025, VU University Amsterdam
    7                              SWI-Prolog Solutions b.v.
    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(dicts,
   37          [ mapdict/2,                  % :Goal, +Dict
   38            mapdict/3,                  % :Goal, ?Dict1, ?Dict2
   39            mapdict/4,                  % :Goal, ?Dict1, ?Dict2, ?Dict3
   40            dicts_same_tag/2,           % +List, -Tag
   41            dict_size/2,                % +Dict, -KeyCount
   42            dict_keys/2,                % +Dict, -Keys
   43            dicts_same_keys/2,          % +DictList, -Keys
   44            dicts_to_same_keys/3,       % +DictsIn, :OnEmpty, -DictsOut
   45            dict_fill/4,                % +Value, +Key, +Dict, -Value
   46            dict_no_fill/3,             % +Key, +Dict, -Value
   47            dicts_join/3,               % +Key, +DictsIn, -Dicts
   48            dicts_join/4,               % +Key, +Dicts1, +Dicts2, -Dicts
   49            dicts_slice/3,              % +Keys, +DictsIn, -DictsOut
   50            dicts_to_compounds/4        % ?Dicts, +Keys, :OnEmpty, ?Compounds
   51          ]).   52:- autoload(library(apply),[maplist/2,maplist/3]).   53:- autoload(library(lists),[append/2,append/3]).   54:- autoload(library(ordsets),[ord_subtract/3]).   55:- autoload(library(pairs),[pairs_keys/2,pairs_keys_values/3]).   56:- autoload(library(error), [domain_error/2, must_be/2]).   57
   58:- set_prolog_flag(generate_debug_info, false).   59
   60:- meta_predicate
   61    mapdict(2, +),
   62    mapdict(3, ?, ?),
   63    mapdict(4, ?, ?, ?),
   64    dicts_to_same_keys(+,3,-),
   65    dicts_to_compounds(?,+,3,?).

Dict utilities

This library defines utilities that operate on lists of dicts, notably to make lists of dicts consistent by adding missing keys, converting between lists of compounds and lists of dicts, joining and slicing lists of dicts. */

 mapdict(:Goal, +Dict)
 mapdict(:Goal, ?Dict, ?Dict2)
 mapdict(:Goal, ?Dict, ?Dict2, ?Dict3)
True when all dicts have the same set of keys and call(Goal, Key, V1, ...) is true for all keys in the dicts. At least one of the dicts must be instantiated.
Errors
- instantiation_error if no dict is bound
- type_error(dict, Culprit) if one of the dict arguments is not a dict.
- domain_error(incompatible_dict, Culprit) if Culprit does not have the same keys as one of the other dicts.
   89mapdict(Goal, Dict) :-
   90    mapdict_(1, Goal, Dict).
   91
   92mapdict_(I, Goal, D1) :-
   93    (   '$get_dict_kv'(I, D1, K, V1)
   94    ->  call(Goal, K, V1),
   95        I2 is I+1,
   96        mapdict_(I2, Goal, D1)
   97    ;   true
   98    ).
   99
  100mapdict(Goal, Dict1, Dict2) :-
  101    (   dict_same_keys(Dict1, Dict2)
  102    ->  mapdict_(1, Goal, Dict1, Dict2)
  103    ;   domain_error(incompatible_dict, Dict2)
  104    ).
  105
  106mapdict_(I, Goal, D1, D2) :-
  107    (   '$get_dict_kv'(I, D1, D2, K, V1, V2)
  108    ->  call(Goal, K, V1, V2),
  109        I2 is I+1,
  110        mapdict_(I2, Goal, D1, D2)
  111    ;   true
  112    ).
  113
  114
  115mapdict(Goal, Dict1, Dict2, Dict3) :-
  116    (   nonvar(Dict1)
  117    ->  dict_same_keys(Dict1, Dict2),
  118        dict_same_keys(Dict1, Dict3)
  119    ;   nonvar(Dict2)
  120    ->  dict_same_keys(Dict1, Dict2),
  121        dict_same_keys(Dict1, Dict3)
  122    ;   dict_same_keys(Dict3, Dict2),
  123        dict_same_keys(Dict3, Dict1)
  124    ),
  125    !,
  126    mapdict_(1, Goal, Dict1, Dict2, Dict3).
  127mapdict(_Goal, Dict1, Dict2, Dict3) :-
  128    (   nonvar(Dict3)
  129    ->  domain_error(incompatible_dict, Dict3)
  130    ;   nonvar(Dict2)
  131    ->  domain_error(incompatible_dict, Dict2)
  132    ;   domain_error(incompatible_dict, Dict1)
  133    ).
  134
  135mapdict_(I, Goal, D1, D2, D3) :-
  136    (   '$get_dict_kv'(I, D1, D2, D3, K, V1, V2, V3)
  137    ->  call(Goal, K, V1, V2, V3),
  138        I2 is I+1,
  139        mapdict_(I2, Goal, D1, D2, D3)
  140    ;   true
  141    ).
 dicts_same_tag(+List, -Tag) is semidet
True when List is a list of dicts that all have the tag Tag.
  148dicts_same_tag(List, Tag) :-
  149    maplist(keys_tag(Tag), List).
  150
  151keys_tag(Tag, Dict) :-
  152    is_dict(Dict, Tag).
 dict_size(+Dict, -KeyCount) is det
True when KeyCount is the number of keys in Dict.
  158dict_size(Dict, KeyCount) :-
  159    must_be(dict,Dict),
  160    compound_name_arity(Dict,_,Arity),
  161    KeyCount is (Arity-1)//2.
 dict_keys(+Dict, -Keys) is det
True when Keys is an ordered set of the keys appearing in Dict.
  167dict_keys(Dict, Keys) :-
  168    dict_pairs(Dict, _Tag, Pairs),
  169    pairs_keys(Pairs, Keys).
 dicts_same_keys(+List, -Keys) is semidet
True if List is a list of dicts that all have the same keys and Keys is an ordered set of these keys.
  177dicts_same_keys(List, Keys) :-
  178    maplist(keys_dict(Keys), List).
  179
  180keys_dict(Keys, Dict) :-
  181    dict_keys(Dict, Keys).
 dicts_to_same_keys(+DictsIn, :OnEmpty, -DictsOut)
DictsOut is a copy of DictsIn, where each dict contains all keys appearing in all dicts of DictsIn. Values for keys that are added to a dict are produced by calling OnEmpty as below. The predicate dict_fill/4 provides an implementation that fills all new cells with a predefined value.
call(:OnEmpty, +Key, +Dict, -Value)
  195dicts_to_same_keys(Dicts, _, Table) :-
  196    dicts_same_keys(Dicts, _),
  197    !,
  198    Table = Dicts.
  199dicts_to_same_keys(Dicts, OnEmpty, Table) :-
  200    maplist(dict_keys, Dicts, KeysList),
  201    append(KeysList, Keys0),
  202    sort(Keys0, Keys),
  203    maplist(extend_dict(Keys, OnEmpty), Dicts, Table).
  204
  205extend_dict(Keys, OnEmpty, Dict0, Dict) :-
  206    dict_pairs(Dict0, Tag, Pairs),
  207    pairs_keys(Pairs, DictKeys),
  208    ord_subtract(Keys, DictKeys, Missing),
  209    (   Missing == []
  210    ->  Dict = Dict0
  211    ;   maplist(key_value_pair(Dict0, OnEmpty), Missing, NewPairs),
  212        append(NewPairs, Pairs, AllPairs),
  213        dict_pairs(Dict, Tag, AllPairs)
  214    ).
  215
  216key_value_pair(Dict, OnEmpty, Key, Key-Value) :-
  217    call(OnEmpty, Key, Dict, Value).
 dict_fill(+ValueIn, +Key, +Dict, -Value) is det
Implementation for the dicts_to_same_keys/3 OnEmpty closure that fills new cells with a copy of ValueIn. Note that copy_term/2 does not really copy ground terms. Below are two examples. Note that when filling empty cells with a variable, each empty cell is bound to a new variable.
?- dicts_to_same_keys([r{x:1}, r{y:2}], dict_fill(null), L).
L = [r{x:1, y:null}, r{x:null, y:2}].
?- dicts_to_same_keys([r{x:1}, r{y:2}], dict_fill(_), L).
L = [r{x:1, y:_G2005}, r{x:_G2036, y:2}].

Use dict_no_fill/3 to raise an error if a dict is missing a key.

  236dict_fill(ValueIn, _, _, Value) :-
  237    copy_term(ValueIn, Value).
 dict_no_fill is det
Can be used instead of dict_fill/4 to raise an exception if some dict is missing a key.
  244dict_no_fill(Key, Dict, Value) :-
  245    Value = Dict.Key.
 dicts_join(+Key, +DictsIn, -Dicts) is semidet
Join dicts in Dicts that have the same value for Key, provided they do not have conflicting values on other keys. For example:
?- dicts_join(x, [r{x:1, y:2}, r{x:1, z:3}, r{x:2,y:4}], L).
L = [r{x:1, y:2, z:3}, r{x:2, y:4}].
Errors
- existence_error(key, Key, Dict) if a dict in Dicts1 or Dicts2 does not contain Key.
  260dicts_join(Join, Dicts0, Dicts) :-
  261    sort(Join, @=<, Dicts0, Dicts1),
  262    join(Dicts1, Join, Dicts).
  263
  264join([], _, []) :- !.
  265join([H0|T0], Key, [H|T]) :-
  266    !,
  267    get_dict(Key, H0, V0),
  268    join_same(T0, Key, V0, H0, H, T1),
  269    join(T1, Key, T).
  270join([One], _, [One]) :- !.
  271
  272join_same([H|T0], Key, V0, D0, D, T) :-
  273    get_dict(Key, H, V),
  274    V == V0,
  275    !,
  276    D0 >:< H,
  277    put_dict(H, D0, D1),
  278    join_same(T0, Key, V0, D1, D, T).
  279join_same(DL, _, _, D, D, DL).
 dicts_join(+Key, +Dicts1, +Dicts2, -Dicts) is semidet
Join two lists of dicts (Dicts1 and Dicts2) on Key. Each pair D1-D2 from Dicts1 and Dicts2 that have the same (==) value for Key creates a new dict D with the union of the keys from D1 and D2, provided D1 and D2 to not have conflicting values for some key. For example:
?- DL1 = [r{x:1,y:1},r{x:2,y:4}],
   DL2 = [r{x:1,z:2},r{x:3,z:4}],
   dicts_join(x, DL1, DL2, DL).
   DL = [r{x:1, y:1, z:2}, r{x:2, y:4}, r{x:3, z:4}].
Errors
- existence_error(key, Key, Dict) if a dict in Dicts1 or Dicts2 does not contain Key.
  299dicts_join(Join, Dicts1, Dicts2, Dicts) :-
  300    sort(Join, @=<, Dicts1, Dicts11),
  301    sort(Join, @=<, Dicts2, Dicts21),
  302    join(Dicts11, Dicts21, Join, Dicts).
  303
  304join([], [], _, []) :- !.
  305join([D1|T1], [D2|T2], Join, [DNew|MoreDicts]) :-
  306    !,
  307    get_dict(Join, D1, K1),
  308    get_dict(Join, D2, K2),
  309    compare(Diff, K1, K2),
  310    (   Diff == (=)
  311    ->  D1 >:< D2,
  312        put_dict(D1, D2, DNew),
  313        join(T1, T2, Join, MoreDicts)
  314    ;   Diff == (<)
  315    ->  DNew = D1,
  316        join(T1, [D2|T2], Join, MoreDicts)
  317    ;   DNew = D2,
  318        join([D1|T1], T2, Join, MoreDicts)
  319    ).
  320join([], Dicts, _, Dicts) :- !.
  321join(Dicts, [], _, Dicts).
 dicts_slice(+Keys, +DictsIn, -DictsOut) is det
DictsOut is a list of Dicts only containing values for Keys.
  328dicts_slice(Keys, DictsIn, DictsOut) :-
  329    sort(Keys, SortedKeys),
  330    maplist(dict_slice(SortedKeys), DictsIn, DictsOut).
  331
  332dict_slice(Keys, DictIn, DictOut) :-
  333    dict_pairs(DictIn, Tag, PairsIn),
  334    slice_pairs(Keys, PairsIn, PairsOut),
  335    dict_pairs(DictOut, Tag, PairsOut).
  336
  337slice_pairs([], _, []) :- !.
  338slice_pairs(_, [], []) :- !.
  339slice_pairs([H|T0], [P|PL], Pairs) :-
  340    P = K-_,
  341    compare(D, H, K),
  342    (   D == (=)
  343    ->  Pairs = [P|More],
  344        slice_pairs(T0, PL, More)
  345    ;   D == (<)
  346    ->  slice_pairs(T0, [P|PL], Pairs)
  347    ;   slice_pairs([H|T0], PL, Pairs)
  348    ).
 dicts_to_compounds(?Dicts, +Keys, :OnEmpty, ?Compounds) is semidet
True when Dicts and Compounds are lists of the same length and each element of Compounds is a compound term whose arguments represent the values associated with the corresponding keys in Keys. When converting from dict to row, OnEmpty is used to compute missing values. The functor for the compound is the same as the tag of the pair. When converting from dict to row and the dict has no tag, the functor row is used. For example:
?- Dicts = [_{x:1}, _{x:2, y:3}],
   dicts_to_compounds(Dicts, [x], dict_fill(null), Compounds).
Compounds = [row(1), row(2)].
?- Dicts = [_{x:1}, _{x:2, y:3}],
   dicts_to_compounds(Dicts, [x,y], dict_fill(null), Compounds).
Compounds = [row(1, null), row(2, 3)].
?- Compounds = [point(1,1), point(2,4)],
   dicts_to_compounds(Dicts, [x,y], dict_fill(null), Compounds).
Dicts = [point{x:1, y:1}, point{x:2, y:4}].

When converting from Dicts to Compounds Keys may be computed by dicts_same_keys/2.

  375dicts_to_compounds(Dicts, Keys, OnEmpty, Compounds) :-
  376    maplist(dict_to_compound(Keys, OnEmpty), Dicts, Compounds).
  377
  378dict_to_compound(Keys, OnEmpty, Dict, Row) :-
  379    is_dict(Dict, Tag),
  380    !,
  381    default_tag(Tag, row),
  382    maplist(key_value(Dict, OnEmpty), Keys, Values),
  383    compound_name_arguments(Row, Tag, Values).
  384dict_to_compound(Keys, _, Dict, Row) :-
  385    compound(Row),
  386    compound_name_arguments(Row, Tag, Values),
  387    pairs_keys_values(Pairs, Keys, Values),
  388    dict_pairs(Dict, Tag, Pairs).
  389
  390default_tag(Tag, Tag) :- !.
  391default_tag(_, _).
  392
  393key_value(Dict, OnEmpty, Key, Value) :-
  394    (   get_dict(Key, Dict, Value0)
  395    ->  Value = Value0
  396    ;   call(OnEmpty, Key, Dict, Value)
  397    )