1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
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.
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.
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
26 #include "dictionary.h"
28 #include "expressions/public.h"
37 /* Target of a COMPUTE or IF assignment, either a variable or a
39 static struct lvalue *lvalue_parse (void);
40 static int lvalue_get_type (const struct lvalue *);
41 static int lvalue_is_vector (const struct lvalue *);
42 static void lvalue_finalize (struct lvalue *,
43 struct compute_trns *);
44 static void lvalue_destroy (struct lvalue *);
46 /* COMPUTE and IF transformation. */
51 /* Test expression (IF only). */
52 struct expression *test; /* Test expression. */
54 /* Variable lvalue, if variable != NULL. */
55 struct variable *variable; /* Destination variable, if any. */
56 int fv; /* `value' index of destination variable. */
57 int width; /* Lvalue string width; 0=numeric. */
59 /* Vector lvalue, if vector != NULL. */
60 const struct vector *vector; /* Destination vector, if any. */
61 struct expression *element; /* Destination vector element expr. */
64 struct expression *rvalue; /* Rvalue expression. */
67 static int parse_rvalue_expression (struct compute_trns *,
68 const struct lvalue *);
69 static struct compute_trns *compute_trns_create (void);
70 static void compute_trns_free (struct trns_header *);
77 struct lvalue *lvalue = NULL;
78 struct compute_trns *compute = NULL;
80 lvalue = lvalue_parse ();
84 compute = compute_trns_create ();
86 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
89 lvalue_finalize (lvalue, compute);
91 add_transformation (&compute->h);
96 lvalue_destroy (lvalue);
99 compute_trns_free (&compute->h);
105 /* Transformation functions. */
107 /* Handle COMPUTE or IF with numeric target variable. */
109 compute_num (struct trns_header *compute_, struct ccase *c,
112 struct compute_trns *compute = (struct compute_trns *) compute_;
114 if (compute->test == NULL
115 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
116 case_data_rw (c, compute->fv)->f = expr_evaluate_num (compute->rvalue, c,
122 /* Handle COMPUTE or IF with numeric vector element target
125 compute_num_vec (struct trns_header *compute_, struct ccase *c,
128 struct compute_trns *compute = (struct compute_trns *) compute_;
130 if (compute->test == NULL
131 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
133 double index; /* Index into the vector. */
134 int rindx; /* Rounded index value. */
136 index = expr_evaluate_num (compute->element, c, case_num);
137 rindx = floor (index + EPSILON);
138 if (index == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
141 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
142 "an index into vector %s."), compute->vector->name);
144 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
145 "an index into vector %s."),
146 index, compute->vector->name);
149 case_data_rw (c, compute->vector->var[rindx - 1]->fv)->f
150 = expr_evaluate_num (compute->rvalue, c, case_num);
156 /* Handle COMPUTE or IF with string target variable. */
158 compute_str (struct trns_header *compute_, struct ccase *c,
161 struct compute_trns *compute = (struct compute_trns *) compute_;
163 if (compute->test == NULL
164 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
165 expr_evaluate_str (compute->rvalue, c, case_num,
166 case_data_rw (c, compute->fv)->s, compute->width);
171 /* Handle COMPUTE or IF with string vector element target
174 compute_str_vec (struct trns_header *compute_, struct ccase *c,
177 struct compute_trns *compute = (struct compute_trns *) compute_;
179 if (compute->test == NULL
180 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
182 double index; /* Index into the vector. */
183 int rindx; /* Rounded index value. */
184 struct variable *vr; /* Variable reference by indexed vector. */
186 index = expr_evaluate_num (compute->element, c, case_num);
187 rindx = floor (index + EPSILON);
190 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
191 "value as an index into vector %s."),
192 compute->vector->name);
195 else if (rindx < 1 || rindx > compute->vector->cnt)
197 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
198 "an index into vector %s."),
199 index, compute->vector->name);
203 vr = compute->vector->var[rindx - 1];
204 expr_evaluate_str (compute->rvalue, c, case_num,
205 case_data_rw (c, vr->fv)->s, vr->width);
216 struct compute_trns *compute = NULL;
217 struct lvalue *lvalue = NULL;
219 compute = compute_trns_create ();
221 /* Test expression. */
222 compute->test = expr_parse (default_dict, EXPR_BOOLEAN);
223 if (compute->test == NULL)
226 /* Lvalue variable. */
227 lvalue = lvalue_parse ();
231 /* Rvalue expression. */
232 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
235 lvalue_finalize (lvalue, compute);
237 add_transformation (&compute->h);
242 lvalue_destroy (lvalue);
245 compute_trns_free (&compute->h);
251 /* Code common to COMPUTE and IF. */
253 /* Checks for type mismatches on transformation C. Also checks for
254 command terminator, sets the case-handling proc from the array
257 parse_rvalue_expression (struct compute_trns *compute,
258 const struct lvalue *lvalue)
260 int type = lvalue_get_type (lvalue);
261 int vector = lvalue_is_vector (lvalue);
263 assert (type == NUMERIC || type == ALPHA);
265 compute->rvalue = expr_parse (default_dict,
266 type == ALPHA ? EXPR_STRING : EXPR_NUMBER);
267 if (compute->rvalue == NULL)
271 compute->h.proc = vector ? compute_num_vec : compute_num;
273 compute->h.proc = vector ? compute_str_vec : compute_str;
277 lex_error (_("expecting end of command"));
284 /* Returns a new struct compute_trns after initializing its fields. */
285 static struct compute_trns *
286 compute_trns_create (void)
288 struct compute_trns *compute = xmalloc (sizeof *compute);
289 compute->h.proc = NULL;
290 compute->h.free = compute_trns_free;
291 compute->test = NULL;
292 compute->variable = NULL;
293 compute->vector = NULL;
294 compute->element = NULL;
295 compute->rvalue = NULL;
299 /* Deletes all the fields in COMPUTE. */
301 compute_trns_free (struct trns_header *compute_)
303 struct compute_trns *compute = (struct compute_trns *) compute_;
305 expr_free (compute->test);
306 expr_free (compute->element);
307 expr_free (compute->rvalue);
310 /* COMPUTE or IF target variable or vector element. */
313 char var_name[9]; /* Destination variable name, or "". */
314 const struct vector *vector; /* Destination vector, if any, or NULL. */
315 struct expression *element; /* Destination vector element, or NULL. */
318 /* Parses the target variable or vector elector into a new
319 `struct lvalue', which is returned. */
320 static struct lvalue *
323 struct lvalue *lvalue;
325 lvalue = xmalloc (sizeof *lvalue);
326 lvalue->var_name[0] = '\0';
327 lvalue->vector = NULL;
328 lvalue->element = NULL;
330 if (!lex_force_id ())
333 if (lex_look_ahead () == '(')
336 lvalue->vector = dict_lookup_vector (default_dict, tokid);
337 if (lvalue->vector == NULL)
339 msg (SE, _("There is no vector named %s."), tokid);
343 /* Vector element. */
345 if (!lex_force_match ('('))
347 lvalue->element = expr_parse (default_dict, EXPR_NUMBER);
348 if (lvalue->element == NULL)
350 if (!lex_force_match (')'))
356 strncpy (lvalue->var_name, tokid, 8);
357 lvalue->var_name[8] = '\0';
363 lvalue_destroy (lvalue);
367 /* Returns the type (NUMERIC or ALPHA) of the target variable or
370 lvalue_get_type (const struct lvalue *lvalue)
372 if (lvalue->vector == NULL)
375 = dict_lookup_var (default_dict, lvalue->var_name);
382 return lvalue->vector->var[0]->type;
385 /* Returns nonzero if LVALUE has a vector as its target. */
387 lvalue_is_vector (const struct lvalue *lvalue)
389 return lvalue->vector != NULL;
392 /* Finalizes making LVALUE the target of COMPUTE, by creating the
393 target variable if necessary and setting fields in COMPUTE. */
395 lvalue_finalize (struct lvalue *lvalue,
396 struct compute_trns *compute)
398 if (lvalue->vector == NULL)
400 compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
401 if (compute->variable == NULL)
402 compute->variable = dict_create_var_assert (default_dict,
403 lvalue->var_name, 0);
405 compute->fv = compute->variable->fv;
406 compute->width = compute->variable->width;
408 /* Goofy behavior, but compatible: Turn off LEAVE. */
409 if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
410 compute->variable->reinit = 1;
414 compute->vector = lvalue->vector;
415 compute->element = lvalue->element;
416 lvalue->element = NULL;
419 lvalue_destroy (lvalue);
422 /* Destroys LVALUE. */
424 lvalue_destroy (struct lvalue *lvalue)
429 expr_free (lvalue->element);