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