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)).
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)).
distinct(Goal,Goal)
.
If the answers are ground terms, the predicate behaves as the code below, but answers are returned as soon as they become available rather than first computing the complete answer set.
distinct(Goal) :- findall(Goal, Goal, List), list_to_set(List, Set), member(Goal, Set).
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).
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 ).
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 ).
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).
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).
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].
asc(v(A))
, asc(v(B))
] becomes [asc(v(A,B))
].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].
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).
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)
Modify solution sequences
The meta predicates of this library modify the sequence of solutions of a goal. The modifications and the predicate names are based on the classical database operations DISTINCT, LIMIT, OFFSET, ORDER BY and GROUP BY.
These predicates were introduced in the context of the SWISH Prolog browser-based shell, which can represent the solutions to a predicate as a table. Notably wrapping a goal in distinct/1 avoids duplicates in the result table and using order_by/2 produces a nicely ordered table.
However, the predicates from this library can also be used to stay longer within the clean paradigm where non-deterministic predicates are composed from simpler non-deterministic predicates by means of conjunction and disjunction. While evaluating a conjunction, we might want to eliminate duplicates of the first part of the conjunction. Below we give both the classical solution for solving variations of (
a(X)
,b(X)
) and the ones using this library side-by-side.Note that the distinct/1 based solution returns the first result of
distinct(a(X))
immediately after a/1 produces a result, while the setof/3 based solution will first compute all results of a/1.b(X)
only for the top-10a(X)
Here we see power of composing primitives from this library and staying within the paradigm of pure non-deterministic relational predicates.
library(aggregate)
*/