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
37 #include "debug-print.h"
39 /* COMPUTE and IF transformation. */
44 /* Destination. (Used only during parsing.) */
45 struct variable *v; /* Destvar, if dest isn't a vector elem. */
46 int created; /* Whether we created the destvar (used only during
49 /* Destination. (Used during execution.) */
50 struct vector *vec; /* Destination vector, if dest is a vector elem. */
51 int fv; /* `value' index of destination variable. */
52 int width; /* Target variable width (string vars only). */
55 struct expression *vec_elem; /* Destination vector element expr. */
56 struct expression *target; /* Target expression. */
57 struct expression *test; /* Test expression (IF only). */
60 static int parse_target_expression (struct compute_trns *,
61 int (*func_tab[4]) (struct trns_header *, struct ccase *));
62 static struct compute_trns *new_trns (void);
63 static void delete_trns (struct compute_trns *);
64 static void free_trns (struct trns_header *);
65 static int parse_var_or_vec (struct compute_trns *);
69 static int compute_num (struct trns_header *, struct ccase *);
70 static int compute_str (struct trns_header *, struct ccase *);
71 static int compute_num_vec (struct trns_header *, struct ccase *);
72 static int compute_str_vec (struct trns_header *, struct ccase *);
77 /* Table of functions to process data. */
78 static int (*func_tab[4]) (struct trns_header *, struct ccase *) =
86 /* Transformation being constructed. */
87 struct compute_trns *c;
89 lex_match_id ("COMPUTE");
92 if (!parse_var_or_vec (c))
95 if (!lex_force_match ('=')
96 || !parse_target_expression (c, func_tab))
99 /* Goofy behavior, but compatible: Turn off LEAVE on the destvar. */
100 if (c->v && c->v->left && c->v->name[0] != '#')
107 add_transformation ((struct trns_header *) c);
117 compute_num (struct trns_header * pt, struct ccase * c)
119 struct compute_trns *t = (struct compute_trns *) pt;
120 expr_evaluate (t->target, c, &c->data[t->fv]);
125 compute_num_vec (struct trns_header * pt, struct ccase * c)
127 struct compute_trns *t = (struct compute_trns *) pt;
129 /* Index into the vector. */
132 /* Rounded index value. */
135 expr_evaluate (t->vec_elem, c, &index);
136 rindx = floor (index.f + EPSILON);
137 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
139 if (index.f == SYSMIS)
140 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
141 "an index into vector %s."), t->vec->name);
143 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
144 "an index into vector %s."), index.f, t->vec->name);
147 expr_evaluate (t->target, c, &c->data[t->vec->v[rindx - 1]->fv]);
152 compute_str (struct trns_header * pt, struct ccase * c)
154 struct compute_trns *t = (struct compute_trns *) pt;
156 /* Temporary storage for string expression return value. */
159 expr_evaluate (t->target, c, &v);
160 st_bare_pad_len_copy (c->data[t->fv].s, &v.c[1], t->width, v.c[0]);
165 compute_str_vec (struct trns_header * pt, struct ccase * c)
167 struct compute_trns *t = (struct compute_trns *) pt;
169 /* Temporary storage for string expression return value. */
172 /* Index into the vector. */
175 /* Rounded index value. */
178 /* Variable reference by indexed vector. */
181 expr_evaluate (t->vec_elem, c, &index);
182 rindx = floor (index.f + EPSILON);
183 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
185 if (index.f == SYSMIS)
186 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
187 "an index into vector %s."), t->vec->name);
189 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
190 "an index into vector %s."), index.f, t->vec->name);
194 expr_evaluate (t->target, c, &v);
195 vr = t->vec->v[rindx - 1];
196 st_bare_pad_len_copy (c->data[vr->fv].s, &v.c[1], vr->width, v.c[0]);
202 static int if_num (struct trns_header *, struct ccase *);
203 static int if_str (struct trns_header *, struct ccase *);
204 static int if_num_vec (struct trns_header *, struct ccase *);
205 static int if_str_vec (struct trns_header *, struct ccase *);
210 /* Table of functions to process data. */
211 static int (*func_tab[4]) (struct trns_header *, struct ccase *) =
219 /* Transformation being constructed. */
220 struct compute_trns *c;
225 /* Test expression. */
226 c->test = expr_parse (PXP_BOOLEAN);
230 /* Target variable. */
231 if (!parse_var_or_vec (c))
234 /* Target expression. */
236 if (!lex_force_match ('=')
237 || !parse_target_expression (c, func_tab))
240 add_transformation ((struct trns_header *) c);
250 if_num (struct trns_header * pt, struct ccase * c)
252 struct compute_trns *t = (struct compute_trns *) pt;
254 if (expr_evaluate (t->test, c, NULL) == 1.0)
255 expr_evaluate (t->target, c, &c->data[t->fv]);
260 if_str (struct trns_header * pt, struct ccase * c)
262 struct compute_trns *t = (struct compute_trns *) pt;
264 if (expr_evaluate (t->test, c, NULL) == 1.0)
268 expr_evaluate (t->target, c, &v);
269 st_bare_pad_len_copy (c->data[t->fv].s, &v.c[1], t->width, v.c[0]);
275 if_num_vec (struct trns_header * pt, struct ccase * c)
277 struct compute_trns *t = (struct compute_trns *) pt;
279 if (expr_evaluate (t->test, c, NULL) == 1.0)
281 /* Index into the vector. */
284 /* Rounded index value. */
287 expr_evaluate (t->vec_elem, c, &index);
288 rindx = floor (index.f + EPSILON);
289 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
291 if (index.f == SYSMIS)
292 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
293 "an index into vector %s."), t->vec->name);
295 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
296 "an index into vector %s."), index.f, t->vec->name);
299 expr_evaluate (t->target, c,
300 &c->data[t->vec->v[rindx]->fv]);
306 if_str_vec (struct trns_header * pt, struct ccase * c)
308 struct compute_trns *t = (struct compute_trns *) pt;
310 if (expr_evaluate (t->test, c, NULL) == 1.0)
312 /* Index into the vector. */
315 /* Rounded index value. */
318 /* Temporary storage for result of target expression. */
321 /* Variable reference by indexed vector. */
324 expr_evaluate (t->vec_elem, c, &index);
325 rindx = floor (index.f + EPSILON);
326 if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
328 if (index.f == SYSMIS)
329 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
330 "an index into vector %s."), t->vec->name);
332 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
333 "an index into vector %s."), index.f, t->vec->name);
336 expr_evaluate (t->target, c, &v2);
337 vr = t->vec->v[rindx - 1];
338 st_bare_pad_len_copy (c->data[vr->fv].s, &v2.c[1], vr->width, v2.c[0]);
343 /* Code common to COMPUTE and IF. */
345 /* Checks for type mismatches on transformation C. Also checks for
346 command terminator, sets the case-handling proc from the array
349 parse_target_expression (struct compute_trns *c,
350 int (*proc_list[4]) (struct trns_header *, struct ccase *))
352 int dest_type = c->v ? c->v->type : c->vec->v[0]->type;
353 c->target = expr_parse (dest_type == ALPHA ? PXP_STRING : PXP_NUMERIC);
357 c->h.proc = proc_list[(dest_type == ALPHA) + 2 * (c->vec != NULL)];
361 lex_error (_("expecting end of command"));
368 /* Returns a new struct compute_trns after initializing its fields. */
369 static struct compute_trns *
372 struct compute_trns *c = xmalloc (sizeof *c);
374 c->h.free = free_trns;
386 /* Deletes all the fields in C, the variable C->v if we created it,
389 delete_trns (struct compute_trns * c)
391 free_trns ((struct trns_header *) c);
393 delete_variable (&default_dict, c->v);
397 /* Deletes all the fields in C. */
399 free_trns (struct trns_header * pt)
401 struct compute_trns *t = (struct compute_trns *) pt;
403 expr_free (t->vec_elem);
404 expr_free (t->target);
408 /* Parses a variable name or a vector element into C. If the
409 variable does not exist, it is created. Returns success. */
411 parse_var_or_vec (struct compute_trns * c)
413 if (!lex_force_id ())
416 if (lex_look_ahead () == '(')
418 /* Vector element. */
419 c->vec = find_vector (tokid);
422 msg (SE, _("There is no vector named %s."), tokid);
427 if (!lex_force_match ('('))
429 c->vec_elem = expr_parse (PXP_NUMERIC);
432 if (!lex_force_match (')'))
434 expr_free (c->vec_elem);
441 c->v = find_variable (tokid);
444 c->v = force_create_variable (&default_dict, tokid, NUMERIC, 0);
449 c->width = c->v->width;
461 struct expression *expr;
463 lex_match_id ("EVALUATE");
464 expr = expr_parse (PXP_DUMP);
471 msg (SE, _("Extra characters after expression."));