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
36 /* Target of a COMPUTE or IF assignment, either a variable or a
38 static struct lvalue *lvalue_parse (void);
39 static int lvalue_get_type (const struct lvalue *);
40 static int lvalue_is_vector (const struct lvalue *);
41 static void lvalue_finalize (struct lvalue *,
42 struct compute_trns *);
43 static void lvalue_destroy (struct lvalue *);
45 /* COMPUTE and IF transformation. */
50 /* Test expression (IF only). */
51 struct expression *test; /* Test expression. */
53 /* Variable lvalue, if variable != NULL. */
54 struct variable *variable; /* Destination variable, if any. */
55 int fv; /* `value' index of destination variable. */
56 int width; /* Lvalue string width; 0=numeric. */
58 /* Vector lvalue, if vector != NULL. */
59 const struct vector *vector; /* Destination vector, if any. */
60 struct expression *element; /* Destination vector element expr. */
63 struct expression *rvalue; /* Rvalue expression. */
66 static int parse_rvalue_expression (struct compute_trns *,
67 const struct lvalue *);
68 static struct compute_trns *compute_trns_create (void);
69 static void compute_trns_free (struct trns_header *);
76 struct lvalue *lvalue = NULL;
77 struct compute_trns *compute = NULL;
79 lex_match_id ("COMPUTE");
81 lvalue = lvalue_parse ();
85 compute = compute_trns_create ();
87 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
90 lvalue_finalize (lvalue, compute);
92 add_transformation (&compute->h);
97 lvalue_destroy (lvalue);
100 compute_trns_free (&compute->h);
106 /* Transformation functions. */
109 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, NULL) == 1.0)
116 expr_evaluate (compute->rvalue, c, &c->data[compute->fv]);
123 compute_num_vec (struct trns_header *compute_, struct ccase *c)
125 struct compute_trns *compute = (struct compute_trns *) compute_;
127 if (compute->test == NULL
128 || expr_evaluate (compute->test, c, NULL) == 1.0)
130 /* Index into the vector. */
133 /* Rounded index value. */
136 expr_evaluate (compute->element, c, &index);
137 rindx = floor (index.f + EPSILON);
138 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
140 if (index.f == SYSMIS)
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.f, compute->vector->name);
149 expr_evaluate (compute->rvalue, c,
150 &c->data[compute->vector->var[rindx - 1]->fv]);
157 compute_str (struct trns_header *compute_, struct ccase *c)
159 struct compute_trns *compute = (struct compute_trns *) compute_;
161 if (compute->test == NULL
162 || expr_evaluate (compute->test, c, NULL) == 1.0)
164 /* Temporary storage for string expression return value. */
167 expr_evaluate (compute->rvalue, c, &v);
168 st_bare_pad_len_copy (c->data[compute->fv].s, &v.c[1], compute->width,
176 compute_str_vec (struct trns_header *compute_, struct ccase *c)
178 struct compute_trns *compute = (struct compute_trns *) compute_;
180 if (compute->test == NULL
181 || expr_evaluate (compute->test, c, NULL) == 1.0)
183 /* Temporary storage for string expression return value. */
186 /* Index into the vector. */
189 /* Rounded index value. */
192 /* Variable reference by indexed vector. */
195 expr_evaluate (compute->element, c, &index);
196 rindx = floor (index.f + EPSILON);
197 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
199 if (index.f == SYSMIS)
200 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
201 "value as an index into vector %s."),
202 compute->vector->name);
204 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
205 "an index into vector %s."),
206 index.f, compute->vector->name);
210 expr_evaluate (compute->rvalue, c, &v);
211 vr = compute->vector->var[rindx - 1];
212 st_bare_pad_len_copy (c->data[vr->fv].s, &v.c[1], vr->width, v.c[0]);
223 struct compute_trns *compute = NULL;
224 struct lvalue *lvalue = NULL;
227 compute = compute_trns_create ();
229 /* Test expression. */
230 compute->test = expr_parse (PXP_BOOLEAN);
231 if (compute->test == NULL)
234 /* Lvalue variable. */
235 lvalue = lvalue_parse ();
239 /* Rvalue expression. */
240 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
243 lvalue_finalize (lvalue, compute);
245 add_transformation (&compute->h);
250 lvalue_destroy (lvalue);
253 compute_trns_free (&compute->h);
259 /* Code common to COMPUTE and IF. */
261 /* Checks for type mismatches on transformation C. Also checks for
262 command terminator, sets the case-handling proc from the array
265 parse_rvalue_expression (struct compute_trns *compute,
266 const struct lvalue *lvalue)
268 int type = lvalue_get_type (lvalue);
269 int vector = lvalue_is_vector (lvalue);
271 assert (type == NUMERIC || type == ALPHA);
273 compute->rvalue = expr_parse (type == ALPHA ? PXP_STRING : PXP_NUMERIC);
274 if (compute->rvalue == NULL)
278 compute->h.proc = vector ? compute_num_vec : compute_num;
280 compute->h.proc = vector ? compute_str_vec : compute_str;
284 lex_error (_("expecting end of command"));
291 /* Returns a new struct compute_trns after initializing its fields. */
292 static struct compute_trns *
293 compute_trns_create (void)
295 struct compute_trns *compute = xmalloc (sizeof *compute);
296 compute->h.proc = NULL;
297 compute->h.free = compute_trns_free;
298 compute->test = NULL;
299 compute->variable = NULL;
300 compute->vector = NULL;
301 compute->element = NULL;
302 compute->rvalue = NULL;
306 /* Deletes all the fields in COMPUTE. */
308 compute_trns_free (struct trns_header *compute_)
310 struct compute_trns *compute = (struct compute_trns *) compute_;
312 expr_free (compute->test);
313 expr_free (compute->element);
314 expr_free (compute->rvalue);
319 char var_name[9]; /* Destination variable name, or "". */
320 const struct vector *vector; /* Destination vector, if any, or NULL. */
321 struct expression *element; /* Destination vector element, or NULL. */
324 static struct lvalue *
327 struct lvalue *lvalue;
329 lvalue = xmalloc (sizeof *lvalue);
330 lvalue->var_name[0] = '\0';
331 lvalue->vector = NULL;
332 lvalue->element = NULL;
334 if (!lex_force_id ())
337 if (lex_look_ahead () == '(')
340 lvalue->vector = dict_lookup_vector (default_dict, tokid);
341 if (lvalue->vector == NULL)
343 msg (SE, _("There is no vector named %s."), tokid);
347 /* Vector element. */
349 if (!lex_force_match ('('))
351 lvalue->element = expr_parse (PXP_NUMERIC);
352 if (lvalue->element == NULL)
354 if (!lex_force_match (')'))
360 strncpy (lvalue->var_name, tokid, 8);
361 lvalue->var_name[8] = '\0';
367 lvalue_destroy (lvalue);
372 lvalue_get_type (const struct lvalue *lvalue)
374 if (lvalue->vector == NULL)
377 = dict_lookup_var (default_dict, lvalue->var_name);
384 return lvalue->vector->var[0]->type;
388 lvalue_is_vector (const struct lvalue *lvalue)
390 return lvalue->vector != NULL;
394 lvalue_finalize (struct lvalue *lvalue,
395 struct compute_trns *compute)
397 if (lvalue->vector == NULL)
399 compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
400 if (compute->variable == NULL)
401 compute->variable = dict_create_var (default_dict, lvalue->var_name,
403 assert (compute->variable != NULL);
405 compute->fv = compute->variable->fv;
406 compute->width = compute->variable->width;
408 /* Goofy behavior, but compatible: Turn off LEAVE. */
409 if (compute->variable->left
410 && dict_class_from_id (compute->variable->name) != DC_SCRATCH)
412 devector (compute->variable);
413 compute->variable->left = 0;
414 envector (compute->variable);
419 compute->vector = lvalue->vector;
420 compute->element = lvalue->element;
421 lvalue->element = NULL;
424 lvalue_destroy (lvalue);
428 lvalue_destroy (struct lvalue *lvalue)
430 expr_free (lvalue->element);
439 struct expression *expr;
441 lex_match_id ("EVALUATE");
442 expr = expr_parse (PXP_DUMP);
449 msg (SE, _("Extra characters after expression."));