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