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) 2008-2020, University of Amsterdam 7 VU University Amsterdam 8 CWI Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(aggregate, 38 [ foreach/2, % :Generator, :Goal 39 aggregate/3, % +Templ, :Goal, -Result 40 aggregate/4, % +Templ, +Discrim, :Goal, -Result 41 aggregate_all/3, % +Templ, :Goal, -Result 42 aggregate_all/4, % +Templ, +Discrim, :Goal, -Result 43 free_variables/4 % :Generator, :Template, +Vars0, -Vars 44 ]). 45:- autoload(library(apply),[maplist/4,maplist/5]). 46:- autoload(library(error), 47 [instantiation_error/1,type_error/2,domain_error/2]). 48:- autoload(library(lists), 49 [append/3,member/2,sum_list/2,max_list/2,min_list/2]). 50:- autoload(library(ordsets),[ord_subtract/3,ord_intersection/3]). 51:- autoload(library(pairs),[pairs_values/2]). 52 53:- set_prolog_flag(generate_debug_info, false). 54 55:- meta_predicate 56 foreach(,), 57 aggregate(,,), 58 aggregate(,,,), 59 aggregate_all(,,), 60 aggregate_all(,,,).
143 /******************************* 144 * AGGREGATE * 145 *******************************/
152aggregate(Template, Goal0, Result) :-
153 template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate),
154 bagof(Pattern, Goal, List),
155 aggregate_list(Aggregate, List, Result).
162aggregate(Template, Discriminator, Goal0, Result) :-
163 template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate),
164 setof(Discriminator-Pattern, Goal, Pairs),
165 pairs_values(Pairs, List),
166 aggregate_list(Aggregate, List, Result).min(X), max(X),
min(X,Witness) or max(X,Witness) and Goal has no solutions, i.e.,
the minimum and maximum of an empty set is undefined.
The Template values count, sum(X), max(X), min(X), max(X,W) and
min(X,W) are processed incrementally rather than using findall/3 and
run in constant memory.
180aggregate_all(Var, _, _) :- 181 var(Var), 182 !, 183 instantiation_error(Var). 184aggregate_all(count, Goal, Count) :- 185 !, 186 aggregate_all(sum(1), Goal, Count). 187aggregate_all(sum(X), Goal, Sum) :- 188 !, 189 State = state(0), 190 ( call(Goal), 191 arg(1, State, S0), 192 S is S0 + X, 193 nb_setarg(1, State, S), 194 fail 195 ; arg(1, State, Sum) 196 ). 197aggregate_all(max(X), Goal, Max) :- 198 !, 199 State = state(X), 200 ( call(Goal), 201 arg(1, State, M0), 202 M is max(M0,X), 203 nb_setarg(1, State, M), 204 fail 205 ; arg(1, State, Max), 206 nonvar(Max) 207 ). 208aggregate_all(min(X), Goal, Min) :- 209 !, 210 State = state(X), 211 ( call(Goal), 212 arg(1, State, M0), 213 M is min(M0,X), 214 nb_setarg(1, State, M), 215 fail 216 ; arg(1, State, Min), 217 nonvar(Min) 218 ). 219aggregate_all(max(X,W), Goal, max(Max,Witness)) :- 220 !, 221 State = state(false, _Max, _Witness), 222 ( call(Goal), 223 ( State = state(true, Max0, _) 224 -> X > Max0, 225 nb_setarg(2, State, X), 226 nb_setarg(3, State, W) 227 ; number(X) 228 -> nb_setarg(1, State, true), 229 nb_setarg(2, State, X), 230 nb_setarg(3, State, W) 231 ; type_error(number, X) 232 ), 233 fail 234 ; State = state(true, Max, Witness) 235 ). 236aggregate_all(min(X,W), Goal, min(Min,Witness)) :- 237 !, 238 State = state(false, _Min, _Witness), 239 ( call(Goal), 240 ( State = state(true, Min0, _) 241 -> X < Min0, 242 nb_setarg(2, State, X), 243 nb_setarg(3, State, W) 244 ; number(X) 245 -> nb_setarg(1, State, true), 246 nb_setarg(2, State, X), 247 nb_setarg(3, State, W) 248 ; type_error(number, X) 249 ), 250 fail 251 ; State = state(true, Min, Witness) 252 ). 253aggregate_all(Template, Goal0, Result) :- 254 template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate), 255 findall(Pattern, Goal, List), 256 aggregate_list(Aggregate, List, Result).
265aggregate_all(Template, Discriminator, Goal0, Result) :- 266 template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate), 267 findall(Discriminator-Pattern, Goal, Pairs0), 268 sort(Pairs0, Pairs), 269 pairs_values(Pairs, List), 270 aggregate_list(Aggregate, List, Result). 271 272template_to_pattern(All, Template, Pattern, Goal0, Goal, Aggregate) :- 273 template_to_pattern(Template, Pattern, Post, Vars, Aggregate), 274 existential_vars(Goal0, Goal1, AllVars, Vars), 275 clean_body((Goal1, Post), Goal2), 276 ( All == bag 277 -> add_existential_vars(AllVars, Goal2, Goal) 278 ; Goal = Goal2 279 ). 280 281existential_vars(Var, Var) --> 282 { var(Var) }, 283 !. 284existential_vars(Var^G0, G) --> 285 !, 286 [Var], 287 existential_vars(G0, G). 288existential_vars(M:G0, M:G) --> 289 !, 290 existential_vars(G0, G). 291existential_vars(G, G) --> 292 []. 293 294add_existential_vars([], G, G). 295add_existential_vars([H|T], G0, H^G1) :- 296 add_existential_vars(T, G0, G1).
true from Goal0.303clean_body((Goal0,Goal1), Goal) :- 304 !, 305 clean_body(Goal0, GoalA), 306 clean_body(Goal1, GoalB), 307 ( GoalA == true 308 -> Goal = GoalB 309 ; GoalB == true 310 -> Goal = GoalA 311 ; Goal = (GoalA,GoalB) 312 ). 313clean_body(Goal, Goal).
327template_to_pattern(Term, Pattern, Goal, Vars, Aggregate) :- 328 templ_to_pattern(Term, Pattern, Goal, Vars, Aggregate), 329 !. 330template_to_pattern(Term, Pattern, Goal, Vars, term(MinNeeded, Functor, AggregateArgs)) :- 331 compound(Term), 332 !, 333 Term =.. [Functor|Args0], 334 templates_to_patterns(Args0, Args, Goal, Vars, AggregateArgs), 335 needs_one(AggregateArgs, MinNeeded), 336 Pattern =.. [Functor|Args]. 337template_to_pattern(Term, _, _, _, _) :- 338 invalid_template(Term). 339 340templ_to_pattern(sum(X), X, true, [], sum) :- var(X), !. 341templ_to_pattern(sum(X0), X, X is X0, [X0], sum) :- !. 342templ_to_pattern(count, 1, true, [], count) :- !. 343templ_to_pattern(min(X), X, true, [], min) :- var(X), !. 344templ_to_pattern(min(X0), X, X is X0, [X0], min) :- !. 345templ_to_pattern(min(X0, Witness), X-Witness, X is X0, [X0], min_witness) :- !. 346templ_to_pattern(max(X0), X, X is X0, [X0], max) :- !. 347templ_to_pattern(max(X0, Witness), X-Witness, X is X0, [X0], max_witness) :- !. 348templ_to_pattern(set(X), X, true, [], set) :- !. 349templ_to_pattern(bag(X), X, true, [], bag) :- !. 350 351templates_to_patterns([], [], true, [], []). 352templates_to_patterns([H0], [H], G, Vars, [A]) :- 353 !, 354 sub_template_to_pattern(H0, H, G, Vars, A). 355templates_to_patterns([H0|T0], [H|T], (G0,G), Vars, [A0|A]) :- 356 sub_template_to_pattern(H0, H, G0, V0, A0), 357 append(V0, RV, Vars), 358 templates_to_patterns(T0, T, G, RV, A). 359 360sub_template_to_pattern(Term, Pattern, Goal, Vars, Aggregate) :- 361 templ_to_pattern(Term, Pattern, Goal, Vars, Aggregate), 362 !. 363sub_template_to_pattern(Term, _, _, _, _) :- 364 invalid_template(Term). 365 366invalid_template(Term) :- 367 callable(Term), 368 !, 369 domain_error(aggregate_template, Term). 370invalid_template(Term) :- 371 type_error(aggregate_template, Term).
378needs_one(Ops, 1) :- 379 member(Op, Ops), 380 needs_one(Op), 381 !. 382needs_one(_, 0). 383 384needs_one(min). 385needs_one(min_witness). 386needs_one(max). 387needs_one(max_witness).
399aggregate_list(bag, List0, List) :- 400 !, 401 List = List0. 402aggregate_list(set, List, Set) :- 403 !, 404 sort(List, Set). 405aggregate_list(sum, List, Sum) :- 406 sum_list(List, Sum). 407aggregate_list(count, List, Count) :- 408 length(List, Count). 409aggregate_list(max, List, Sum) :- 410 max_list(List, Sum). 411aggregate_list(max_witness, List, max(Max, Witness)) :- 412 max_pair(List, Max, Witness). 413aggregate_list(min, List, Sum) :- 414 min_list(List, Sum). 415aggregate_list(min_witness, List, min(Min, Witness)) :- 416 min_pair(List, Min, Witness). 417aggregate_list(term(0, Functor, Ops), List, Result) :- 418 !, 419 maplist(state0, Ops, StateArgs, FinishArgs), 420 State0 =.. [Functor|StateArgs], 421 aggregate_term_list(List, Ops, State0, Result0), 422 finish_result(Ops, FinishArgs, Result0, Result). 423aggregate_list(term(1, Functor, Ops), [H|List], Result) :- 424 H =.. [Functor|Args], 425 maplist(state1, Ops, Args, StateArgs, FinishArgs), 426 State0 =.. [Functor|StateArgs], 427 aggregate_term_list(List, Ops, State0, Result0), 428 finish_result(Ops, FinishArgs, Result0, Result). 429 430aggregate_term_list([], _, State, State). 431aggregate_term_list([H|T], Ops, State0, State) :- 432 step_term(Ops, H, State0, State1), 433 aggregate_term_list(T, Ops, State1, State).
443min_pair([M0-W0|T], M, W) :- 444 min_pair(T, M0, W0, M, W). 445 446min_pair([], M, W, M, W). 447min_pair([M0-W0|T], M1, W1, M, W) :- 448 ( M0 < M1 449 -> min_pair(T, M0, W0, M, W) 450 ; min_pair(T, M1, W1, M, W) 451 ). 452 453max_pair([M0-W0|T], M, W) :- 454 max_pair(T, M0, W0, M, W). 455 456max_pair([], M, W, M, W). 457max_pair([M0-W0|T], M1, W1, M, W) :- 458 ( M0 > M1 459 -> max_pair(T, M0, W0, M, W) 460 ; max_pair(T, M1, W1, M, W) 461 ).
465step(bag, X, [X|L], L). 466step(set, X, [X|L], L). 467step(count, _, X0, X1) :- 468 succ(X0, X1). 469step(sum, X, X0, X1) :- 470 X1 is X0+X. 471step(max, X, X0, X1) :- 472 X1 is max(X0, X). 473step(min, X, X0, X1) :- 474 X1 is min(X0, X). 475step(max_witness, X-W, X0-W0, X1-W1) :- 476 ( X > X0 477 -> X1 = X, W1 = W 478 ; X1 = X0, W1 = W0 479 ). 480step(min_witness, X-W, X0-W0, X1-W1) :- 481 ( X < X0 482 -> X1 = X, W1 = W 483 ; X1 = X0, W1 = W0 484 ). 485step(term(Ops), Row, Row0, Row1) :- 486 step_term(Ops, Row, Row0, Row1). 487 488step_term(Ops, Row, Row0, Row1) :- 489 functor(Row, Name, Arity), 490 functor(Row1, Name, Arity), 491 step_list(Ops, 1, Row, Row0, Row1). 492 493step_list([], _, _, _, _). 494step_list([Op|OpT], Arg, Row, Row0, Row1) :- 495 arg(Arg, Row, X), 496 arg(Arg, Row0, X0), 497 arg(Arg, Row1, X1), 498 step(Op, X, X0, X1), 499 succ(Arg, Arg1), 500 step_list(OpT, Arg1, Row, Row0, Row1). 501 502finish_result(Ops, Finish, R0, R) :- 503 functor(R0, Functor, Arity), 504 functor(R, Functor, Arity), 505 finish_result(Ops, Finish, 1, R0, R). 506 507finish_result([], _, _, _, _). 508finish_result([Op|OpT], [F|FT], I, R0, R) :- 509 arg(I, R0, A0), 510 arg(I, R, A), 511 finish_result1(Op, F, A0, A), 512 succ(I, I2), 513 finish_result(OpT, FT, I2, R0, R). 514 515finish_result1(bag, Bag0, [], Bag) :- 516 !, 517 Bag = Bag0. 518finish_result1(set, Bag, [], Set) :- 519 !, 520 sort(Bag, Set). 521finish_result1(max_witness, _, M-W, R) :- 522 !, 523 R = max(M,W). 524finish_result1(min_witness, _, M-W, R) :- 525 !, 526 R = min(M,W). 527finish_result1(_, _, A, A).
531state0(bag, L, L). 532state0(set, L, L). 533state0(count, 0, _). 534state0(sum, 0, _).
538state1(bag, X, L, [X|L]) :- !. 539state1(set, X, L, [X|L]) :- !. 540state1(_, X, X, _). 541 542 543 /******************************* 544 * FOREACH * 545 *******************************/
foreach(Generator, Goal) :-
findall(Goal, Generator, Goals),
maplist(call, Goals).
The actual implementation uses findall/3 on a template created from the variables shared between Generator and Goal. Subsequently, it uses every instance of this template to instantiate Goal, call Goal and undo only the instantiation of the template and not other instantiations created by running Goal. Here is an example:
?- foreach(between(1,4,X), dif(X,Y)), Y = 5. Y = 5. ?- foreach(between(1,4,X), dif(X,Y)), Y = 3. false.
The predicate foreach/2 is mostly used if Goal performs backtrackable destructive assignment on terms. Attributed variables (underlying constraints) are an example. Another example of a backtrackable data structure is in library(hashtable). If we care only about the side effects (I/O, dynamic database, etc.) or the truth value of Goal, forall/2 is a faster and simpler alternative. If Goal instantiates its arguments it is will often fail as the argument cannot be instantiated to multiple values. It is possible to incrementally grow an argument:
?- foreach(between(1,4,X), member(X, L)). L = [1,2,3,4|_].
Note that SWI-Prolog up to version 8.3.4 created copies of Goal using copy_term/2 for each iteration.
590foreach(Generator, Goal) :- 591 term_variables(Generator, GenVars0), sort(GenVars0, GenVars), 592 term_variables(Goal, GoalVars0), sort(GoalVars0, GoalVars), 593 ord_intersection(GenVars, GoalVars, SharedVars), 594 Templ =.. [v|SharedVars], 595 findall(Templ, Generator, List), 596 prove_list(List, Templ, Goal). 597 598prove_list([], _, _). 599prove_list([H|T], Templ, Goal) :- 600 Templ = H, 601 call(Goal), 602 '$unbind_template'(Templ), 603 prove_list(T, Templ, Goal).
free_variables(Generator, Template, OldList, NewList) finds this
set using OldList as an accumulator.
625free_variables(Term, Bound, VarList, [Term|VarList]) :- 626 var(Term), 627 term_is_free_of(Bound, Term), 628 list_is_free_of(VarList, Term), 629 !. 630free_variables(Term, _Bound, VarList, VarList) :- 631 var(Term), 632 !. 633free_variables(Term, Bound, OldList, NewList) :- 634 explicit_binding(Term, Bound, NewTerm, NewBound), 635 !, 636 free_variables(NewTerm, NewBound, OldList, NewList). 637free_variables(Term, Bound, OldList, NewList) :- 638 functor(Term, _, N), 639 free_variables(N, Term, Bound, OldList, NewList). 640 641free_variables(0, _, _, VarList, VarList) :- !. 642free_variables(N, Term, Bound, OldList, NewList) :- 643 arg(N, Term, Argument), 644 free_variables(Argument, Bound, OldList, MidList), 645 M is N-1, 646 !, 647 free_variables(M, Term, Bound, MidList, NewList). 648 649% explicit_binding checks for goals known to existentially quantify 650% one or more variables. In particular \+ is quite common. 651 652explicit_binding(\+ _Goal, Bound, fail, Bound ) :- !. 653explicit_binding(not(_Goal), Bound, fail, Bound ) :- !. 654explicit_binding(Var^Goal, Bound, Goal, Bound+Var) :- !. 655explicit_binding(setof(Var,Goal,Set), Bound, Goal-Set, Bound+Var) :- !. 656explicit_binding(bagof(Var,Goal,Bag), Bound, Goal-Bag, Bound+Var) :- !.
664term_is_free_of(Term, Var) :- 665 \+ var_in_term(Term, Var). 666 667var_in_term(Term, Var) :- 668 Var == Term, 669 !. 670var_in_term(Term, Var) :- 671 compound(Term), 672 arg(_, Term, Arg), 673 var_in_term(Arg, Var), 674 !.
681list_is_free_of([Head|Tail], Var) :- 682 Head \== Var, 683 !, 684 list_is_free_of(Tail, Var). 685list_is_free_of([], _). 686 687 688% term_variables(+Term, +Vars0, -Vars) is det. 689% 690% True if Vars is the union of variables in Term and Vars0. 691% We cannot have this as term_variables/3 is already defined 692% as a difference-list version of term_variables/2. 693 694%term_variables(Term, Vars0, Vars) :- 695% term_variables(Term+Vars0, Vars).
703:- multifile sandbox:safe_meta_predicate/1. 704 705sandbox:safe_meta_predicate(aggregate:foreach/2). 706sandbox:safe_meta_predicate(aggregate:aggregate/3). 707sandbox:safe_meta_predicate(aggregate:aggregate/4). 708sandbox:safe_meta_predicate(aggregate:aggregate_all/3). 709sandbox:safe_meta_predicate(aggregate:aggregate_all/4)
Aggregation operators on backtrackable predicates
This library provides aggregating operators over the solutions of a predicate. The operations are a generalisation of the bagof/3, setof/3 and findall/3 built-in predicates. Aggregations that can be computed incrementally avoid findall/3 and run in constant memory. The defined aggregation operations are counting, computing the sum, minimum, maximum, a bag of solutions and a set of solutions. We first give a simple example, computing the country with the smallest area:
smallest_country(Name, Area) :- aggregate(min(A, N), country(N, A), min(Area, Name)).There are four aggregation predicates (aggregate/3, aggregate/4, aggregate_all/3 and aggregate/4), distinguished on two properties.
Var^Goal) and providing multiple solutions for the remaining free variables in Goal. The aggregate_all/3 predicate uses findall/3, implicitly qualifying all free variables and providing exactly one solution, while aggregate_all/4 uses sort/2 over solutions that Discriminator (see below) generated using findall/3.country(belgium, 11000000)may succeed twice, we can use the following to avoid counting the population of Belgium twice:aggregate(sum(P), Name, country(Name, P), Total)All aggregation predicates support the following operators below in Template. In addition, they allow for an arbitrary named compound term, where each of the arguments is a term from the list below. For example, the term
r(min(X), max(X))computes both the minimum and maximum binding for X.sum(1).min(Min, Witness), where Min is the minimal version of Expr over all solutions, and Witness is any other template applied to solutions that produced Min. If multiple solutions provide the same minimum, Witness corresponds to the first solution.min(Expr, Witness), but producing the maximum result.Acknowledgements
The development of this library was sponsored by SecuritEase, http://www.securitease.com