Revise.
[pspp] / src / count.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
5    This program is free software; you can redistribute it and/or
6    modify it under the terms of the GNU General Public License as
7    published by the Free Software Foundation; either version 2 of the
8    License, or (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful, but
11    WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21 #include "error.h"
22 #include <stdlib.h>
23 #include "alloc.h"
24 #include "case.h"
25 #include "command.h"
26 #include "dictionary.h"
27 #include "error.h"
28 #include "lexer.h"
29 #include "str.h"
30 #include "var.h"
31
32 #include "gettext.h"
33 #define _(msgid) gettext (msgid)
34
35 /* Implementation details:
36
37    The S?SS manuals do not specify the order that COUNT subcommands are
38    performed in.  Experiments, however, have shown that they are performed
39    in the order that they are specified in, rather than simultaneously.
40    So, with the two variables A and B, and the two cases,
41
42    A B
43    1 2
44    2 1
45
46    the command COUNT A=A B (1) / B=A B (2) will produce the following
47    results,
48
49    A B
50    1 1
51    1 0
52
53    rather than the results that would be produced if subcommands were
54    simultaneous:
55
56    A B
57    1 1
58    1 1
59
60    Perhaps simultaneity could be implemented as an option.  On the
61    other hand, what good are the above commands?  */
62 \f
63 /* Definitions. */
64
65 enum
66   {
67     CNT_ERROR,                  /* Invalid value. */
68     CNT_SINGLE,                 /* Single value. */
69     CNT_HIGH,                   /* x >= a. */
70     CNT_LOW,                    /* x <= a. */
71     CNT_RANGE,                  /* a <= x <= b. */
72     CNT_ANY,                    /* Count any. */
73     CNT_SENTINEL                /* List terminator. */
74   };
75
76 struct cnt_num
77   {
78     int type;
79     double a, b;
80   };
81
82 struct cnt_str
83   {
84     int type;
85     char *s;
86   };
87
88 struct counting
89   {
90     struct counting *next;
91
92     /* variables to count */
93     struct variable **v;
94     int n;
95
96     /* values to count */
97     int missing;                /* (numeric only)
98                                    0=don't count missing,
99                                    1=count SYSMIS,
100                                    2=count system- and user-missing */
101     union                       /* Criterion values. */
102       {
103         struct cnt_num *n;
104         struct cnt_str *s;
105       }
106     crit;
107   };
108
109 struct cnt_var_info
110   {
111     struct cnt_var_info *next;
112
113     struct variable *d;         /* Destination variable. */
114     char n[LONG_NAME_LEN + 1];  /* Name of dest var. */
115
116     struct counting *c;         /* The counting specifications. */
117   };
118
119 struct count_trns
120   {
121     struct trns_header h;
122     struct cnt_var_info *specs;
123   };
124 \f
125 /* Parser. */
126
127 static trns_proc_func count_trns_proc;
128 static trns_free_func count_trns_free;
129
130 static int parse_numeric_criteria (struct counting *);
131 static int parse_string_criteria (struct counting *);
132
133 int
134 cmd_count (void)
135 {
136   struct cnt_var_info *cnt;     /* Specification currently being parsed. */
137   struct counting *c;           /* Counting currently being parsed. */
138   int ret;                      /* Return value from parsing function. */
139   struct count_trns *trns;      /* Transformation. */
140   struct cnt_var_info *head;    /* First counting in chain. */
141
142   /* Parses each slash-delimited specification. */
143   head = cnt = xmalloc (sizeof *cnt);
144   for (;;)
145     {
146       /* Initialize this struct cnt_var_info to ensure proper cleanup. */
147       cnt->next = NULL;
148       cnt->d = NULL;
149       cnt->c = NULL;
150
151       /* Get destination variable, or at least its name. */
152       if (!lex_force_id ())
153         goto fail;
154       cnt->d = dict_lookup_var (default_dict, tokid);
155       if (cnt->d)
156         {
157           if (cnt->d->type == ALPHA)
158             {
159               msg (SE, _("Destination cannot be a string variable."));
160               goto fail;
161             }
162         }
163       else
164         str_copy_trunc (cnt->n, sizeof cnt->n, tokid);
165
166       lex_get ();
167       if (!lex_force_match ('='))
168         goto fail;
169
170       c = cnt->c = xmalloc (sizeof *c);
171       for (;;)
172         {
173           c->next = NULL;
174           c->v = NULL;
175           if (!parse_variables (default_dict, &c->v, &c->n,
176                                 PV_DUPLICATE | PV_SAME_TYPE))
177             goto fail;
178
179           if (!lex_force_match ('('))
180             goto fail;
181
182           ret = (c->v[0]->type == NUMERIC
183                  ? parse_numeric_criteria
184                  : parse_string_criteria) (c);
185           if (!ret)
186             goto fail;
187
188           if (token == '/' || token == '.')
189             break;
190
191           c = c->next = xmalloc (sizeof *c);
192         }
193
194       if (token == '.')
195         break;
196
197       if (!lex_force_match ('/'))
198         goto fail;
199       cnt = cnt->next = xmalloc (sizeof *cnt);
200     }
201
202   /* Create all the nonexistent destination variables. */
203   for (cnt = head; cnt; cnt = cnt->next)
204     if (!cnt->d)
205       {
206         /* It's valid, though motivationally questionable, to count to
207            the same dest var more than once. */
208         cnt->d = dict_lookup_var (default_dict, cnt->n);
209
210         if (cnt->d == NULL) 
211           cnt->d = dict_create_var_assert (default_dict, cnt->n, 0);
212       }
213
214   trns = xmalloc (sizeof *trns);
215   trns->h.proc = count_trns_proc;
216   trns->h.free = count_trns_free;
217   trns->specs = head;
218   add_transformation ((struct trns_header *) trns);
219
220   return CMD_SUCCESS;
221
222 fail:
223   {
224     struct count_trns t;
225     t.specs = head;
226     count_trns_free ((struct trns_header *) & t);
227     return CMD_FAILURE;
228   }
229 }
230
231 /* Parses a set of numeric criterion values. */
232 static int
233 parse_numeric_criteria (struct counting * c)
234 {
235   int n = 0;
236   int m = 0;
237
238   c->crit.n = 0;
239   c->missing = 0;
240   for (;;)
241     {
242       struct cnt_num *cur;
243       if (n >= m - 1)
244         {
245           m += 16;
246           c->crit.n = xrealloc (c->crit.n, m * sizeof (struct cnt_num));
247         }
248
249       cur = &c->crit.n[n++];
250       if (lex_is_number ())
251         {
252           cur->a = tokval;
253           lex_get ();
254           if (lex_match_id ("THRU"))
255             {
256               if (lex_is_number ())
257                 {
258                   if (!lex_force_num ())
259                     return 0;
260                   cur->b = tokval;
261                   cur->type = CNT_RANGE;
262                   lex_get ();
263
264                   if (cur->a > cur->b)
265                     {
266                       msg (SE, _("%g THRU %g is not a valid range.  The "
267                                  "number following THRU must be at least "
268                                  "as big as the number preceding THRU."),
269                            cur->a, cur->b);
270                       return 0;
271                     }
272                 }
273               else if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
274                 cur->type = CNT_HIGH;
275               else
276                 {
277                   lex_error (NULL);
278                   return 0;
279                 }
280             }
281           else
282             cur->type = CNT_SINGLE;
283         }
284       else if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
285         {
286           if (!lex_force_match_id ("THRU"))
287             return 0;
288           if (lex_is_number ())
289             {
290               cur->type = CNT_LOW;
291               cur->a = tokval;
292               lex_get ();
293             }
294           else if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
295             cur->type = CNT_ANY;
296           else
297             {
298               lex_error (NULL);
299               return 0;
300             }
301         }
302       else if (lex_match_id ("SYSMIS"))
303         {
304           if (c->missing < 1)
305             c->missing = 1;
306         }
307       else if (lex_match_id ("MISSING"))
308         c->missing = 2;
309       else
310         {
311           lex_error (NULL);
312           return 0;
313         }
314
315       lex_match (',');
316       if (lex_match (')'))
317         break;
318     }
319
320   c->crit.n[n].type = CNT_SENTINEL;
321   return 1;
322 }
323
324 /* Parses a set of string criteria values.  The skeleton is the same
325    as parse_numeric_criteria(). */
326 static int
327 parse_string_criteria (struct counting * c)
328 {
329   int len = 0;
330
331   int n = 0;
332   int m = 0;
333
334   int i;
335
336   for (i = 0; i < c->n; i++)
337     if (c->v[i]->width > len)
338       len = c->v[i]->width;
339
340   c->crit.n = 0;
341   for (;;)
342     {
343       struct cnt_str *cur;
344       if (n >= m - 1)
345         {
346           m += 16;
347           c->crit.n = xrealloc (c->crit.n, m * sizeof (struct cnt_str));
348         }
349
350       if (!lex_force_string ())
351         return 0;
352       cur = &c->crit.s[n++];
353       cur->type = CNT_SINGLE;
354       cur->s = malloc (len + 1);
355       str_copy_rpad (cur->s, len + 1, ds_c_str (&tokstr));
356       lex_get ();
357
358       lex_match (',');
359       if (lex_match (')'))
360         break;
361     }
362
363   c->crit.s[n].type = CNT_SENTINEL;
364   return 1;
365 }
366 \f
367 /* Transformation. */
368
369 /* Counts the number of values in case C matching counting CNT. */
370 static inline int
371 count_numeric (struct counting * cnt, struct ccase * c)
372 {
373   int counter = 0;
374   int i;
375
376   for (i = 0; i < cnt->n; i++)
377     {
378       struct cnt_num *num;
379
380       /* Extract the variable value and eliminate missing values. */
381       double cmp = case_num (c, cnt->v[i]->fv);
382       if (cmp == SYSMIS)
383         {
384           if (cnt->missing >= 1)
385             counter++;
386           continue;
387         }
388       if (cnt->missing >= 2 && is_num_user_missing (cmp, cnt->v[i]))
389         {
390           counter++;
391           continue;
392         }
393
394       /* Try to find the value in the list. */
395       for (num = cnt->crit.n;; num++)
396         switch (num->type)
397           {
398           case CNT_ERROR:
399             assert (0);
400             break;
401           case CNT_SINGLE:
402             if (cmp != num->a)
403               break;
404             counter++;
405             goto done;
406           case CNT_HIGH:
407             if (cmp < num->a)
408               break;
409             counter++;
410             goto done;
411           case CNT_LOW:
412             if (cmp > num->a)
413               break;
414             counter++;
415             goto done;
416           case CNT_RANGE:
417             if (cmp < num->a || cmp > num->b)
418               break;
419             counter++;
420             goto done;
421           case CNT_ANY:
422             counter++;
423             goto done;
424           case CNT_SENTINEL:
425             goto done;
426           default:
427             assert (0);
428           }
429     done: ;
430     }
431   return counter;
432 }
433
434 /* Counts the number of values in case C matching counting CNT. */
435 static inline int
436 count_string (struct counting * cnt, struct ccase * c)
437 {
438   int counter = 0;
439   int i;
440
441   for (i = 0; i < cnt->n; i++)
442     {
443       struct cnt_str *str;
444
445       /* Extract the variable value, variable width. */
446       for (str = cnt->crit.s;; str++)
447         switch (str->type)
448           {
449           case CNT_ERROR:
450             assert (0);
451           case CNT_SINGLE:
452             if (memcmp (case_str (c, cnt->v[i]->fv), str->s,
453                         cnt->v[i]->width))
454               break;
455             counter++;
456             goto done;
457           case CNT_SENTINEL:
458             goto done;
459           default:
460             assert (0);
461           }
462     done: ;
463     }
464   return counter;
465 }
466
467 /* Performs the COUNT transformation T on case C. */
468 static int
469 count_trns_proc (struct trns_header * trns, struct ccase * c,
470                  int case_num UNUSED)
471 {
472   struct cnt_var_info *info;
473   struct counting *cnt;
474   int counter;
475
476   for (info = ((struct count_trns *) trns)->specs; info; info = info->next)
477     {
478       counter = 0;
479       for (cnt = info->c; cnt; cnt = cnt->next)
480         if (cnt->v[0]->type == NUMERIC)
481           counter += count_numeric (cnt, c);
482         else
483           counter += count_string (cnt, c);
484       case_data_rw (c, info->d->fv)->f = counter;
485     }
486   return -1;
487 }
488
489 /* Destroys all dynamic data structures associated with T. */
490 static void
491 count_trns_free (struct trns_header * t)
492 {
493   struct cnt_var_info *iter, *next;
494
495   for (iter = ((struct count_trns *) t)->specs; iter; iter = next)
496     {
497       struct counting *i, *n;
498
499       for (i = iter->c; i; i = n)
500         {
501           if (i->n && i->v)
502             {
503               if (i->v[0]->type == NUMERIC)
504                 free (i->crit.n);
505               else
506                 {
507                   struct cnt_str *s;
508
509                   for (s = i->crit.s; s->type != CNT_SENTINEL; s++)
510                     free (s->s);
511                   free (i->crit.s);
512                 }
513             }
514           free (i->v);
515
516           n = i->next;
517           free (i);
518         }
519
520       next = iter->next;
521       free (iter);
522     }
523 }