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
35 /* Target of a COMPUTE or IF assignment, either a variable or a
37 static struct lvalue *lvalue_parse (void);
38 static int lvalue_get_type (const struct lvalue *);
39 static int lvalue_is_vector (const struct lvalue *);
40 static void lvalue_finalize (struct lvalue *,
41 struct compute_trns *);
42 static void lvalue_destroy (struct lvalue *);
44 /* COMPUTE and IF transformation. */
49 /* Test expression (IF only). */
50 struct expression *test; /* Test expression. */
52 /* Variable lvalue, if variable != NULL. */
53 struct variable *variable; /* Destination variable, if any. */
54 int fv; /* `value' index of destination variable. */
55 int width; /* Lvalue string width; 0=numeric. */
57 /* Vector lvalue, if vector != NULL. */
58 const struct vector *vector; /* Destination vector, if any. */
59 struct expression *element; /* Destination vector element expr. */
62 struct expression *rvalue; /* Rvalue expression. */
65 static int parse_rvalue_expression (struct compute_trns *,
66 const struct lvalue *);
67 static struct compute_trns *compute_trns_create (void);
68 static void compute_trns_free (struct trns_header *);
75 struct lvalue *lvalue = NULL;
76 struct compute_trns *compute = NULL;
78 lvalue = lvalue_parse ();
82 compute = compute_trns_create ();
84 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
87 lvalue_finalize (lvalue, compute);
89 add_transformation (&compute->h);
94 lvalue_destroy (lvalue);
97 compute_trns_free (&compute->h);
103 /* Transformation functions. */
105 /* Handle COMPUTE or IF with numeric target variable. */
107 compute_num (struct trns_header *compute_, struct ccase *c,
110 struct compute_trns *compute = (struct compute_trns *) compute_;
112 if (compute->test == NULL
113 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
115 expr_evaluate (compute->rvalue, c, case_num, &c->data[compute->fv]);
121 /* Handle COMPUTE or IF with numeric vector element target
124 compute_num_vec (struct trns_header *compute_, struct ccase *c,
127 struct compute_trns *compute = (struct compute_trns *) compute_;
129 if (compute->test == NULL
130 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
132 /* Index into the vector. */
135 /* Rounded index value. */
138 expr_evaluate (compute->element, c, case_num, &index);
139 rindx = floor (index.f + EPSILON);
140 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
142 if (index.f == SYSMIS)
143 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
144 "an index into vector %s."), compute->vector->name);
146 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
147 "an index into vector %s."),
148 index.f, compute->vector->name);
151 expr_evaluate (compute->rvalue, c, case_num,
152 &c->data[compute->vector->var[rindx - 1]->fv]);
158 /* Handle COMPUTE or IF with string target variable. */
160 compute_str (struct trns_header *compute_, struct ccase *c,
163 struct compute_trns *compute = (struct compute_trns *) compute_;
165 if (compute->test == NULL
166 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
168 /* Temporary storage for string expression return value. */
171 expr_evaluate (compute->rvalue, c, case_num, &v);
172 st_bare_pad_len_copy (c->data[compute->fv].s, &v.c[1], compute->width,
179 /* Handle COMPUTE or IF with string vector element target
182 compute_str_vec (struct trns_header *compute_, struct ccase *c,
185 struct compute_trns *compute = (struct compute_trns *) compute_;
187 if (compute->test == NULL
188 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
190 /* Temporary storage for string expression return value. */
193 /* Index into the vector. */
196 /* Rounded index value. */
199 /* Variable reference by indexed vector. */
202 expr_evaluate (compute->element, c, case_num, &index);
203 rindx = floor (index.f + EPSILON);
204 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
206 if (index.f == SYSMIS)
207 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
208 "value as an index into vector %s."),
209 compute->vector->name);
211 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
212 "an index into vector %s."),
213 index.f, compute->vector->name);
217 expr_evaluate (compute->rvalue, c, case_num, &v);
218 vr = compute->vector->var[rindx - 1];
219 st_bare_pad_len_copy (c->data[vr->fv].s, &v.c[1], vr->width, v.c[0]);
230 struct compute_trns *compute = NULL;
231 struct lvalue *lvalue = NULL;
233 compute = compute_trns_create ();
235 /* Test expression. */
236 compute->test = expr_parse (PXP_BOOLEAN);
237 if (compute->test == NULL)
240 /* Lvalue variable. */
241 lvalue = lvalue_parse ();
245 /* Rvalue expression. */
246 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
249 lvalue_finalize (lvalue, compute);
251 add_transformation (&compute->h);
256 lvalue_destroy (lvalue);
259 compute_trns_free (&compute->h);
265 /* Code common to COMPUTE and IF. */
267 /* Checks for type mismatches on transformation C. Also checks for
268 command terminator, sets the case-handling proc from the array
271 parse_rvalue_expression (struct compute_trns *compute,
272 const struct lvalue *lvalue)
274 int type = lvalue_get_type (lvalue);
275 int vector = lvalue_is_vector (lvalue);
277 assert (type == NUMERIC || type == ALPHA);
279 compute->rvalue = expr_parse (type == ALPHA ? PXP_STRING : PXP_NUMERIC);
280 if (compute->rvalue == NULL)
284 compute->h.proc = vector ? compute_num_vec : compute_num;
286 compute->h.proc = vector ? compute_str_vec : compute_str;
290 lex_error (_("expecting end of command"));
297 /* Returns a new struct compute_trns after initializing its fields. */
298 static struct compute_trns *
299 compute_trns_create (void)
301 struct compute_trns *compute = xmalloc (sizeof *compute);
302 compute->h.proc = NULL;
303 compute->h.free = compute_trns_free;
304 compute->test = NULL;
305 compute->variable = NULL;
306 compute->vector = NULL;
307 compute->element = NULL;
308 compute->rvalue = NULL;
312 /* Deletes all the fields in COMPUTE. */
314 compute_trns_free (struct trns_header *compute_)
316 struct compute_trns *compute = (struct compute_trns *) compute_;
318 expr_free (compute->test);
319 expr_free (compute->element);
320 expr_free (compute->rvalue);
323 /* COMPUTE or IF target variable or vector element. */
326 char var_name[9]; /* Destination variable name, or "". */
327 const struct vector *vector; /* Destination vector, if any, or NULL. */
328 struct expression *element; /* Destination vector element, or NULL. */
331 /* Parses the target variable or vector elector into a new
332 `struct lvalue', which is returned. */
333 static struct lvalue *
336 struct lvalue *lvalue;
338 lvalue = xmalloc (sizeof *lvalue);
339 lvalue->var_name[0] = '\0';
340 lvalue->vector = NULL;
341 lvalue->element = NULL;
343 if (!lex_force_id ())
346 if (lex_look_ahead () == '(')
349 lvalue->vector = dict_lookup_vector (default_dict, tokid);
350 if (lvalue->vector == NULL)
352 msg (SE, _("There is no vector named %s."), tokid);
356 /* Vector element. */
358 if (!lex_force_match ('('))
360 lvalue->element = expr_parse (PXP_NUMERIC);
361 if (lvalue->element == NULL)
363 if (!lex_force_match (')'))
369 strncpy (lvalue->var_name, tokid, 8);
370 lvalue->var_name[8] = '\0';
376 lvalue_destroy (lvalue);
380 /* Returns the type (NUMERIC or ALPHA) of the target variable or
383 lvalue_get_type (const struct lvalue *lvalue)
385 if (lvalue->vector == NULL)
388 = dict_lookup_var (default_dict, lvalue->var_name);
395 return lvalue->vector->var[0]->type;
398 /* Returns nonzero if LVALUE has a vector as its target. */
400 lvalue_is_vector (const struct lvalue *lvalue)
402 return lvalue->vector != NULL;
405 /* Finalizes making LVALUE the target of COMPUTE, by creating the
406 target variable if necessary and setting fields in COMPUTE. */
408 lvalue_finalize (struct lvalue *lvalue,
409 struct compute_trns *compute)
411 if (lvalue->vector == NULL)
413 compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
414 if (compute->variable == NULL)
415 compute->variable = dict_create_var_assert (default_dict,
416 lvalue->var_name, 0);
418 compute->fv = compute->variable->fv;
419 compute->width = compute->variable->width;
421 /* Goofy behavior, but compatible: Turn off LEAVE. */
422 if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
423 compute->variable->reinit = 1;
427 compute->vector = lvalue->vector;
428 compute->element = lvalue->element;
429 lvalue->element = NULL;
432 lvalue_destroy (lvalue);
435 /* Destroys LVALUE. */
437 lvalue_destroy (struct lvalue *lvalue)
439 expr_free (lvalue->element);