Fixed bug #22073
[pspp] / src / math / factor-stats.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 2004 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18 #include "factor-stats.h"
19 #include <data/val-type.h>
20 #include <data/value.h>
21 #include <libpspp/hash.h>
22 #include <libpspp/array.h>
23 #include "moments.h"
24 #include "percentiles.h"
25
26 #include <stdlib.h>
27 #include <math.h>
28 #include <float.h>
29 #include <assert.h>
30 #include "histogram.h"
31
32 #include "xalloc.h"
33
34 void
35 metrics_precalc(struct metrics *m)
36 {
37   assert (m) ;
38
39   m->n_missing = 0;
40
41   m->min = DBL_MAX;
42   m->max = -DBL_MAX;
43
44   m->histogram = 0;
45
46   m->moments = moments1_create(MOMENT_KURTOSIS);
47
48   m->ordered_data = hsh_create(20,
49                                 (hsh_compare_func *) compare_values,
50                                 (hsh_hash_func *) hash_value,
51                                 (hsh_free_func *) weighted_value_free,
52                                 (void *) 0);
53 }
54
55
56 /* Include val in the calculation for the metrics.
57    If val is null, then treat it as MISSING
58 */
59 void
60 metrics_calc (struct metrics *fs, const union value *val,
61               double weight, int case_no)
62 {
63   struct weighted_value **wv;
64   double x;
65
66   if ( ! val )
67     {
68       fs->n_missing += weight;
69       return ;
70     }
71
72   x = val->f;
73
74   moments1_add(fs->moments, x, weight);
75
76
77   if ( x < fs->min) fs->min = x;
78   if ( x > fs->max) fs->max = x;
79
80
81   wv = (struct weighted_value **) hsh_probe (fs->ordered_data,(void *) val );
82
83   if ( *wv  )
84     {
85       /* If this value has already been seen, then simply
86          increase its weight  and push a new case number */
87
88       struct case_node *cn;
89
90       assert( (*wv)->v.f == val->f );
91       (*wv)->w += weight;
92
93       cn = xmalloc ( sizeof *cn);
94       cn->next = (*wv)->case_nos ;
95       cn->num = case_no;
96
97       (*wv)->case_nos = cn;
98     }
99   else
100     {
101       struct case_node *cn;
102
103       *wv = weighted_value_create();
104       (*wv)->v = *val;
105       (*wv)->w = weight;
106
107       cn = xmalloc (sizeof *cn);
108       cn->next=0;
109       cn->num = case_no;
110       (*wv)->case_nos  = cn;
111
112     }
113
114 }
115
116 void
117 metrics_postcalc(struct metrics *m)
118 {
119   double cc = 0.0;
120   double tc ;
121   int k1, k2 ;
122   int i;
123   int j = 1;
124
125   moments1_calculate (m->moments, &m->n, &m->mean, &m->var,
126                       &m->skewness, &m->kurtosis);
127
128   moments1_destroy (m->moments);
129
130
131   m->stddev = sqrt(m->var);
132
133   /* FIXME: Check this is correct ???
134      Shouldn't we use the sample variance ??? */
135   m->se_mean = sqrt (m->var / m->n) ;
136
137
138
139   m->wvp = (struct weighted_value **) hsh_sort(m->ordered_data);
140   m->n_data = hsh_count(m->ordered_data);
141
142   /* Trimmed mean calculation */
143   if ( m->n_data <= 1 )
144     {
145       m->trimmed_mean = m->mean;
146       return;
147     }
148
149   m->histogram = histogram_create(10, m->min, m->max);
150
151   for ( i = 0 ; i < m->n_data ; ++i )
152     {
153       struct weighted_value **wv = (m->wvp) ;
154       gsl_histogram_accumulate(m->histogram, wv[i]->v.f, wv[i]->w);
155     }
156
157   tc = m->n * 0.05 ;
158   k1 = -1;
159   k2 = -1;
160
161   for ( i = 0 ; i < m->n_data ; ++i )
162     {
163       cc += m->wvp[i]->w;
164       m->wvp[i]->cc = cc;
165
166       m->wvp[i]->rank = j + (m->wvp[i]->w - 1) / 2.0 ;
167
168       j += m->wvp[i]->w;
169
170       if ( cc < tc )
171         k1 = i;
172     }
173
174
175
176   k2 = m->n_data;
177   for ( i = m->n_data -1  ; i >= 0; --i )
178     {
179       if ( tc > m->n - m->wvp[i]->cc)
180         k2 = i;
181     }
182
183
184   /* Calculate the percentiles */
185   ptiles (m->ptile_hash, (const struct weighted_value **) m->wvp,
186           m->n_data, m->n, m->ptile_alg);
187
188   tukey_hinges ((const struct weighted_value **) m->wvp,
189                 m->n_data, m->n, m->hinge);
190
191   /* Special case here */
192   if ( k1 + 1 == k2 )
193     {
194       m->trimmed_mean = m->wvp[k2]->v.f;
195       return;
196     }
197
198   m->trimmed_mean = 0;
199   for ( i = k1 + 2 ; i <= k2 - 1 ; ++i )
200     {
201       m->trimmed_mean += m->wvp[i]->v.f * m->wvp[i]->w;
202     }
203
204
205   m->trimmed_mean += (m->n - m->wvp[k2 - 1]->cc - tc) * m->wvp[k2]->v.f ;
206   m->trimmed_mean += (m->wvp[k1 + 1]->cc - tc) * m->wvp[k1 + 1]->v.f ;
207   m->trimmed_mean /= 0.9 * m->n ;
208
209
210 }
211
212
213 struct weighted_value *
214 weighted_value_create(void)
215 {
216   struct weighted_value *wv;
217   wv = xmalloc (sizeof *wv);
218
219   wv->cc = 0;
220   wv->case_nos = 0;
221
222   return wv;
223 }
224
225 void
226 weighted_value_free(struct weighted_value *wv)
227 {
228   struct case_node *cn ;
229
230   if ( !wv )
231     return ;
232
233   cn = wv->case_nos;
234
235   while(cn)
236     {
237       struct case_node *next = cn->next;
238
239       free(cn);
240       cn = next;
241     }
242
243   free(wv);
244
245 }
246
247
248
249
250
251 /* Create a factor statistics object with for N dependent vars
252    and ID0 and ID1 as the values of the independent variable */
253 struct factor_statistics *
254 create_factor_statistics (int n,
255                           union value *id0,
256                           union value *id1)
257 {
258   struct factor_statistics *f;
259
260   f = xmalloc (sizeof *f);
261
262   f->id[0] = id0;
263   f->id[1] = id1;
264   f->m = xnmalloc (n, sizeof *f->m);
265   memset (f->m, 0, sizeof(struct metrics) * n);
266   f->n_var = n;
267
268   return f;
269 }
270
271 void
272 metrics_destroy(struct metrics *m)
273 {
274   hsh_destroy(m->ordered_data);
275   hsh_destroy(m->ptile_hash);
276   if ( m-> histogram )
277     gsl_histogram_free(m->histogram);
278 }
279
280 void
281 factor_statistics_free(struct factor_statistics *f)
282 {
283
284   int i;
285   free (f->id[0]);
286   free (f->id[1]);
287   for ( i = 0 ; i < f->n_var; ++i )
288        metrics_destroy(&f->m[i]);
289   free(f->m) ;
290   free(f);
291 }
292
293
294 int
295 factor_statistics_compare(const struct factor_statistics *f0,
296                           const struct factor_statistics *f1, int width)
297 {
298
299   int cmp0;
300
301   assert(f0);
302   assert(f1);
303
304   cmp0 = compare_values(f0->id[0], f1->id[0], width);
305
306   if ( cmp0 != 0 )
307     return cmp0;
308
309
310   if ( ( f0->id[1]->f == SYSMIS ) && (f1->id[1]->f != SYSMIS) )
311     return 1;
312
313   if ( ( f0->id[1]->f != SYSMIS )  && (f1->id[1]->f == SYSMIS) )
314     return -1;
315
316   return compare_values (f0->id[1], f1->id[1], width);
317 }
318
319 unsigned int
320 factor_statistics_hash (const struct factor_statistics *f, int width)
321 {
322   unsigned int h;
323
324   h = hash_value (f->id[0], width);
325
326   if ( f->id[1]->f != SYSMIS )
327     h += hash_value(f->id[1], width);
328
329   return h;
330 }