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,Set,Val) :-
   48   dimensioned(Set), !,
   49   u_aggr(Fn,Set,Val).
   50aggregate(Fn,Set,Val) :-
   51   i_aggr(Fn,Set,Val).
   52
   53i_aggr(average,Set,Val) :-
   54   i_total(Set,T),
   55   length(Set,N),
   56   Val is T//N.
   57i_aggr(total,Set,Val) :-
   58   i_total(Set,Val).
   59i_aggr(max,Set,Val) :-
   60   i_maxs(Set,List),
   61   one_of(List,Val).
   62i_aggr(min,Set,Val) :-
   63   i_mins(Set,List),
   64   one_of(List,Val).
   65i_aggr(maximum,[V0:O|S],V) :-
   66   i_maxs0(S,V0,[O],_,V).
   67i_aggr(minimum,[V0:O|S],V) :-
   68   i_mins0(S,V0,[O],_,V).
   69
   70u_aggr(average,Set,V--U) :-
   71   u_total(Set,T--U),
   72   length(Set,N),
   73   V is T//N.
   74u_aggr(total,Set,Val) :-
   75   u_total(Set,Val).
   76u_aggr(max,Set,Val) :-
   77   u_maxs(Set,List),
   78   one_of(List,Val).
   79u_aggr(min,Set,Val) :-
   80   u_mins(Set,List),
   81   one_of(List,Val).
   82u_aggr(maximum,[V0:O|S],V) :-
   83   u_maxs0(S,V0,[O],_,V).
   84u_aggr(minimum,[V0:O|S],V) :-
   85   u_mins0(S,V0,[O],_,V).
   86
   87i_total([],0).
   88i_total([V:_|R],T) :-
   89   i_total(R,T0),
   90   T is V+T0.
   91
   92i_maxs([V:X|Set],List) :-
   93   i_maxs0(Set,V,[X],List,_).
   94
   95i_maxs0([],V,L,L,V).
   96i_maxs0([V0:X|R],V0,L0,L,V) :- !,
   97   i_maxs0(R,V0,[X|L0],L,V).
   98i_maxs0([U:X|R],V,_,L,W) :-
   99   U>V, !,
  100   i_maxs0(R,U,[X],L,W).
  101i_maxs0([_|R],V,L0,L,W) :-
  102   i_maxs0(R,V,L0,L,W).
  103
  104i_mins([V:X|Set],List) :-
  105   i_mins0(Set,V,[X],List,_).
  106
  107i_mins0([],V,L,L,V).
  108i_mins0([V:X|R],V,L0,L,W) :- !,
  109   i_mins0(R,V,[X|L0],L,W).
  110i_mins0([U:X|R],V,_,L,W) :-
  111   U<V, !,
  112   i_mins0(R,U,[X],L,W).
  113i_mins0([_|R],V,L0,L,W) :-
  114   i_mins0(R,V,L0,L,W).
  115
  116u_total([],0--_U).
  117u_total([V:_|R],T) :-
  118   u_total(R,T0),
  119   u_sum(T0,V,T).
  120
  121u_sum(X--U,Y--U,Z--U) :- !,
  122   Z is X+Y.
  123u_sum(X--U,Y--U1,Z--U) :-
  124   ratio(U,U1,M,M1), M>M1, !,
  125   Z is X + (Y*M1)//M.
  126u_sum(X--U1,Y--U,Z--U) :-
  127   ratio(U,U1,M,M1), M>M1, !,
  128   Z is (X*M1)//M + Y.
  129
  130u_maxs([V:X|Set],List) :-
  131   u_maxs0(Set,V,[X],List,_).
  132
  133u_maxs0([],V,L,L,V).
  134u_maxs0([V0:X|R],V0,L0,L,V) :- !,
  135   u_maxs0(R,V0,[X|L0],L,V).
  136u_maxs0([U:X|R],V,_,L,W) :-
  137   u_lt(V,U), !,
  138   u_maxs0(R,U,[X],L,W).
  139u_maxs0([_|R],V,L0,L,W) :-
  140   u_maxs0(R,V,L0,L,W).
  141
  142u_mins([V:X|Set],List) :-
  143   u_mins0(Set,V,[X],List,_).
  144
  145u_mins0([],V,L,L,V).
  146u_mins0([V:X|R],V,L0,L,W) :- !,
  147   u_mins0(R,V,[X|L0],L,W).
  148u_mins0([U:X|R],V,_,L,W) :-
  149   u_lt(U,V), !,
  150   u_mins0(R,U,[X],L,W).
  151u_mins0([_|R],V,L0,L,W) :-
  152   u_mins0(R,V,L0,L,W).
  153
  154u_lt(A,X--U) :-
  155   Y is -X,
  156   u_sum(A,Y--U,Z--_),
  157   Z<0.
  158
  159dimensioned([(_--_):_|_]).
  160
  161one_of([X|_],X).
  162one_of([_|R],X) :-
  163   one_of(R,X).
  164
  165ratio(N,M,R) :- R is (N*100)//M.
  166
  167cardinality(S,N) :- length(S,N)