Fixed bug reporting the significance of paired value t-test.
[pspp-builds.git] / 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   if ( x < fs->min) fs->min = x;
77   if ( x > fs->max) fs->max = x;
78
79   wv = (struct weighted_value **) hsh_probe (fs->ordered_data,(void *) val );
80
81   if ( *wv  )
82     {
83       /* If this value has already been seen, then simply
84          increase its weight  and push a new case number */
85
86       struct case_node *cn;
87
88       assert( (*wv)->v.f == val->f );
89       (*wv)->w += weight;
90
91       cn = xmalloc ( sizeof *cn);
92       cn->next = (*wv)->case_nos ;
93       cn->num = case_no;
94
95       (*wv)->case_nos = cn;
96     }
97   else
98     {
99       struct case_node *cn;
100
101       *wv = weighted_value_create();
102       (*wv)->v = *val;
103       (*wv)->w = weight;
104
105       cn = xmalloc (sizeof *cn);
106       cn->next=0;
107       cn->num = case_no;
108       (*wv)->case_nos  = cn;
109
110     }
111
112 }
113
114 void
115 metrics_postcalc(struct metrics *m)
116 {
117   double cc = 0.0;
118   double tc ;
119   int k1, k2 ;
120   int i;
121   int j = 1;
122
123   moments1_calculate (m->moments, &m->n, &m->mean, &m->var,
124                       &m->skewness, &m->kurtosis);
125
126   moments1_destroy (m->moments);
127
128
129   m->stddev = sqrt(m->var);
130
131   /* FIXME: Check this is correct ???
132      Shouldn't we use the sample variance ??? */
133   m->se_mean = sqrt (m->var / m->n) ;
134
135
136
137   m->wvp = (struct weighted_value **) hsh_sort(m->ordered_data);
138   m->n_data = hsh_count(m->ordered_data);
139
140   /* Trimmed mean calculation */
141   if ( m->n_data <= 1 )
142     {
143       m->trimmed_mean = m->mean;
144       return;
145     }
146
147   m->histogram = histogram_create(10, m->min, m->max);
148
149   for ( i = 0 ; i < m->n_data ; ++i )
150     {
151       struct weighted_value **wv = (m->wvp) ;
152       gsl_histogram_accumulate(m->histogram, wv[i]->v.f, wv[i]->w);
153     }
154
155   tc = m->n * 0.05 ;
156   k1 = -1;
157   k2 = -1;
158
159   for ( i = 0 ; i < m->n_data ; ++i )
160     {
161       cc += m->wvp[i]->w;
162       m->wvp[i]->cc = cc;
163
164       m->wvp[i]->rank = j + (m->wvp[i]->w - 1) / 2.0 ;
165
166       j += m->wvp[i]->w;
167
168       if ( cc < tc )
169         k1 = i;
170     }
171
172
173
174   k2 = m->n_data;
175   for ( i = m->n_data -1  ; i >= 0; --i )
176     {
177       if ( tc > m->n - m->wvp[i]->cc)
178         k2 = i;
179     }
180
181
182   /* Calculate the percentiles */
183   ptiles (m->ptile_hash, (const struct weighted_value **) m->wvp,
184           m->n_data, m->n, m->ptile_alg);
185
186   tukey_hinges ((const struct weighted_value **) m->wvp,
187                 m->n_data, m->n, m->hinge);
188
189   /* Special case here */
190   if ( k1 + 1 == k2 )
191     {
192       m->trimmed_mean = m->wvp[k2]->v.f;
193       return;
194     }
195
196   m->trimmed_mean = 0;
197   for ( i = k1 + 2 ; i <= k2 - 1 ; ++i )
198     {
199       m->trimmed_mean += m->wvp[i]->v.f * m->wvp[i]->w;
200     }
201
202
203   m->trimmed_mean += (m->n - m->wvp[k2 - 1]->cc - tc) * m->wvp[k2]->v.f ;
204   m->trimmed_mean += (m->wvp[k1 + 1]->cc - tc) * m->wvp[k1 + 1]->v.f ;
205   m->trimmed_mean /= 0.9 * m->n ;
206
207
208 }
209
210
211 struct weighted_value *
212 weighted_value_create(void)
213 {
214   struct weighted_value *wv;
215   wv = xmalloc (sizeof *wv);
216
217   wv->cc = 0;
218   wv->case_nos = 0;
219
220   return wv;
221 }
222
223 void
224 weighted_value_free(struct weighted_value *wv)
225 {
226   struct case_node *cn ;
227
228   if ( !wv )
229     return ;
230
231   cn = wv->case_nos;
232
233   while(cn)
234     {
235       struct case_node *next = cn->next;
236
237       free(cn);
238       cn = next;
239     }
240
241   free(wv);
242
243 }
244
245
246
247
248
249 /* Create a factor statistics object with for N dependent vars
250    and ID0 and ID1 as the values of the independent variable */
251 struct factor_statistics *
252 create_factor_statistics (int n,
253                           union value *id0,
254                           union value *id1)
255 {
256   struct factor_statistics *f;
257
258   f = xmalloc (sizeof *f);
259
260   f->id[0] = id0;
261   f->id[1] = id1;
262   f->m = xnmalloc (n, sizeof *f->m);
263   memset (f->m, 0, sizeof(struct metrics) * n);
264   f->n_var = n;
265
266   return f;
267 }
268
269 void
270 metrics_destroy(struct metrics *m)
271 {
272   hsh_destroy(m->ordered_data);
273   hsh_destroy(m->ptile_hash);
274   if ( m-> histogram )
275     gsl_histogram_free(m->histogram);
276 }
277
278 void
279 factor_statistics_free(struct factor_statistics *f)
280 {
281
282   int i;
283   free (f->id[0]);
284   free (f->id[1]);
285   for ( i = 0 ; i < f->n_var; ++i )
286        metrics_destroy(&f->m[i]);
287   free(f->m) ;
288   free(f);
289 }
290
291
292 int
293 factor_statistics_compare(const struct factor_statistics *f0,
294                           const struct factor_statistics *f1, int width)
295 {
296
297   int cmp0;
298
299   assert(f0);
300   assert(f1);
301
302   cmp0 = compare_values(f0->id[0], f1->id[0], width);
303
304   if ( cmp0 != 0 )
305     return cmp0;
306
307
308   if ( ( f0->id[1]->f == SYSMIS ) && (f1->id[1]->f != SYSMIS) )
309     return 1;
310
311   if ( ( f0->id[1]->f != SYSMIS )  && (f1->id[1]->f == SYSMIS) )
312     return -1;
313
314   return compare_values (f0->id[1], f1->id[1], width);
315 }
316
317 unsigned int
318 factor_statistics_hash (const struct factor_statistics *f, int width)
319 {
320   unsigned int h;
321
322   h = hash_value (f->id[0], width);
323
324   if ( f->id[1]->f != SYSMIS )
325     h += hash_value(f->id[1], width);
326
327   return h;
328 }