Module Aggreg

Jan Burse, created May 21. 2019
* Prolog text aggreg from Chat80 as a module.
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies GmbH makes no warranties
* regarding the provided information. XLOG Technologies GmbH assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies GmbH.
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies GmbH. If the company was not the originator of some
* excerpts, XLOG Technologies GmbH has at least obtained the right to
* reproduce, change and translate the information.
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies GmbH.
* Obtained rights comment in Prolog text and text from LICENSE file:
* @(#) 24.1 2/23/88
* Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
* All Rights Reserved
* This program may be used, copied, altered or included in other programs
* only for academic purposes and provided that the authorship of the
* initial program is acknowledged. Use for commercial purposes without the
* previous written agreement of the authors is forbidden.
:- if(current_prolog_flag(dialect,jekejeke)).
:- package(library(database)).
:- endif.
:- module(aggreg, [aggregate/3,one_of/2,ratio/4,card/2]).
:- use_module(chatops).
:- current_prolog_flag(dialect, jekejeke)
-> use_module(library(basic/lists)); true.
% :- mode aggregate(+,+,?),
% dimensioned(+),
% one_of(+,?),
% i_aggr(+,+,?),
% u_aggr(+,+,?),
% i_total(+,?),
% i_maxs(+,?),
% i_mins(+,?),
% i_maxs0(+,+,+,?,?),
% i_mins0(+,+,+,?,?),
% u_total(+,?),
% u_sum(+,+,?),
% u_maxs(+,?),
% u_mins(+,?),
% i_maxs0(+,+,+,?,?),
% i_mins0(+,+,+,?,?),
% u_lt(+,+).
aggregate(Fn, Set, Val) :-
u_aggr(Fn, Set, Val).
aggregate(Fn, Set, Val) :-
i_aggr(Fn, Set, Val).
i_aggr(average, Set, Val) :-
i_total(Set, T),
length(Set, N),
Val is T//N.
i_aggr(total, Set, Val) :-
i_total(Set, Val).
i_aggr(max, Set, Val) :-
i_maxs(Set, List),
one_of(List, Val).
i_aggr(min, Set, Val) :-
i_mins(Set, List),
one_of(List, Val).
i_aggr(maximum, [V0:O|S], V) :-
i_maxs0(S, V0, [O], _, V).
i_aggr(minimum, [V0:O|S], V) :-
i_mins0(S, V0, [O], _, V).
u_aggr(average, Set, V--U) :-
u_total(Set, T--U),
length(Set, N),
V is T//N.
u_aggr(total, Set, Val) :-
u_total(Set, Val).
u_aggr(max, Set, Val) :-
u_maxs(Set, List),
one_of(List, Val).
u_aggr(min, Set, Val) :-
u_mins(Set, List),
one_of(List, Val).
u_aggr(maximum, [V0:O|S], V) :-
u_maxs0(S, V0, [O], _, V).
u_aggr(minimum, [V0:O|S], V) :-
u_mins0(S, V0, [O], _, V).
i_total([], 0).
i_total([V:_|R], T) :-
i_total(R, T0),
T is V+T0.
i_maxs([V:X|Set], List) :-
i_maxs0(Set, V, [X], List, _).
i_maxs0([], V, L, L, V).
i_maxs0([V0:X|R], V0, L0, L, V) :- !,
i_maxs0(R, V0, [X|L0], L, V).
i_maxs0([U:X|R], V, _, L, W) :-
U > V, !,
i_maxs0(R, U, [X], L, W).
i_maxs0([_|R], V, L0, L, W) :-
i_maxs0(R, V, L0, L, W).
i_mins([V:X|Set], List) :-
i_mins0(Set, V, [X], List, _).
i_mins0([], V, L, L, V).
i_mins0([V:X|R], V, L0, L, W) :- !,
i_mins0(R, V, [X|L0], L, W).
i_mins0([U:X|R], V, _, L, W) :-
U < V, !,
i_mins0(R, U, [X], L, W).
i_mins0([_|R], V, L0, L, W) :-
i_mins0(R, V, L0, L, W).
u_total([], 0--_).
u_total([V:_|R], T) :-
u_total(R, T0),
u_sum(T0, V, T).
u_sum(X--U, Y--U, Z--U) :- !,
Z is X+Y.
u_sum(X--U, Y--U1, Z--U) :-
ratio(U, U1, M, M1),
M > M1, !,
Z is X+Y*M1//M.
u_sum(X--U1, Y--U, Z--U) :-
ratio(U, U1, M, M1),
M > M1, !,
Z is X*M1//M+Y.
u_maxs([V:X|Set], List) :-
u_maxs0(Set, V, [X], List, _).
u_maxs0([], V, L, L, V).
u_maxs0([V0:X|R], V0, L0, L, V) :- !,
u_maxs0(R, V0, [X|L0], L, V).
u_maxs0([U:X|R], V, _, L, W) :-
u_lt(V, U), !,
u_maxs0(R, U, [X], L, W).
u_maxs0([_|R], V, L0, L, W) :-
u_maxs0(R, V, L0, L, W).
u_mins([V:X|Set], List) :-
u_mins0(Set, V, [X], List, _).
u_mins0([], V, L, L, V).
u_mins0([V:X|R], V, L0, L, W) :- !,
u_mins0(R, V, [X|L0], L, W).
u_mins0([U:X|R], V, _, L, W) :-
u_lt(U, V), !,
u_mins0(R, U, [X], L, W).
u_mins0([_|R], V, L0, L, W) :-
u_mins0(R, V, L0, L, W).
u_lt(A, X--U) :-
Y is -X,
u_sum(A, Y--U, Z--_),
Z < 0.
one_of([X|_], X).
one_of([_|R], X) :-
one_of(R, X).
card(S, N) :-
length(S, N).
ratio(thousand, million, 1, 1000).
ratio(million, thousand, 1000, 1).
ratio(ksqmiles, sqmiles, 1000, 1).
ratio(sqmiles, ksqmiles, 1, 1000).