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