Fixed bug reporting the significance of paired value t-test.
[pspp-builds.git] / src / language / stats / autorecode.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000 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 <stdlib.h>
19
20 #include <data/case.h>
21 #include <data/casereader.h>
22 #include <data/dictionary.h>
23 #include <data/procedure.h>
24 #include <data/transformations.h>
25 #include <data/variable.h>
26 #include <language/command.h>
27 #include <language/lexer/lexer.h>
28 #include <language/lexer/variable-parser.h>
29 #include <libpspp/compiler.h>
30 #include <libpspp/hash.h>
31 #include <libpspp/message.h>
32 #include <libpspp/pool.h>
33 #include <libpspp/str.h>
34
35 #include "xalloc.h"
36
37 #include "gettext.h"
38 #define _(msgid) gettext (msgid)
39
40 /* FIXME: Implement PRINT subcommand. */
41
42 /* An AUTORECODE variable's original value. */
43 union arc_value
44   {
45     double f;                   /* Numeric. */
46     char *c;                    /* Short or long string. */
47   };
48
49 /* Explains how to recode one value.  `from' must be first element.  */
50 struct arc_item
51   {
52     union arc_value from;       /* Original value. */
53     double to;                  /* Recoded value. */
54   };
55
56 /* Explains how to recode an AUTORECODE variable. */
57 struct arc_spec
58   {
59     const struct variable *src; /* Source variable. */
60     struct variable *dest;      /* Target variable. */
61     struct hsh_table *items;    /* Hash table of `freq's. */
62   };
63
64 /* AUTORECODE transformation. */
65 struct autorecode_trns
66   {
67     struct pool *pool;          /* Contains AUTORECODE specs. */
68     struct arc_spec *specs;     /* AUTORECODE specifications. */
69     size_t spec_cnt;            /* Number of specifications. */
70   };
71
72 /* Descending or ascending sort order. */
73 enum direction
74   {
75     ASCENDING,
76     DESCENDING
77   };
78
79 /* AUTORECODE data. */
80 struct autorecode_pgm
81   {
82     const struct variable **src_vars;    /* Source variables. */
83     char **dst_names;              /* Target variable names. */
84     struct variable **dst_vars;    /* Target variables. */
85     struct hsh_table **src_values; /* `union arc_value's of source vars. */
86     size_t var_cnt;                /* Number of variables. */
87     struct pool *src_values_pool;  /* Pool used by src_values. */
88     enum direction direction;      /* Sort order. */
89     int print;                     /* Print mapping table if nonzero. */
90   };
91
92 static trns_proc_func autorecode_trns_proc;
93 static trns_free_func autorecode_trns_free;
94 static hsh_compare_func compare_alpha_value, compare_numeric_value;
95 static hsh_hash_func hash_alpha_value, hash_numeric_value;
96
97 static void recode (struct dataset *, const struct autorecode_pgm *);
98 static void arc_free (struct autorecode_pgm *);
99
100 /* Performs the AUTORECODE procedure. */
101 int
102 cmd_autorecode (struct lexer *lexer, struct dataset *ds)
103 {
104   struct autorecode_pgm arc;
105   struct casereader *input;
106   struct ccase c;
107   size_t dst_cnt;
108   size_t i;
109   bool ok;
110
111   arc.src_vars = NULL;
112   arc.dst_names = NULL;
113   arc.dst_vars = NULL;
114   arc.src_values = NULL;
115   arc.var_cnt = 0;
116   arc.src_values_pool = NULL;
117   arc.direction = ASCENDING;
118   arc.print = 0;
119   dst_cnt = 0;
120
121   lex_match_id (lexer, "VARIABLES");
122   lex_match (lexer, '=');
123   if (!parse_variables_const (lexer, dataset_dict (ds), &arc.src_vars,
124                               &arc.var_cnt,
125                         PV_NO_DUPLICATE))
126     goto lossage;
127   if (!lex_force_match_id (lexer, "INTO"))
128     goto lossage;
129   lex_match (lexer, '=');
130   if (!parse_DATA_LIST_vars (lexer, &arc.dst_names, &dst_cnt, PV_NONE))
131     goto lossage;
132   if (dst_cnt != arc.var_cnt)
133     {
134       size_t i;
135
136       msg (SE, _("Source variable count (%zu) does not match "
137                  "target variable count (%zu)."),
138            arc.var_cnt, dst_cnt);
139
140       for (i = 0; i < dst_cnt; i++)
141         free (arc.dst_names[i]);
142       free (arc.dst_names);
143       arc.dst_names = NULL;
144
145       goto lossage;
146     }
147   while (lex_match (lexer, '/'))
148     if (lex_match_id (lexer, "DESCENDING"))
149       arc.direction = DESCENDING;
150     else if (lex_match_id (lexer, "PRINT"))
151       arc.print = 1;
152   if (lex_token (lexer) != '.')
153     {
154       lex_error (lexer, _("expecting end of command"));
155       goto lossage;
156     }
157
158   for (i = 0; i < arc.var_cnt; i++)
159     {
160       int j;
161
162       if (dict_lookup_var (dataset_dict (ds), arc.dst_names[i]) != NULL)
163         {
164           msg (SE, _("Target variable %s duplicates existing variable %s."),
165                arc.dst_names[i], arc.dst_names[i]);
166           goto lossage;
167         }
168       for (j = 0; j < i; j++)
169         if (!strcasecmp (arc.dst_names[i], arc.dst_names[j]))
170           {
171             msg (SE, _("Duplicate variable name %s among target variables."),
172                  arc.dst_names[i]);
173             goto lossage;
174           }
175     }
176
177   arc.src_values_pool = pool_create ();
178   arc.dst_vars = xnmalloc (arc.var_cnt, sizeof *arc.dst_vars);
179   arc.src_values = xnmalloc (arc.var_cnt, sizeof *arc.src_values);
180   for (i = 0; i < dst_cnt; i++)
181     {
182         /* FIXME: consolodate this hsh_create */
183     if (var_is_alpha (arc.src_vars[i]))
184       arc.src_values[i] = hsh_create (10, compare_alpha_value,
185                                       hash_alpha_value, NULL, arc.src_vars[i]);
186     else
187       arc.src_values[i] = hsh_create (10, compare_numeric_value,
188                                       hash_numeric_value, NULL, NULL);
189    }
190
191   input = proc_open (ds);
192   for (; casereader_read (input, &c); case_destroy (&c))
193     for (i = 0; i < arc.var_cnt; i++)
194       {
195         union arc_value v, *vp, **vpp;
196
197         if (var_is_numeric (arc.src_vars[i]))
198           v.f = case_num (&c, arc.src_vars[i]);
199         else
200           v.c = (char *) case_str (&c, arc.src_vars[i]);
201
202         vpp = (union arc_value **) hsh_probe (arc.src_values[i], &v);
203         if (*vpp == NULL)
204           {
205             vp = pool_alloc (arc.src_values_pool, sizeof *vp);
206             if (var_is_numeric (arc.src_vars[i]))
207               vp->f = v.f;
208             else
209               vp->c = pool_clone (arc.src_values_pool,
210                                   v.c, var_get_width (arc.src_vars[i]));
211             *vpp = vp;
212           }
213       }
214   ok = casereader_destroy (input);
215   ok = proc_commit (ds) && ok;
216
217   for (i = 0; i < arc.var_cnt; i++)
218     arc.dst_vars[i] = dict_create_var_assert (dataset_dict (ds),
219                                               arc.dst_names[i], 0);
220
221   recode (ds, &arc);
222   arc_free (&arc);
223   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
224
225 lossage:
226   arc_free (&arc);
227   return CMD_CASCADING_FAILURE;
228 }
229
230 static void
231 arc_free (struct autorecode_pgm *arc)
232 {
233   free (arc->src_vars);
234   if (arc->dst_names != NULL)
235     {
236       size_t i;
237
238       for (i = 0; i < arc->var_cnt; i++)
239         free (arc->dst_names[i]);
240       free (arc->dst_names);
241     }
242   free (arc->dst_vars);
243   if (arc->src_values != NULL)
244     {
245       size_t i;
246
247       for (i = 0; i < arc->var_cnt; i++)
248         hsh_destroy (arc->src_values[i]);
249       free (arc->src_values);
250     }
251   pool_destroy (arc->src_values_pool);
252 }
253
254 \f
255 /* AUTORECODE transformation. */
256
257 static void
258 recode (struct dataset *ds, const struct autorecode_pgm *arc)
259 {
260   struct autorecode_trns *trns;
261   size_t i;
262
263   trns = pool_create_container (struct autorecode_trns, pool);
264   trns->specs = pool_nalloc (trns->pool, arc->var_cnt, sizeof *trns->specs);
265   trns->spec_cnt = arc->var_cnt;
266   for (i = 0; i < arc->var_cnt; i++)
267     {
268       struct arc_spec *spec = &trns->specs[i];
269       void *const *p = hsh_sort (arc->src_values[i]);
270       int count = hsh_count (arc->src_values[i]);
271       int j;
272
273       spec->src = arc->src_vars[i];
274       spec->dest = arc->dst_vars[i];
275
276       if (var_is_alpha (arc->src_vars[i]))
277         spec->items = hsh_create (2 * count, compare_alpha_value,
278                                   hash_alpha_value, NULL, arc->src_vars[i]);
279       else
280         spec->items = hsh_create (2 * count, compare_numeric_value,
281                                   hash_numeric_value, NULL, NULL);
282
283       for (j = 0; *p; p++, j++)
284         {
285           struct arc_item *item = pool_alloc (trns->pool, sizeof *item);
286           union arc_value *vp = *p;
287
288           if (var_is_numeric (arc->src_vars[i]))
289             item->from.f = vp->f;
290           else
291             item->from.c = pool_clone (trns->pool, vp->c,
292                                        var_get_width (arc->src_vars[i]));
293           item->to = arc->direction == ASCENDING ? j + 1 : count - j;
294           hsh_force_insert (spec->items, item);
295         }
296     }
297   add_transformation (ds,
298                       autorecode_trns_proc, autorecode_trns_free, trns);
299 }
300
301 /* Executes an AUTORECODE transformation. */
302 static int
303 autorecode_trns_proc (void *trns_, struct ccase *c, casenumber case_idx UNUSED)
304 {
305   struct autorecode_trns *trns = trns_;
306   size_t i;
307
308   for (i = 0; i < trns->spec_cnt; i++)
309     {
310       struct arc_spec *spec = &trns->specs[i];
311       struct arc_item *item;
312       union arc_value v;
313
314       if (var_is_numeric (spec->src))
315         v.f = case_num (c, spec->src);
316       else
317         v.c = (char *) case_str (c, spec->src);
318       item = hsh_force_find (spec->items, &v);
319
320       case_data_rw (c, spec->dest)->f = item->to;
321     }
322   return TRNS_CONTINUE;
323 }
324
325 /* Frees an AUTORECODE transformation. */
326 static bool
327 autorecode_trns_free (void *trns_)
328 {
329   struct autorecode_trns *trns = trns_;
330   size_t i;
331
332   for (i = 0; i < trns->spec_cnt; i++)
333     hsh_destroy (trns->specs[i].items);
334   pool_destroy (trns->pool);
335   return true;
336 }
337 \f
338 /* AUTORECODE procedure. */
339
340 static int
341 compare_alpha_value (const void *a_, const void *b_, const void *v_)
342 {
343   const union arc_value *a = a_;
344   const union arc_value *b = b_;
345   const struct variable *v = v_;
346
347   return memcmp (a->c, b->c, var_get_width (v));
348 }
349
350 static unsigned
351 hash_alpha_value (const void *a_, const void *v_)
352 {
353   const union arc_value *a = a_;
354   const struct variable *v = v_;
355
356   return hsh_hash_bytes (a->c, var_get_width (v));
357 }
358
359 static int
360 compare_numeric_value (const void *a_, const void *b_, const void *aux UNUSED)
361 {
362   const union arc_value *a = a_;
363   const union arc_value *b = b_;
364
365   return a->f < b->f ? -1 : a->f > b->f;
366 }
367
368 static unsigned
369 hash_numeric_value (const void *a_, const void *aux UNUSED)
370 {
371   const union arc_value *a = a_;
372
373   return hsh_hash_double (a->f);
374 }