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., 51 Franklin Street, Fifth Floor, Boston, MA
24 #include <data/case.h>
25 #include <data/dictionary.h>
26 #include <data/procedure.h>
27 #include <data/transformations.h>
28 #include <data/variable.h>
29 #include <data/vector.h>
30 #include <language/command.h>
31 #include <language/expressions/public.h>
32 #include <language/lexer/lexer.h>
33 #include <libpspp/alloc.h>
34 #include <libpspp/message.h>
35 #include <libpspp/message.h>
36 #include <libpspp/misc.h>
37 #include <libpspp/str.h>
40 #define _(msgid) gettext (msgid)
45 /* Target of a COMPUTE or IF assignment, either a variable or a
47 static struct lvalue *lvalue_parse (struct lexer *lexer, struct dataset *);
48 static int lvalue_get_type (const struct lvalue *);
49 static bool lvalue_is_vector (const struct lvalue *);
50 static void lvalue_finalize (struct lvalue *,
51 struct compute_trns *, struct dictionary *);
52 static void lvalue_destroy (struct lvalue *, struct dictionary *);
54 /* COMPUTE and IF transformation. */
57 /* Test expression (IF only). */
58 struct expression *test; /* Test expression. */
60 /* Variable lvalue, if variable != NULL. */
61 struct variable *variable; /* Destination variable, if any. */
62 int width; /* Lvalue string width; 0=numeric. */
64 /* Vector lvalue, if vector != NULL. */
65 const struct vector *vector; /* Destination vector, if any. */
66 struct expression *element; /* Destination vector element expr. */
69 struct expression *rvalue; /* Rvalue expression. */
72 static struct expression *parse_rvalue (struct lexer *lexer,
73 const struct lvalue *,
76 static struct compute_trns *compute_trns_create (void);
77 static trns_proc_func *get_proc_func (const struct lvalue *);
78 static trns_free_func compute_trns_free;
83 cmd_compute (struct lexer *lexer, struct dataset *ds)
85 struct dictionary *dict = dataset_dict (ds);
86 struct lvalue *lvalue = NULL;
87 struct compute_trns *compute = NULL;
89 compute = compute_trns_create ();
91 lvalue = lvalue_parse (lexer, ds);
95 if (!lex_force_match (lexer, '='))
97 compute->rvalue = parse_rvalue (lexer, lvalue, ds);
98 if (compute->rvalue == NULL)
101 add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
103 lvalue_finalize (lvalue, compute, dict);
105 return lex_end_of_command (lexer);
108 lvalue_destroy (lvalue, dict);
109 compute_trns_free (compute);
110 return CMD_CASCADING_FAILURE;
113 /* Transformation functions. */
115 /* Handle COMPUTE or IF with numeric target variable. */
117 compute_num (void *compute_, struct ccase *c, casenumber case_num)
119 struct compute_trns *compute = compute_;
121 if (compute->test == NULL
122 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
123 case_data_rw (c, compute->variable)->f
124 = expr_evaluate_num (compute->rvalue, c, case_num);
126 return TRNS_CONTINUE;
129 /* Handle COMPUTE or IF with numeric vector element target
132 compute_num_vec (void *compute_, struct ccase *c, casenumber case_num)
134 struct compute_trns *compute = compute_;
136 if (compute->test == NULL
137 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
139 double index; /* Index into the vector. */
140 int rindx; /* Rounded index value. */
142 index = expr_evaluate_num (compute->element, c, case_num);
143 rindx = floor (index + EPSILON);
145 || rindx < 1 || rindx > vector_get_var_cnt (compute->vector))
148 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value "
149 "as an index into vector %s."),
150 vector_get_name (compute->vector));
152 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
153 "an index into vector %s."),
154 index, vector_get_name (compute->vector));
155 return TRNS_CONTINUE;
157 case_data_rw (c, vector_get_var (compute->vector, rindx - 1))->f
158 = expr_evaluate_num (compute->rvalue, c, case_num);
161 return TRNS_CONTINUE;
164 /* Handle COMPUTE or IF with string target variable. */
166 compute_str (void *compute_, struct ccase *c, casenumber case_num)
168 struct compute_trns *compute = compute_;
170 if (compute->test == NULL
171 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
172 expr_evaluate_str (compute->rvalue, c, case_num,
173 case_data_rw (c, compute->variable)->s, compute->width);
175 return TRNS_CONTINUE;
178 /* Handle COMPUTE or IF with string vector element target
181 compute_str_vec (void *compute_, struct ccase *c, casenumber case_num)
183 struct compute_trns *compute = compute_;
185 if (compute->test == NULL
186 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
188 double index; /* Index into the vector. */
189 int rindx; /* Rounded index value. */
190 struct variable *vr; /* Variable reference by indexed vector. */
192 index = expr_evaluate_num (compute->element, c, case_num);
193 rindx = floor (index + EPSILON);
196 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
197 "value as an index into vector %s."),
198 vector_get_name (compute->vector));
199 return TRNS_CONTINUE;
201 else if (rindx < 1 || rindx > vector_get_var_cnt (compute->vector))
203 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
204 "an index into vector %s."),
205 index, vector_get_name (compute->vector));
206 return TRNS_CONTINUE;
209 vr = vector_get_var (compute->vector, rindx - 1);
210 expr_evaluate_str (compute->rvalue, c, case_num,
211 case_data_rw (c, vr)->s,
215 return TRNS_CONTINUE;
221 cmd_if (struct lexer *lexer, struct dataset *ds)
223 struct dictionary *dict = dataset_dict (ds);
224 struct compute_trns *compute = NULL;
225 struct lvalue *lvalue = NULL;
227 compute = compute_trns_create ();
229 /* Test expression. */
230 compute->test = expr_parse (lexer, ds, EXPR_BOOLEAN);
231 if (compute->test == NULL)
234 /* Lvalue variable. */
235 lvalue = lvalue_parse (lexer, ds);
239 /* Rvalue expression. */
240 if (!lex_force_match (lexer, '='))
242 compute->rvalue = parse_rvalue (lexer, lvalue, ds);
243 if (compute->rvalue == NULL)
246 add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
248 lvalue_finalize (lvalue, compute, dict);
250 return lex_end_of_command (lexer);
253 lvalue_destroy (lvalue, dict);
254 compute_trns_free (compute);
255 return CMD_CASCADING_FAILURE;
258 /* Code common to COMPUTE and IF. */
260 static trns_proc_func *
261 get_proc_func (const struct lvalue *lvalue)
263 bool is_numeric = lvalue_get_type (lvalue) == VAR_NUMERIC;
264 bool is_vector = lvalue_is_vector (lvalue);
267 ? (is_vector ? compute_num_vec : compute_num)
268 : (is_vector ? compute_str_vec : compute_str));
271 /* Parses and returns an rvalue expression of the same type as
272 LVALUE, or a null pointer on failure. */
273 static struct expression *
274 parse_rvalue (struct lexer *lexer,
275 const struct lvalue *lvalue, struct dataset *ds)
277 bool is_numeric = lvalue_get_type (lvalue) == VAR_NUMERIC;
279 return expr_parse (lexer, ds, is_numeric ? EXPR_NUMBER : EXPR_STRING);
282 /* Returns a new struct compute_trns after initializing its fields. */
283 static struct compute_trns *
284 compute_trns_create (void)
286 struct compute_trns *compute = xmalloc (sizeof *compute);
287 compute->test = NULL;
288 compute->variable = NULL;
289 compute->vector = NULL;
290 compute->element = NULL;
291 compute->rvalue = NULL;
295 /* Deletes all the fields in COMPUTE. */
297 compute_trns_free (void *compute_)
299 struct compute_trns *compute = compute_;
303 expr_free (compute->test);
304 expr_free (compute->element);
305 expr_free (compute->rvalue);
311 /* COMPUTE or IF target variable or vector element.
312 For a variable, the `variable' member is non-null.
313 For a vector element, the `vector' member is non-null. */
316 struct variable *variable; /* Destination variable. */
317 bool is_new_variable; /* Did we create the variable? */
319 const struct vector *vector; /* Destination vector, if any, or NULL. */
320 struct expression *element; /* Destination vector element, or NULL. */
323 /* Parses the target variable or vector element into a new
324 `struct lvalue', which is returned. */
325 static struct lvalue *
326 lvalue_parse (struct lexer *lexer, struct dataset *ds)
328 struct dictionary *dict = dataset_dict (ds);
329 struct lvalue *lvalue;
331 lvalue = xmalloc (sizeof *lvalue);
332 lvalue->variable = NULL;
333 lvalue->is_new_variable = false;
334 lvalue->vector = NULL;
335 lvalue->element = NULL;
337 if (!lex_force_id (lexer))
340 if (lex_look_ahead (lexer) == '(')
343 lvalue->vector = dict_lookup_vector (dict, lex_tokid (lexer));
344 if (lvalue->vector == NULL)
346 msg (SE, _("There is no vector named %s."), lex_tokid (lexer));
350 /* Vector element. */
352 if (!lex_force_match (lexer, '('))
354 lvalue->element = expr_parse (lexer, ds, EXPR_NUMBER);
355 if (lvalue->element == NULL)
357 if (!lex_force_match (lexer, ')'))
363 const char *var_name = lex_tokid (lexer);
364 lvalue->variable = dict_lookup_var (dict, var_name);
365 if (lvalue->variable == NULL)
367 lvalue->variable = dict_create_var_assert (dict, var_name, 0);
368 lvalue->is_new_variable = true;
375 lvalue_destroy (lvalue, dict);
379 /* Returns the type (NUMERIC or ALPHA) of the target variable or
382 lvalue_get_type (const struct lvalue *lvalue)
384 return (lvalue->variable != NULL
385 ? var_get_type (lvalue->variable)
386 : vector_get_type (lvalue->vector));
389 /* Returns true if LVALUE has a vector as its target. */
391 lvalue_is_vector (const struct lvalue *lvalue)
393 return lvalue->vector != NULL;
396 /* Finalizes making LVALUE the target of COMPUTE, by creating the
397 target variable if necessary and setting fields in COMPUTE. */
399 lvalue_finalize (struct lvalue *lvalue,
400 struct compute_trns *compute,
401 struct dictionary *dict)
403 if (lvalue->vector == NULL)
405 compute->variable = lvalue->variable;
406 compute->width = var_get_width (compute->variable);
408 /* Goofy behavior, but compatible: Turn off LEAVE. */
409 if (!var_must_leave (compute->variable))
410 var_set_leave (compute->variable, false);
412 /* Prevent lvalue_destroy from deleting variable. */
413 lvalue->is_new_variable = false;
417 compute->vector = lvalue->vector;
418 compute->element = lvalue->element;
419 lvalue->element = NULL;
422 lvalue_destroy (lvalue, dict);
425 /* Destroys LVALUE. */
427 lvalue_destroy (struct lvalue *lvalue, struct dictionary *dict)
432 if (lvalue->is_new_variable)
433 dict_delete_var (dict, lvalue->variable);
434 expr_free (lvalue->element);