1/* @(#)aggreg.pl	24.1 2/23/88 */
    2
    3/* 
    4 _________________________________________________________________________
    5|	Copyright (C) 1982						  |
    6|									  |
    7|	David Warren,							  |
    8|		SRI International, 333 Ravenswood Ave., Menlo Park,	  |
    9|		California 94025, USA;					  |
   10|									  |
   11|	Fernando Pereira,						  |
   12|		Dept. of Architecture, University of Edinburgh,		  |
   13|		20 Chambers St., Edinburgh EH1 1JZ, Scotland		  |
   14|									  |
   15|	This program may be used, copied, altered or included in other	  |
   16|	programs only for academic purposes and provided that the	  |
   17|	authorship of the initial program is aknowledged.		  |
   18|	Use for commercial purposes without the previous written 	  |
   19|	agreement of the authors is forbidden.				  |
   20|_________________________________________________________________________|
   21
   22
   23	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
   24
   25			   All Rights Reserved
   26*/
   27:- public aggregate/3, one_of/2, ratio/3, cardinality/2.   28
   29:- mode aggregate(+,+,?),
   30        dimensioned(+),
   31	one_of(+,?),
   32	i_aggr(+,+,?),
   33	u_aggr(+,+,?),
   34	i_total(+,?),
   35	i_maxs(+,?),
   36	i_mins(+,?),
   37	i_maxs0(+,+,+,?,?),
   38	i_mins0(+,+,+,?,?),
   39	u_total(+,?),
   40	u_sum(+,+,?),
   41	u_maxs(+,?),
   42	u_mins(+,?),
   43	i_maxs0(+,+,+,?,?),
   44	i_mins0(+,+,+,?,?),
   45	u_lt(+,+).   46
   47aggregate(Fn, _S, _V) :- var(Fn),!,fail.
   48aggregate(Fn,Set,Val) :- 
   49   dimensioned(Set), !,
   50   u_aggr(Fn,Set,Val).
   51aggregate(Fn,Set,Val) :-
   52   i_aggr(Fn,Set,Val).
   53
   54i_aggr(average,Set,Val) :-
   55   i_total(Set,T),
   56   length(Set,N),
   57   Val is T//N.
   58i_aggr(total,Set,Val) :-
   59   i_total(Set,Val).
   60i_aggr(max,Set,Val) :-
   61   i_maxs(Set,List),
   62   one_of(List,Val).
   63i_aggr(min,Set,Val) :-
   64   i_mins(Set,List),
   65   one_of(List,Val).
   66i_aggr(maximum,[V0:O|S],V) :-
   67   i_maxs0(S,V0,[O],_,V).
   68i_aggr(minimum,[V0:O|S],V) :-
   69   i_mins0(S,V0,[O],_,V).
   70
   71u_aggr(average,Set,V--U) :-
   72   u_total(Set,T--U),
   73   length(Set,N),
   74   V is T//N.
   75u_aggr(total,Set,Val) :-
   76   u_total(Set,Val).
   77u_aggr(max,Set,Val) :-
   78   u_maxs(Set,List),
   79   one_of(List,Val).
   80u_aggr(min,Set,Val) :-
   81   u_mins(Set,List),
   82   one_of(List,Val).
   83u_aggr(maximum,[V0:O|S],V) :-
   84   u_maxs0(S,V0,[O],_,V).
   85u_aggr(minimum,[V0:O|S],V) :-
   86   u_mins0(S,V0,[O],_,V).
   87
   88i_total([],0).
   89i_total([V:_|R],T) :-
   90   i_total(R,T0),
   91   T is V+T0.
   92
   93i_maxs([V:X|Set],List) :-
   94   i_maxs0(Set,V,[X],List,_).
   95
   96i_maxs0([],V,L,L,V).
   97i_maxs0([V0:X|R],V0,L0,L,V) :- !,
   98   i_maxs0(R,V0,[X|L0],L,V).
   99i_maxs0([U:X|R],V,_,L,W) :-
  100   U>V, !,
  101   i_maxs0(R,U,[X],L,W).
  102i_maxs0([_|R],V,L0,L,W) :-
  103   i_maxs0(R,V,L0,L,W).
  104
  105i_mins([V:X|Set],List) :-
  106   i_mins0(Set,V,[X],List,_).
  107
  108i_mins0([],V,L,L,V).
  109i_mins0([V:X|R],V,L0,L,W) :- !,
  110   i_mins0(R,V,[X|L0],L,W).
  111i_mins0([U:X|R],V,_,L,W) :-
  112   U<V, !,
  113   i_mins0(R,U,[X],L,W).
  114i_mins0([_|R],V,L0,L,W) :-
  115   i_mins0(R,V,L0,L,W).
  116
  117u_total([],0--_U).
  118u_total([V:_|R],T) :-
  119   u_total(R,T0),
  120   u_sum(T0,V,T).
  121
  122u_sum(X--U,Y--U,Z--U) :- !,
  123   Z is X+Y.
  124u_sum(X--U,Y--U1,Z--U) :-
  125   ratio(U,U1,M,M1), M>M1, !,
  126   Z is X + (Y*M1)//M.
  127u_sum(X--U1,Y--U,Z--U) :-
  128   ratio(U,U1,M,M1), M>M1, !,
  129   Z is (X*M1)//M + Y.
  130
  131u_maxs([V:X|Set],List) :-
  132   u_maxs0(Set,V,[X],List,_).
  133
  134u_maxs0([],V,L,L,V).
  135u_maxs0([V0:X|R],V0,L0,L,V) :- !,
  136   u_maxs0(R,V0,[X|L0],L,V).
  137u_maxs0([U:X|R],V,_,L,W) :-
  138   u_lt(V,U), !,
  139   u_maxs0(R,U,[X],L,W).
  140u_maxs0([_|R],V,L0,L,W) :-
  141   u_maxs0(R,V,L0,L,W).
  142
  143u_mins([V:X|Set],List) :-
  144   u_mins0(Set,V,[X],List,_).
  145
  146u_mins0([],V,L,L,V).
  147u_mins0([V:X|R],V,L0,L,W) :- !,
  148   u_mins0(R,V,[X|L0],L,W).
  149u_mins0([U:X|R],V,_,L,W) :-
  150   u_lt(U,V), !,
  151   u_mins0(R,U,[X],L,W).
  152u_mins0([_|R],V,L0,L,W) :-
  153   u_mins0(R,V,L0,L,W).
  154
  155u_lt(A,X--U) :-
  156   Y is -X,
  157   u_sum(A,Y--U,Z--_),
  158   Z<0.
  159
  160dimensioned(Var):- var(Var),!,fail.
  161dimensioned([(_--_):_|_]).
  162
  163one_of([Var|_],_):- var(Var),!,fail.
  164one_of([X|_],X).
  165one_of([_|R],X) :-
  166   one_of(R,X).
  167
  168
  169ratio(N,M,R) :- R is (N*100)//M.
  170
  171cardinality(S,N) :- length(S,N)