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 lex_match_id ("COMPUTE");
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. */
108 compute_num (struct trns_header *compute_, struct ccase *c,
111 struct compute_trns *compute = (struct compute_trns *) compute_;
113 if (compute->test == NULL
114 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
116 expr_evaluate (compute->rvalue, c, case_num, &c->data[compute->fv]);
123 compute_num_vec (struct trns_header *compute_, struct ccase *c,
126 struct compute_trns *compute = (struct compute_trns *) compute_;
128 if (compute->test == NULL
129 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
131 /* Index into the vector. */
134 /* Rounded index value. */
137 expr_evaluate (compute->element, c, case_num, &index);
138 rindx = floor (index.f + EPSILON);
139 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
141 if (index.f == SYSMIS)
142 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
143 "an index into vector %s."), compute->vector->name);
145 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
146 "an index into vector %s."),
147 index.f, compute->vector->name);
150 expr_evaluate (compute->rvalue, c, case_num,
151 &c->data[compute->vector->var[rindx - 1]->fv]);
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 (compute->test, c, case_num, NULL) == 1.0)
166 /* Temporary storage for string expression return value. */
169 expr_evaluate (compute->rvalue, c, case_num, &v);
170 st_bare_pad_len_copy (c->data[compute->fv].s, &v.c[1], compute->width,
178 compute_str_vec (struct trns_header *compute_, struct ccase *c,
181 struct compute_trns *compute = (struct compute_trns *) compute_;
183 if (compute->test == NULL
184 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
186 /* Temporary storage for string expression return value. */
189 /* Index into the vector. */
192 /* Rounded index value. */
195 /* Variable reference by indexed vector. */
198 expr_evaluate (compute->element, c, case_num, &index);
199 rindx = floor (index.f + EPSILON);
200 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
202 if (index.f == SYSMIS)
203 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
204 "value as an index into vector %s."),
205 compute->vector->name);
207 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
208 "an index into vector %s."),
209 index.f, compute->vector->name);
213 expr_evaluate (compute->rvalue, c, case_num, &v);
214 vr = compute->vector->var[rindx - 1];
215 st_bare_pad_len_copy (c->data[vr->fv].s, &v.c[1], vr->width, v.c[0]);
226 struct compute_trns *compute = NULL;
227 struct lvalue *lvalue = NULL;
230 compute = compute_trns_create ();
232 /* Test expression. */
233 compute->test = expr_parse (PXP_BOOLEAN);
234 if (compute->test == NULL)
237 /* Lvalue variable. */
238 lvalue = lvalue_parse ();
242 /* Rvalue expression. */
243 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
246 lvalue_finalize (lvalue, compute);
248 add_transformation (&compute->h);
253 lvalue_destroy (lvalue);
256 compute_trns_free (&compute->h);
262 /* Code common to COMPUTE and IF. */
264 /* Checks for type mismatches on transformation C. Also checks for
265 command terminator, sets the case-handling proc from the array
268 parse_rvalue_expression (struct compute_trns *compute,
269 const struct lvalue *lvalue)
271 int type = lvalue_get_type (lvalue);
272 int vector = lvalue_is_vector (lvalue);
274 assert (type == NUMERIC || type == ALPHA);
276 compute->rvalue = expr_parse (type == ALPHA ? PXP_STRING : PXP_NUMERIC);
277 if (compute->rvalue == NULL)
281 compute->h.proc = vector ? compute_num_vec : compute_num;
283 compute->h.proc = vector ? compute_str_vec : compute_str;
287 lex_error (_("expecting end of command"));
294 /* Returns a new struct compute_trns after initializing its fields. */
295 static struct compute_trns *
296 compute_trns_create (void)
298 struct compute_trns *compute = xmalloc (sizeof *compute);
299 compute->h.proc = NULL;
300 compute->h.free = compute_trns_free;
301 compute->test = NULL;
302 compute->variable = NULL;
303 compute->vector = NULL;
304 compute->element = NULL;
305 compute->rvalue = NULL;
309 /* Deletes all the fields in COMPUTE. */
311 compute_trns_free (struct trns_header *compute_)
313 struct compute_trns *compute = (struct compute_trns *) compute_;
315 expr_free (compute->test);
316 expr_free (compute->element);
317 expr_free (compute->rvalue);
322 char var_name[9]; /* Destination variable name, or "". */
323 const struct vector *vector; /* Destination vector, if any, or NULL. */
324 struct expression *element; /* Destination vector element, or NULL. */
327 static struct lvalue *
330 struct lvalue *lvalue;
332 lvalue = xmalloc (sizeof *lvalue);
333 lvalue->var_name[0] = '\0';
334 lvalue->vector = NULL;
335 lvalue->element = NULL;
337 if (!lex_force_id ())
340 if (lex_look_ahead () == '(')
343 lvalue->vector = dict_lookup_vector (default_dict, tokid);
344 if (lvalue->vector == NULL)
346 msg (SE, _("There is no vector named %s."), tokid);
350 /* Vector element. */
352 if (!lex_force_match ('('))
354 lvalue->element = expr_parse (PXP_NUMERIC);
355 if (lvalue->element == NULL)
357 if (!lex_force_match (')'))
363 strncpy (lvalue->var_name, tokid, 8);
364 lvalue->var_name[8] = '\0';
370 lvalue_destroy (lvalue);
375 lvalue_get_type (const struct lvalue *lvalue)
377 if (lvalue->vector == NULL)
380 = dict_lookup_var (default_dict, lvalue->var_name);
387 return lvalue->vector->var[0]->type;
391 lvalue_is_vector (const struct lvalue *lvalue)
393 return lvalue->vector != NULL;
397 lvalue_finalize (struct lvalue *lvalue,
398 struct compute_trns *compute)
400 if (lvalue->vector == NULL)
402 compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
403 if (compute->variable == NULL)
404 compute->variable = dict_create_var_assert (default_dict,
405 lvalue->var_name, 0);
407 compute->fv = compute->variable->fv;
408 compute->width = compute->variable->width;
412 /* Goofy behavior, but compatible: Turn off LEAVE. */
413 if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
414 compute->variable->reinit = 1;
418 compute->vector = lvalue->vector;
419 compute->element = lvalue->element;
420 lvalue->element = NULL;
423 lvalue_destroy (lvalue);
427 lvalue_destroy (struct lvalue *lvalue)
429 expr_free (lvalue->element);
438 struct expression *expr;
440 lex_match_id ("EVALUATE");
441 expr = expr_parse (PXP_DUMP);
448 msg (SE, _("Extra characters after expression."));