Missing value-handling
[pspp-builds.git] / src / compute.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 "expressions/public.h"
29 #include "lexer.h"
30 #include "misc.h"
31 #include "str.h"
32 #include "var.h"
33
34 #include "gettext.h"
35 #define _(msgid) gettext (msgid)
36
37 struct compute_trns;
38 struct lvalue;
39
40 /* Target of a COMPUTE or IF assignment, either a variable or a
41    vector element. */
42 static struct lvalue *lvalue_parse (void);
43 static int lvalue_get_type (const struct lvalue *);
44 static bool lvalue_is_vector (const struct lvalue *);
45 static void lvalue_finalize (struct lvalue *,
46                              struct compute_trns *);
47 static void lvalue_destroy (struct lvalue *);
48
49 /* COMPUTE and IF transformation. */
50 struct compute_trns
51   {
52     /* Test expression (IF only). */
53     struct expression *test;     /* Test expression. */
54
55     /* Variable lvalue, if variable != NULL. */
56     struct variable *variable;   /* Destination variable, if any. */
57     int fv;                      /* `value' index of destination variable. */
58     int width;                   /* Lvalue string width; 0=numeric. */
59
60     /* Vector lvalue, if vector != NULL. */
61     const struct vector *vector; /* Destination vector, if any. */
62     struct expression *element;  /* Destination vector element expr. */
63
64     /* Rvalue. */
65     struct expression *rvalue;   /* Rvalue expression. */
66   };
67
68 static struct expression *parse_rvalue (const struct lvalue *);
69 static struct compute_trns *compute_trns_create (void);
70 static trns_proc_func *get_proc_func (const struct lvalue *);
71 static trns_free_func compute_trns_free;
72 \f
73 /* COMPUTE. */
74
75 int
76 cmd_compute (void)
77 {
78   struct lvalue *lvalue = NULL;
79   struct compute_trns *compute = NULL;
80
81   compute = compute_trns_create ();
82
83   lvalue = lvalue_parse ();
84   if (lvalue == NULL)
85     goto fail;
86
87   if (!lex_force_match ('='))
88     goto fail;
89   compute->rvalue = parse_rvalue (lvalue);
90   if (compute->rvalue == NULL)
91     goto fail;
92
93   add_transformation (get_proc_func (lvalue), compute_trns_free, compute);
94
95   lvalue_finalize (lvalue, compute);
96
97   return lex_end_of_command ();
98
99  fail:
100   lvalue_destroy (lvalue);
101   compute_trns_free (compute);
102   return CMD_FAILURE;
103 }
104 \f
105 /* Transformation functions. */
106
107 /* Handle COMPUTE or IF with numeric target variable. */
108 static int
109 compute_num (void *compute_, struct ccase *c, int case_num)
110 {
111   struct compute_trns *compute = compute_;
112
113   if (compute->test == NULL
114       || expr_evaluate_num (compute->test, c, case_num) == 1.0) 
115     case_data_rw (c, compute->fv)->f = expr_evaluate_num (compute->rvalue, c,
116                                                           case_num); 
117   
118   return -1;
119 }
120
121 /* Handle COMPUTE or IF with numeric vector element target
122    variable. */
123 static int
124 compute_num_vec (void *compute_, struct ccase *c, int case_num)
125 {
126   struct compute_trns *compute = compute_;
127
128   if (compute->test == NULL
129       || expr_evaluate_num (compute->test, c, case_num) == 1.0) 
130     {
131       double index;     /* Index into the vector. */
132       int rindx;        /* Rounded index value. */
133
134       index = expr_evaluate_num (compute->element, c, case_num);
135       rindx = floor (index + EPSILON);
136       if (index == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
137         {
138           if (index == SYSMIS)
139             msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
140                        "an index into vector %s."), compute->vector->name);
141           else
142             msg (SW, _("When executing COMPUTE: %g is not a valid value as "
143                        "an index into vector %s."),
144                  index, compute->vector->name);
145           return -1;
146         }
147       case_data_rw (c, compute->vector->var[rindx - 1]->fv)->f
148         = expr_evaluate_num (compute->rvalue, c, case_num);
149     }
150   
151   return -1;
152 }
153
154 /* Handle COMPUTE or IF with string target variable. */
155 static int
156 compute_str (void *compute_, struct ccase *c, int case_num)
157 {
158   struct compute_trns *compute = compute_;
159
160   if (compute->test == NULL
161       || expr_evaluate_num (compute->test, c, case_num) == 1.0) 
162     expr_evaluate_str (compute->rvalue, c, case_num,
163                        case_data_rw (c, compute->fv)->s, compute->width);
164   
165   return -1;
166 }
167
168 /* Handle COMPUTE or IF with string vector element target
169    variable. */
170 static int
171 compute_str_vec (void *compute_, struct ccase *c, int case_num)
172 {
173   struct compute_trns *compute = compute_;
174
175   if (compute->test == NULL
176       || expr_evaluate_num (compute->test, c, case_num) == 1.0) 
177     {
178       double index;             /* Index into the vector. */
179       int rindx;                /* Rounded index value. */
180       struct variable *vr;      /* Variable reference by indexed vector. */
181
182       index = expr_evaluate_num (compute->element, c, case_num);
183       rindx = floor (index + EPSILON);
184       if (index == SYSMIS) 
185         {
186           msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
187                      "value as an index into vector %s."),
188                compute->vector->name);
189           return -1; 
190         }
191       else if (rindx < 1 || rindx > compute->vector->cnt)
192         {
193           msg (SW, _("When executing COMPUTE: %g is not a valid value as "
194                      "an index into vector %s."),
195                index, compute->vector->name);
196           return -1;
197         }
198
199       vr = compute->vector->var[rindx - 1];
200       expr_evaluate_str (compute->rvalue, c, case_num,
201                          case_data_rw (c, vr->fv)->s, vr->width);
202     }
203   
204   return -1;
205 }
206 \f
207 /* IF. */
208
209 int
210 cmd_if (void)
211 {
212   struct compute_trns *compute = NULL;
213   struct lvalue *lvalue = NULL;
214
215   compute = compute_trns_create ();
216
217   /* Test expression. */
218   compute->test = expr_parse (default_dict, EXPR_BOOLEAN);
219   if (compute->test == NULL)
220     goto fail;
221
222   /* Lvalue variable. */
223   lvalue = lvalue_parse ();
224   if (lvalue == NULL)
225     goto fail;
226
227   /* Rvalue expression. */
228   if (!lex_force_match ('='))
229     goto fail;
230   compute->rvalue = parse_rvalue (lvalue);
231   if (compute->rvalue == NULL)
232     goto fail;
233
234   add_transformation (get_proc_func (lvalue), compute_trns_free, compute);
235
236   lvalue_finalize (lvalue, compute);
237
238   return lex_end_of_command ();
239
240  fail:
241   lvalue_destroy (lvalue);
242   compute_trns_free (compute);
243   return CMD_FAILURE;
244 }
245 \f
246 /* Code common to COMPUTE and IF. */
247
248 static trns_proc_func *
249 get_proc_func (const struct lvalue *lvalue) 
250 {
251   bool is_numeric = lvalue_get_type (lvalue) == NUMERIC;
252   bool is_vector = lvalue_is_vector (lvalue);
253
254   return (is_numeric
255           ? (is_vector ? compute_num_vec : compute_num)
256           : (is_vector ? compute_str_vec : compute_str));
257 }
258
259 /* Parses and returns an rvalue expression of the same type as
260    LVALUE, or a null pointer on failure. */
261 static struct expression *
262 parse_rvalue (const struct lvalue *lvalue)
263 {
264   bool is_numeric = lvalue_get_type (lvalue) == NUMERIC;
265
266   return expr_parse (default_dict, is_numeric ? EXPR_NUMBER : EXPR_STRING);
267 }
268
269 /* Returns a new struct compute_trns after initializing its fields. */
270 static struct compute_trns *
271 compute_trns_create (void)
272 {
273   struct compute_trns *compute = xmalloc (sizeof *compute);
274   compute->test = NULL;
275   compute->variable = NULL;
276   compute->vector = NULL;
277   compute->element = NULL;
278   compute->rvalue = NULL;
279   return compute;
280 }
281
282 /* Deletes all the fields in COMPUTE. */
283 static void
284 compute_trns_free (void *compute_)
285 {
286   struct compute_trns *compute = compute_;
287
288   if (compute != NULL) 
289     {
290       expr_free (compute->test);
291       expr_free (compute->element);
292       expr_free (compute->rvalue);
293       free (compute);
294     }
295 }
296 \f
297 /* COMPUTE or IF target variable or vector element. */
298 struct lvalue
299   {
300     char var_name[LONG_NAME_LEN + 1];   /* Destination variable name, or "". */
301     const struct vector *vector; /* Destination vector, if any, or NULL. */
302     struct expression *element;  /* Destination vector element, or NULL. */
303   };
304
305 /* Parses the target variable or vector element into a new
306    `struct lvalue', which is returned. */
307 static struct lvalue *
308 lvalue_parse (void) 
309 {
310   struct lvalue *lvalue;
311
312   lvalue = xmalloc (sizeof *lvalue);
313   lvalue->var_name[0] = '\0';
314   lvalue->vector = NULL;
315   lvalue->element = NULL;
316
317   if (!lex_force_id ())
318     goto lossage;
319   
320   if (lex_look_ahead () == '(')
321     {
322       /* Vector. */
323       lvalue->vector = dict_lookup_vector (default_dict, tokid);
324       if (lvalue->vector == NULL)
325         {
326           msg (SE, _("There is no vector named %s."), tokid);
327           goto lossage;
328         }
329
330       /* Vector element. */
331       lex_get ();
332       if (!lex_force_match ('('))
333         goto lossage;
334       lvalue->element = expr_parse (default_dict, EXPR_NUMBER);
335       if (lvalue->element == NULL)
336         goto lossage;
337       if (!lex_force_match (')'))
338         goto lossage;
339     }
340   else
341     {
342       /* Variable name. */
343       str_copy_trunc (lvalue->var_name, sizeof lvalue->var_name, tokid);
344       lex_get ();
345     }
346   return lvalue;
347
348  lossage:
349   lvalue_destroy (lvalue);
350   return NULL;
351 }
352
353 /* Returns the type (NUMERIC or ALPHA) of the target variable or
354    vector in LVALUE. */
355 static int
356 lvalue_get_type (const struct lvalue *lvalue) 
357 {
358   if (lvalue->vector == NULL) 
359     {
360       struct variable *var = dict_lookup_var (default_dict, lvalue->var_name);
361       if (var == NULL)
362         return NUMERIC;
363       else
364         return var->type;
365     }
366   else 
367     return lvalue->vector->var[0]->type;
368 }
369
370 /* Returns nonzero if LVALUE has a vector as its target. */
371 static bool
372 lvalue_is_vector (const struct lvalue *lvalue) 
373 {
374   return lvalue->vector != NULL;
375 }
376
377 /* Finalizes making LVALUE the target of COMPUTE, by creating the
378    target variable if necessary and setting fields in COMPUTE. */
379 static void
380 lvalue_finalize (struct lvalue *lvalue, struct compute_trns *compute) 
381 {
382   if (lvalue->vector == NULL)
383     {
384       compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
385       if (compute->variable == NULL)
386           compute->variable = dict_create_var_assert (default_dict,
387                                                       lvalue->var_name, 0);
388
389       compute->fv = compute->variable->fv;
390       compute->width = compute->variable->width;
391
392       /* Goofy behavior, but compatible: Turn off LEAVE. */
393       if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
394         compute->variable->reinit = 1;
395     }
396   else 
397     {
398       compute->vector = lvalue->vector;
399       compute->element = lvalue->element;
400       lvalue->element = NULL;
401     }
402
403   lvalue_destroy (lvalue);
404 }
405
406 /* Destroys LVALUE. */
407 static void 
408 lvalue_destroy (struct lvalue *lvalue) 
409 {
410   if (lvalue == NULL) 
411      return;
412
413   expr_free (lvalue->element);
414   free (lvalue);
415 }