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