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_intersection/3]). 51:- autoload(library(pairs),[pairs_values/2]). 52 53:- set_prolog_flag(generate_debug_info, false). 54 55:- meta_predicate 56 foreach(0,0), 57 aggregate(?,^,-), 58 aggregate(?,?,^,-), 59 aggregate_all(?,0,-), 60 aggregate_all(?,?,0,-).

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.

aggregate vs. aggregate_all

The aggregate predicates use setof/3 (aggregate/4) or bagof/3 (aggregate/3), dealing with existential qualified variables (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.

The Discriminator argument

The versions with 4 arguments deduplicate redundant solutions of Goal. Solutions for which both the template variables and Discriminator are identical will be treated as one solution. For example, if we wish to compute the total population of all countries, and for some reason 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.

count: Count number of solutions. Same as sum(1).
sum(Expr): Sum of Expr for all solutions.
min(Expr): Minimum of Expr for all solutions.
min(Expr, Witness): A term 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.
max(Expr): Maximum of Expr for all solutions.
max(Expr, Witness): As min(Expr, Witness), but producing the maximum result.
set(X): An ordered set with all solutions for X.
bag(X): A list of all solutions for X.

Acknowledgements

The development of this library was sponsored by SecuritEase, http://www.securitease.com

Compatibility: - Quintus, SICStus 4. The forall/2 is a SWI-Prolog built-in and term_variables/3 is a SWI-Prolog built-in with different semantics.
To be done: - Analysing the aggregation template and compiling a predicate for the list aggregation can be done at compile time.; - aggregate_all/3 can be rewritten to run in constant space using non-backtrackable assignment on a term. */

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).

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).

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).

538state1(bag, X, L, [X|L]) :- !. 539state1(set, X, L, [X|L]) :- !. 540state1(_, X, X, _). 541 542 543 /******************************* 544 * FOREACH * 545 *******************************/

601foreach(Generator, Goal) :- 602 term_variables(Generator, GenVars0), sort(GenVars0, GenVars), 603 term_variables(Goal, GoalVars0), sort(GoalVars0, GoalVars), 604 ord_intersection(GenVars, GoalVars, SharedVars), 605 Templ =.. [v|SharedVars], 606 findall(Templ, Generator, List), 607 prove_list(List, Templ, Goal). 608 609prove_list([], _, _). 610prove_list([H|T], Templ, Goal) :- 611 Templ = H, 612 call(Goal), 613 '$unbind_template'(Templ), 614 prove_list(T, Templ, Goal).

636free_variables(Term, Bound, VarList, [Term|VarList]) :- 637 var(Term), 638 term_is_free_of(Bound, Term), 639 list_is_free_of(VarList, Term), 640 !. 641free_variables(Term, _Bound, VarList, VarList) :- 642 var(Term), 643 !. 644free_variables(Term, Bound, OldList, NewList) :- 645 explicit_binding(Term, Bound, NewTerm, NewBound), 646 !, 647 free_variables(NewTerm, NewBound, OldList, NewList). 648free_variables(Term, Bound, OldList, NewList) :- 649 functor(Term, _, N), 650 free_variables(N, Term, Bound, OldList, NewList). 651 652free_variables(0, _, _, VarList, VarList) :- !. 653free_variables(N, Term, Bound, OldList, NewList) :- 654 arg(N, Term, Argument), 655 free_variables(Argument, Bound, OldList, MidList), 656 M is N-1, 657 !, 658 free_variables(M, Term, Bound, MidList, NewList). 659 660% explicit_binding checks for goals known to existentially quantify 661% one or more variables. In particular \+ is quite common. 662 663explicit_binding(\+ _Goal, Bound, fail, Bound ) :- !. 664explicit_binding(not(_Goal), Bound, fail, Bound ) :- !. 665explicit_binding(Var^Goal, Bound, Goal, Bound+Var) :- !. 666explicit_binding(setof(Var,Goal,Set), Bound, Goal-Set, Bound+Var) :- !. 667explicit_binding(bagof(Var,Goal,Bag), Bound, Goal-Bag, Bound+Var) :- !.

675term_is_free_of(Term, Var) :- 676 \+ var_in_term(Term, Var). 677 678var_in_term(Term, Var) :- 679 Var == Term, 680 !. 681var_in_term(Term, Var) :- 682 compound(Term), 683 arg(_, Term, Arg), 684 var_in_term(Arg, Var), 685 !.

692list_is_free_of([Head|Tail], Var) :- 693 Head \== Var, 694 !, 695 list_is_free_of(Tail, Var). 696list_is_free_of([], _). 697 698 699% term_variables(+Term, +Vars0, -Vars) is det. 700% 701% True if Vars is the union of variables in Term and Vars0. 702% We cannot have this as term_variables/3 is already defined 703% as a difference-list version of term_variables/2. 704 705%term_variables(Term, Vars0, Vars) :- 706% term_variables(Term+Vars0, Vars).

714:- multifile sandbox:safe_meta_predicate/1. 715 716sandbox:safe_meta_predicate(aggregate:foreach/2). 717sandbox:safe_meta_predicate(aggregate:aggregate/3). 718sandbox:safe_meta_predicate(aggregate:aggregate/4). 719sandbox:safe_meta_predicate(aggregate:aggregate_all/3). 720sandbox:safe_meta_predicate(aggregate:aggregate_all/4)

`Post`	- is a body-term that evaluates expressions to reduce storage requirements.
`Vars`	- is a list of intermediate variables that must be added to the existential variables for bagof/3.
`Aggregate`	- defines the aggregation operation to execute.