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, VU University Amsterdam
   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(solution_sequences,
  36          [ distinct/1,                 % :Goal
  37            distinct/2,                 % ?Witness, :Goal
  38            limit/2,                    % +Limit, :Goal
  39            offset/2,                   % +Offset, :Goal
  40            order_by/2,                 % +Spec, :Goal
  41            group_by/4                  % +By, +Template, :Goal, -Bag
  42          ]).
  43:- use_module(library(nb_set)).
  44:- use_module(library(error)).
  45:- use_module(library(apply)).
  46:- use_module(library(lists)).
  47:- use_module(library(ordsets)).
  48
  49/** <module> Modify solution sequences
  50
  51The meta predicates of this library modify  the sequence of solutions of
  52a goal. The modifications and  the  predicate   names  are  based on the
  53classical database operations DISTINCT,  LIMIT,   OFFSET,  ORDER  BY and
  54GROUP BY.
  55
  56These   predicates   were   introduced   in     the   context   of   the
  57[SWISH](http://swish.swi-prolog.org) Prolog browser-based   shell, which
  58can represent the solutions to a predicate  as a table. Notably wrapping
  59a goal in distinct/1 avoids duplicates  in   the  result table and using
  60order_by/2 produces a nicely ordered table.
  61
  62However, the predicates from this  library  can   also  be  used to stay
  63longer within the clean paradigm  where non-deterministic predicates are
  64composed  from  simpler  non-deterministic  predicates    by   means  of
  65conjunction and disjunction. While evaluating   a  conjunction, we might
  66want to eliminate duplicates of the first part of the conjunction. Below
  67we give both the classical  solution   for  solving variations of (a(X),
  68b(X)) and the ones using this library side-by-side.
  69
  70  $ Avoid duplicates of earlier steps :
  71
  72    ==
  73      setof(X, a(X), Xs),               distinct(a(X)),
  74      member(X, Xs),                    b(X)
  75      b(X).
  76    ==
  77
  78    Note that the distinct/1 based solution returns the first result
  79    of distinct(a(X)) immediately after a/1 produces a result, while
  80    the setof/3 based solution will first compute all results of a/1.
  81
  82  $ Only try b(X) only for the top-10 a(X) :
  83
  84    ==
  85      setof(X, a(X), Xs),               limit(10, order_by([desc(X)], a(X))),
  86      reverse(Xs, Desc),                b(X)
  87      first_max_n(10, Desc, Limit),
  88      member(X, Limit),
  89      b(X)
  90    ==
  91
  92    Here we see power of composing primitives from this library and
  93    staying within the paradigm of pure non-deterministic relational
  94    predicates.
  95
  96@see all solution predicates findall/3, bagof/3 and setof/3.
  97@see library(aggregate)
  98*/
  99
 100:- meta_predicate
 101    distinct(0),
 102    distinct(?, 0),
 103    limit(+, 0),
 104    offset(+, 0),
 105    order_by(+, 0),
 106    group_by(?, ?, 0, -).
 107
 108%!  distinct(:Goal).
 109%!  distinct(?Witness, :Goal).
 110%
 111%   True if Goal is true and  no   previous  solution  of Goal bound
 112%   Witness to the same  value.  As   previous  answers  need  to be
 113%   copied, equivalence testing is based on _term variance_ (=@=/2).
 114%   The variant distinct/1 is equivalent to distinct(Goal,Goal).
 115%
 116%   If the answers are ground terms,   the  predicate behaves as the
 117%   code below, but answers are  returned   as  soon  as they become
 118%   available rather than first computing the complete answer set.
 119%
 120%     ==
 121%     distinct(Goal) :-
 122%         findall(Goal, Goal, List),
 123%         list_to_set(List, Set),
 124%         member(Goal, Set).
 125%     ==
 126
 127distinct(Goal) :-
 128    distinct(Goal, Goal).
 129distinct(Witness, Goal) :-
 130    term_variables(Witness, Vars),
 131    Witness1 =.. [v|Vars],
 132    empty_nb_set(Set),
 133    call(Goal),
 134    add_nb_set(Witness1, Set, true).
 135
 136%!  limit(+Count, :Goal)
 137%
 138%   Limit the number of solutions. True   if Goal is true, returning
 139%   at most Count solutions. Solutions are  returned as soon as they
 140%   become  available.
 141
 142limit(Count, Goal) :-
 143    Count > 0,
 144    State = count(0),
 145    call(Goal),
 146    arg(1, State, N0),
 147    N is N0+1,
 148    (   N =:= Count
 149    ->  !
 150    ;   nb_setarg(1, State, N)
 151    ).
 152
 153%!  offset(+Count, :Goal)
 154%
 155%   Ignore the first Count  solutions.  True   if  Goal  is true and
 156%   produces more than Count solutions.  This predicate computes and
 157%   ignores the first Count solutions.
 158
 159offset(Count, Goal) :-
 160    Count > 0,
 161    !,
 162    State = count(0),
 163    call(Goal),
 164    arg(1, State, N0),
 165    (   N0 >= Count
 166    ->  true
 167    ;   N is N0+1,
 168        nb_setarg(1, State, N),
 169        fail
 170    ).
 171offset(Count, Goal) :-
 172    Count =:= 0,
 173    !,
 174    call(Goal).
 175offset(Count, _) :-
 176    domain_error(not_less_than_zero, Count).
 177
 178%!  order_by(Spec, Goal)
 179%
 180%   Order solutions according to Spec.  Spec   is  a  list of terms,
 181%   where each element is one of. The  ordering of solutions of Goal
 182%   that only differ in variables that are _not_ shared with Spec is
 183%   not changed.
 184%
 185%     - asc(Term)
 186%     Order solution according to ascending Term
 187%     - desc(Term)
 188%     Order solution according to descending Term
 189
 190order_by(Spec, Goal) :-
 191    must_be(list, Spec),
 192    non_empty_list(Spec),
 193    maplist(order_witness, Spec, Witnesses0),
 194    join_orders(Witnesses0, Witnesses),
 195    non_witness_template(Goal, Witnesses, Others),
 196    reverse(Witnesses, RevWitnesses),
 197    maplist(x_vars, RevWitnesses, WitnessVars),
 198    Template =.. [v,Others|WitnessVars],
 199    findall(Template, Goal, Results),
 200    order(RevWitnesses, 2, Results, OrderedResults),
 201    member(Template, OrderedResults).
 202
 203order([], _, Results, Results).
 204order([H|T], N, Results0, Results) :-
 205    order1(H, N, Results0, Results1),
 206    N2 is N + 1,
 207    order(T, N2, Results1, Results).
 208
 209order1(asc(_), N, Results0, Results) :-
 210    sort(N, @=<, Results0, Results).
 211order1(desc(_), N, Results0, Results) :-
 212    sort(N, @>=, Results0, Results).
 213
 214non_empty_list([]) :-
 215    !,
 216    domain_error(non_empty_list, []).
 217non_empty_list(_).
 218
 219order_witness(Var, _) :-
 220    var(Var),
 221    !,
 222    instantiation_error(Var).
 223order_witness(asc(Term), asc(Witness)) :-
 224    !,
 225    witness(Term, Witness).
 226order_witness(desc(Term), desc(Witness)) :-
 227    !,
 228    witness(Term, Witness).
 229order_witness(Term, _) :-
 230    domain_error(order_specifier, Term).
 231
 232x_vars(asc(Vars), Vars).
 233x_vars(desc(Vars), Vars).
 234
 235witness(Term, Witness) :-
 236    term_variables(Term, Vars),
 237    Witness =.. [v|Vars].
 238
 239%!  join_orders(+SpecIn, -SpecOut) is det.
 240%
 241%   Merge  subsequent  asc  and   desc    sequences.   For  example,
 242%   [asc(v(A)), asc(v(B))] becomes [asc(v(A,B))].
 243
 244join_orders([], []).
 245join_orders([asc(O1)|T0], [asc(O)|T]) :-
 246    !,
 247    ascs(T0, OL, T1),
 248    join_witnesses(O1, OL, O),
 249    join_orders(T1, T).
 250join_orders([desc(O1)|T0], [desc(O)|T]) :-
 251    !,
 252    descs(T0, OL, T1),
 253    join_witnesses(O1, OL, O),
 254    join_orders(T1, T).
 255
 256ascs([asc(A)|T0], [A|AL], T) :-
 257    !,
 258    ascs(T0, AL, T).
 259ascs(L, [], L).
 260
 261descs([desc(A)|T0], [A|AL], T) :-
 262    !,
 263    descs(T0, AL, T).
 264descs(L, [], L).
 265
 266join_witnesses(O, [], O) :- !.
 267join_witnesses(O, OL, R) :-
 268    term_variables([O|OL], VL),
 269    R =.. [v|VL].
 270
 271%!  non_witness_template(+Goal, +Witness, -Template) is det.
 272%
 273%   Create a template for the bindings  that   are  not  part of the
 274%   witness variables.
 275
 276non_witness_template(Goal, Witness, Template) :-
 277    ordered_term_variables(Goal, AllVars),
 278    ordered_term_variables(Witness, WitnessVars),
 279    ord_subtract(AllVars, WitnessVars, TemplateVars),
 280    Template =.. [t|TemplateVars].
 281
 282ordered_term_variables(Term, Vars) :-
 283    term_variables(Term, Vars0),
 284    sort(Vars0, Vars).
 285
 286%!  group_by(+By, +Template, :Goal, -Bag) is nondet.
 287%
 288%   Group bindings of Template that have the same value for By. This
 289%   predicate  is  almost  the  same  as  bagof/3,  but  instead  of
 290%   specifying  the  existential  variables  we   specify  the  free
 291%   variables. It is provided for  consistency and complete coverage
 292%   of the common database vocabulary.
 293
 294group_by(By, Template, Goal, Bag) :-
 295    ordered_term_variables(Goal, GVars),
 296    ordered_term_variables(By+Template, UVars),
 297    ord_subtract(GVars, UVars, ExVars),
 298    bagof(Template, ExVars^Goal, Bag).