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
33 /* I can't think of any really good reason to disable debugging for
35 #include "debug-print.h"
37 /* COMPUTE and IF transformation. */
42 /* Destination. (Used only during parsing.) */
43 struct variable *v; /* Destvar, if dest isn't a vector elem. */
44 int created; /* Whether we created the destvar (used only during
47 /* Destination. (Used during execution.) */
48 struct vector *vec; /* Destination vector, if dest is a vector elem. */
49 int fv; /* `value' index of destination variable. */
50 int width; /* Target variable width (string vars only). */
53 struct expression *vec_elem; /* Destination vector element expr. */
54 struct expression *target; /* Target expression. */
55 struct expression *test; /* Test expression (IF only). */
58 static int parse_target_expression (struct compute_trns *,
59 int (*func_tab[4]) (struct trns_header *, struct ccase *));
60 static struct compute_trns *new_trns (void);
61 static void delete_trns (struct compute_trns *);
62 static void free_trns (struct trns_header *);
63 static int parse_var_or_vec (struct compute_trns *);
67 static int compute_num (struct trns_header *, struct ccase *);
68 static int compute_str (struct trns_header *, struct ccase *);
69 static int compute_num_vec (struct trns_header *, struct ccase *);
70 static int compute_str_vec (struct trns_header *, struct ccase *);
75 /* Table of functions to process data. */
76 static int (*func_tab[4]) (struct trns_header *, struct ccase *) =
84 /* Transformation being constructed. */
85 struct compute_trns *c;
87 lex_match_id ("COMPUTE");
90 if (!parse_var_or_vec (c))
93 if (!lex_force_match ('=')
94 || !parse_target_expression (c, func_tab))
97 /* Goofy behavior, but compatible: Turn off LEAVE on the destvar. */
98 if (c->v && c->v->left && c->v->name[0] != '#')
105 add_transformation ((struct trns_header *) c);
115 compute_num (struct trns_header * pt, struct ccase * c)
117 struct compute_trns *t = (struct compute_trns *) pt;
118 expr_evaluate (t->target, c, &c->data[t->fv]);
123 compute_num_vec (struct trns_header * pt, struct ccase * c)
125 struct compute_trns *t = (struct compute_trns *) pt;
127 /* Index into the vector. */
130 /* Rounded index value. */
133 expr_evaluate (t->vec_elem, c, &index);
134 rindx = floor (index.f + EPSILON);
135 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
137 if (index.f == SYSMIS)
138 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
139 "an index into vector %s."), t->vec->name);
141 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
142 "an index into vector %s."), index.f, t->vec->name);
145 expr_evaluate (t->target, c, &c->data[t->vec->v[rindx - 1]->fv]);
150 compute_str (struct trns_header * pt, struct ccase * c)
152 struct compute_trns *t = (struct compute_trns *) pt;
154 /* Temporary storage for string expression return value. */
157 expr_evaluate (t->target, c, &v);
158 st_bare_pad_len_copy (c->data[t->fv].s, &v.c[1], t->width, v.c[0]);
163 compute_str_vec (struct trns_header * pt, struct ccase * c)
165 struct compute_trns *t = (struct compute_trns *) pt;
167 /* Temporary storage for string expression return value. */
170 /* Index into the vector. */
173 /* Rounded index value. */
176 /* Variable reference by indexed vector. */
179 expr_evaluate (t->vec_elem, c, &index);
180 rindx = floor (index.f + EPSILON);
181 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
183 if (index.f == SYSMIS)
184 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
185 "an index into vector %s."), t->vec->name);
187 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
188 "an index into vector %s."), index.f, t->vec->name);
192 expr_evaluate (t->target, c, &v);
193 vr = t->vec->v[rindx - 1];
194 st_bare_pad_len_copy (c->data[vr->fv].s, &v.c[1], vr->width, v.c[0]);
200 static int if_num (struct trns_header *, struct ccase *);
201 static int if_str (struct trns_header *, struct ccase *);
202 static int if_num_vec (struct trns_header *, struct ccase *);
203 static int if_str_vec (struct trns_header *, struct ccase *);
208 /* Table of functions to process data. */
209 static int (*func_tab[4]) (struct trns_header *, struct ccase *) =
217 /* Transformation being constructed. */
218 struct compute_trns *c;
223 /* Test expression. */
224 c->test = expr_parse (PXP_BOOLEAN);
228 /* Target variable. */
229 if (!parse_var_or_vec (c))
232 /* Target expression. */
234 if (!lex_force_match ('=')
235 || !parse_target_expression (c, func_tab))
238 add_transformation ((struct trns_header *) c);
248 if_num (struct trns_header * pt, struct ccase * c)
250 struct compute_trns *t = (struct compute_trns *) pt;
252 if (expr_evaluate (t->test, c, NULL) == 1.0)
253 expr_evaluate (t->target, c, &c->data[t->fv]);
258 if_str (struct trns_header * pt, struct ccase * c)
260 struct compute_trns *t = (struct compute_trns *) pt;
262 if (expr_evaluate (t->test, c, NULL) == 1.0)
266 expr_evaluate (t->target, c, &v);
267 st_bare_pad_len_copy (c->data[t->fv].s, &v.c[1], t->width, v.c[0]);
273 if_num_vec (struct trns_header * pt, struct ccase * c)
275 struct compute_trns *t = (struct compute_trns *) pt;
277 if (expr_evaluate (t->test, c, NULL) == 1.0)
279 /* Index into the vector. */
282 /* Rounded index value. */
285 expr_evaluate (t->vec_elem, c, &index);
286 rindx = floor (index.f + EPSILON);
287 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
289 if (index.f == SYSMIS)
290 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
291 "an index into vector %s."), t->vec->name);
293 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
294 "an index into vector %s."), index.f, t->vec->name);
297 expr_evaluate (t->target, c,
298 &c->data[t->vec->v[rindx]->fv]);
304 if_str_vec (struct trns_header * pt, struct ccase * c)
306 struct compute_trns *t = (struct compute_trns *) pt;
308 if (expr_evaluate (t->test, c, NULL) == 1.0)
310 /* Index into the vector. */
313 /* Rounded index value. */
316 /* Temporary storage for result of target expression. */
319 /* Variable reference by indexed vector. */
322 expr_evaluate (t->vec_elem, c, &index);
323 rindx = floor (index.f + EPSILON);
324 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
326 if (index.f == SYSMIS)
327 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
328 "an index into vector %s."), t->vec->name);
330 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
331 "an index into vector %s."), index.f, t->vec->name);
334 expr_evaluate (t->target, c, &v2);
335 vr = t->vec->v[rindx - 1];
336 st_bare_pad_len_copy (c->data[vr->fv].s, &v2.c[1], vr->width, v2.c[0]);
341 /* Code common to COMPUTE and IF. */
343 /* Checks for type mismatches on transformation C. Also checks for
344 command terminator, sets the case-handling proc from the array
347 parse_target_expression (struct compute_trns *c,
348 int (*proc_list[4]) (struct trns_header *, struct ccase *))
350 int dest_type = c->v ? c->v->type : c->vec->v[0]->type;
351 c->target = expr_parse (dest_type == ALPHA ? PXP_STRING : PXP_NUMERIC);
355 c->h.proc = proc_list[(dest_type == ALPHA) + 2 * (c->vec != NULL)];
359 lex_error (_("expecting end of command"));
366 /* Returns a new struct compute_trns after initializing its fields. */
367 static struct compute_trns *
370 struct compute_trns *c = xmalloc (sizeof *c);
372 c->h.free = free_trns;
384 /* Deletes all the fields in C, the variable C->v if we created it,
387 delete_trns (struct compute_trns * c)
389 free_trns ((struct trns_header *) c);
391 delete_variable (&default_dict, c->v);
395 /* Deletes all the fields in C. */
397 free_trns (struct trns_header * pt)
399 struct compute_trns *t = (struct compute_trns *) pt;
401 expr_free (t->vec_elem);
402 expr_free (t->target);
406 /* Parses a variable name or a vector element into C. If the
407 variable does not exist, it is created. Returns success. */
409 parse_var_or_vec (struct compute_trns * c)
411 if (!lex_force_id ())
414 if (lex_look_ahead () == '(')
416 /* Vector element. */
417 c->vec = find_vector (tokid);
420 msg (SE, _("There is no vector named %s."), tokid);
425 if (!lex_force_match ('('))
427 c->vec_elem = expr_parse (PXP_NUMERIC);
430 if (!lex_force_match (')'))
432 expr_free (c->vec_elem);
439 c->v = find_variable (tokid);
442 c->v = force_create_variable (&default_dict, tokid, NUMERIC, 0);
447 c->width = c->v->width;
459 struct expression *expr;
461 lex_match_id ("EVALUATE");
462 expr = expr_parse (PXP_DUMP);
469 msg (SE, _("Extra characters after expression."));