36
37:- module(aggregate,
38 [ foreach/2, 39 aggregate/3, 40 aggregate/4, 41 aggregate_all/3, 42 aggregate_all/4, 43 free_variables/4 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(0,0),
57 aggregate(?,^,-),
58 aggregate(?,?,^,-),
59 aggregate_all(?,0,-),
60 aggregate_all(?,?,0,-). 61
142
143 146
151
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).
156
161
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).
167
179
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).
257
264
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).
297
298
302
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).
314
315
326
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).
372
377
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).
388
398
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).
434
435
442
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 ).
462
464
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).
528
530
531state0(bag, L, L).
532state0(set, L, L).
533state0(count, 0, _).
534state0(sum, 0, _).
535
537
538state1(bag, X, L, [X|L]) :- !.
539state1(set, X, L, [X|L]) :- !.
540state1(_, X, X, _).
541
542
543 546
589
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).
604
605
624
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
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) :- !.
657
663
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 !.
675
676
680
681list_is_free_of([Head|Tail], Var) :-
682 Head \== Var,
683 !,
684 list_is_free_of(Tail, Var).
685list_is_free_of([], _).
686
687
693
696
697
702
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)