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-2017, 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 reduced/1, % :Goal 39 reduced/3, % ?Witness, :Goal, +Options 40 limit/2, % +Limit, :Goal 41 offset/2, % +Offset, :Goal 42 call_nth/2, % :Goal, ?Nth 43 order_by/2, % +Spec, :Goal 44 group_by/4 % +By, +Template, :Goal, -Bag 45 ]). 46:- use_module(library(nb_set)). 47:- use_module(library(error)). 48:- use_module(library(apply)). 49:- use_module(library(lists)). 50:- use_module(library(ordsets)). 51:- use_module(library(option)). 52 53/** <module> Modify solution sequences 54 55The meta predicates of this library modify the sequence of solutions of 56a goal. The modifications and the predicate names are based on the 57classical database operations DISTINCT, LIMIT, OFFSET, ORDER BY and 58GROUP BY. 59 60These predicates were introduced in the context of the 61[SWISH](http://swish.swi-prolog.org) Prolog browser-based shell, which 62can represent the solutions to a predicate as a table. Notably wrapping 63a goal in distinct/1 avoids duplicates in the result table and using 64order_by/2 produces a nicely ordered table. 65 66However, the predicates from this library can also be used to stay 67longer within the clean paradigm where non-deterministic predicates are 68composed from simpler non-deterministic predicates by means of 69conjunction and disjunction. While evaluating a conjunction, we might 70want to eliminate duplicates of the first part of the conjunction. Below 71we give both the classical solution for solving variations of (a(X), 72b(X)) and the ones using this library side-by-side. 73 74 $ Avoid duplicates of earlier steps : 75 76 == 77 setof(X, a(X), Xs), distinct(a(X)), 78 member(X, Xs), b(X) 79 b(X). 80 == 81 82 Note that the distinct/1 based solution returns the first result 83 of distinct(a(X)) immediately after a/1 produces a result, while 84 the setof/3 based solution will first compute all results of a/1. 85 86 $ Only try b(X) only for the top-10 a(X) : 87 88 == 89 setof(X, a(X), Xs), limit(10, order_by([desc(X)], a(X))), 90 reverse(Xs, Desc), b(X) 91 first_max_n(10, Desc, Limit), 92 member(X, Limit), 93 b(X) 94 == 95 96 Here we see power of composing primitives from this library and 97 staying within the paradigm of pure non-deterministic relational 98 predicates. 99 100@see all solution predicates findall/3, bagof/3 and setof/3. 101@see library(aggregate) 102*/ 103 104:- meta_predicate 105 distinct( ), 106 distinct( , ), 107 reduced( ), 108 reduced( , , ), 109 limit( , ), 110 offset( , ), 111 call_nth( , ), 112 order_by( , ), 113 group_by( , , , ). 114 115:- noprofile(( 116 distinct/1, 117 distinct/2, 118 reduced/1, 119 reduced/2, 120 limit/2, 121 offset/2, 122 call_nth/2, 123 order_by/2, 124 group_by/3)). 125 126 127%! distinct(:Goal). 128%! distinct(?Witness, :Goal). 129% 130% True if Goal is true and no previous solution of Goal bound 131% Witness to the same value. As previous answers need to be 132% copied, equivalence testing is based on _term variance_ (=@=/2). 133% The variant distinct/1 is equivalent to distinct(Goal,Goal). 134% 135% If the answers are ground terms, the predicate behaves as the 136% code below, but answers are returned as soon as they become 137% available rather than first computing the complete answer set. 138% 139% == 140% distinct(Goal) :- 141% findall(Goal, Goal, List), 142% list_to_set(List, Set), 143% member(Goal, Set). 144% == 145 146distinct(Goal) :- 147 distinct(Goal, Goal). 148distinct(Witness, Goal) :- 149 term_variables(Witness, Vars), 150 Witness1 =.. [v|Vars], 151 empty_nb_set(Set), 152 call(Goal), 153 add_nb_set(Witness1, Set, true). 154 155%! reduced(:Goal). 156%! reduced(?Witness, :Goal, +Options). 157% 158% Similar to distinct/1, but does not guarantee unique results in 159% return for using a limited amount of memory. Both distinct/1 and 160% reduced/1 create a table that block duplicate results. For 161% distinct/1, this table may get arbitrary large. In contrast, 162% reduced/1 discards the table and starts a new one of the table size 163% exceeds a specified limit. This filter is useful for reducing the 164% number of answers when processing large or infinite long tail 165% distributions. Options: 166% 167% - size_limit(+Integer) 168% Max number of elements kept in the table. Default is 10,000. 169 170reduced(Goal) :- 171 reduced(Goal, Goal, []). 172reduced(Witness, Goal, Options) :- 173 option(size_limit(SizeLimit), Options, 10_000), 174 term_variables(Witness, Vars), 175 Witness1 =.. [v|Vars], 176 empty_nb_set(Set), 177 State = state(Set), 178 call(Goal), 179 reduced_(State, Witness1, SizeLimit). 180 181reduced_(State, Witness1, SizeLimit) :- 182 arg(1, State, Set), 183 add_nb_set(Witness1, Set, true), 184 size_nb_set(Set, Size), 185 ( Size > SizeLimit 186 -> empty_nb_set(New), 187 nb_setarg(1, State, New) 188 ; true 189 ). 190 191 192%! limit(+Count, :Goal) 193% 194% Limit the number of solutions. True if Goal is true, returning 195% at most Count solutions. Solutions are returned as soon as they 196% become available. 197 198limit(Count, Goal) :- 199 Count > 0, 200 State = count(0), 201 call(Goal), 202 arg(1, State, N0), 203 N is N0+1, 204 ( N =:= Count 205 -> ! 206 ; nb_setarg(1, State, N) 207 ). 208 209%! offset(+Count, :Goal) 210% 211% Ignore the first Count solutions. True if Goal is true and 212% produces more than Count solutions. This predicate computes and 213% ignores the first Count solutions. 214 215offset(Count, Goal) :- 216 Count > 0, 217 !, 218 State = count(0), 219 call(Goal), 220 arg(1, State, N0), 221 ( N0 >= Count 222 -> true 223 ; N is N0+1, 224 nb_setarg(1, State, N), 225 fail 226 ). 227offset(Count, Goal) :- 228 Count =:= 0, 229 !, 230 call(Goal). 231offset(Count, _) :- 232 domain_error(not_less_than_zero, Count). 233 234%! call_nth(:Goal, ?Nth) 235% 236% True when Goal succeeded for the Nth time. If Nth is bound on entry, 237% the predicate succeeds deterministically if there are at least Nth 238% solutions for Goal. 239 240call_nth(Goal, Nth) :- 241 integer(Nth), 242 !, 243 ( Nth > 0 244 -> ( call_nth(Goal, Sofar), 245 Sofar =:= Nth 246 -> true 247 ) 248 ; domain_error(not_less_than_one, Nth) 249 ). 250call_nth(Goal, Nth) :- 251 var(Nth), 252 !, 253 State = count(0), 254 call(Goal), 255 arg(1, State, N0), 256 Nth is N0+1, 257 nb_setarg(1, State, Nth). 258call_nth(_Goal, Bad) :- 259 must_be(integer, Bad). 260 261%! order_by(+Spec, :Goal) 262% 263% Order solutions according to Spec. Spec is a list of terms, 264% where each element is one of. The ordering of solutions of Goal 265% that only differ in variables that are _not_ shared with Spec is 266% not changed. 267% 268% - asc(Term) 269% Order solution according to ascending Term 270% - desc(Term) 271% Order solution according to descending Term 272 273order_by(Spec, Goal) :- 274 must_be(list, Spec), 275 non_empty_list(Spec), 276 maplist(order_witness, Spec, Witnesses0), 277 join_orders(Witnesses0, Witnesses), 278 non_witness_template(Goal, Witnesses, Others), 279 reverse(Witnesses, RevWitnesses), 280 maplist(x_vars, RevWitnesses, WitnessVars), 281 Template =.. [v,Others|WitnessVars], 282 findall(Template, Goal, Results), 283 order(RevWitnesses, 2, Results, OrderedResults), 284 member(Template, OrderedResults). 285 286order([], _, Results, Results). 287order([H|T], N, Results0, Results) :- 288 order1(H, N, Results0, Results1), 289 N2 is N + 1, 290 order(T, N2, Results1, Results). 291 292order1(asc(_), N, Results0, Results) :- 293 sort(N, @=<, Results0, Results). 294order1(desc(_), N, Results0, Results) :- 295 sort(N, @>=, Results0, Results). 296 297non_empty_list([]) :- 298 !, 299 domain_error(non_empty_list, []). 300non_empty_list(_). 301 302order_witness(Var, _) :- 303 var(Var), 304 !, 305 instantiation_error(Var). 306order_witness(asc(Term), asc(Witness)) :- 307 !, 308 witness(Term, Witness). 309order_witness(desc(Term), desc(Witness)) :- 310 !, 311 witness(Term, Witness). 312order_witness(Term, _) :- 313 domain_error(order_specifier, Term). 314 315x_vars(asc(Vars), Vars). 316x_vars(desc(Vars), Vars). 317 318witness(Term, Witness) :- 319 term_variables(Term, Vars), 320 Witness =.. [v|Vars]. 321 322%! join_orders(+SpecIn, -SpecOut) is det. 323% 324% Merge subsequent asc and desc sequences. For example, 325% [asc(v(A)), asc(v(B))] becomes [asc(v(A,B))]. 326 327join_orders([], []). 328join_orders([asc(O1)|T0], [asc(O)|T]) :- 329 !, 330 ascs(T0, OL, T1), 331 join_witnesses(O1, OL, O), 332 join_orders(T1, T). 333join_orders([desc(O1)|T0], [desc(O)|T]) :- 334 !, 335 descs(T0, OL, T1), 336 join_witnesses(O1, OL, O), 337 join_orders(T1, T). 338 339ascs([asc(A)|T0], [A|AL], T) :- 340 !, 341 ascs(T0, AL, T). 342ascs(L, [], L). 343 344descs([desc(A)|T0], [A|AL], T) :- 345 !, 346 descs(T0, AL, T). 347descs(L, [], L). 348 349join_witnesses(O, [], O) :- !. 350join_witnesses(O, OL, R) :- 351 term_variables([O|OL], VL), 352 R =.. [v|VL]. 353 354%! non_witness_template(+Goal, +Witness, -Template) is det. 355% 356% Create a template for the bindings that are not part of the 357% witness variables. 358 359non_witness_template(Goal, Witness, Template) :- 360 ordered_term_variables(Goal, AllVars), 361 ordered_term_variables(Witness, WitnessVars), 362 ord_subtract(AllVars, WitnessVars, TemplateVars), 363 Template =.. [t|TemplateVars]. 364 365ordered_term_variables(Term, Vars) :- 366 term_variables(Term, Vars0), 367 sort(Vars0, Vars). 368 369%! group_by(+By, +Template, :Goal, -Bag) is nondet. 370% 371% Group bindings of Template that have the same value for By. This 372% predicate is almost the same as bagof/3, but instead of 373% specifying the existential variables we specify the free 374% variables. It is provided for consistency and complete coverage 375% of the common database vocabulary. 376 377group_by(By, Template, Goal, Bag) :- 378 ordered_term_variables(Goal, GVars), 379 ordered_term_variables(By+Template, UVars), 380 ord_subtract(GVars, UVars, ExVars), 381 bagof(Template, ExVars^, Bag)