1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
4 This program is free software; you can redistribute it and/or
5 modify it under the terms of the GNU General Public License as
6 published by the Free Software Foundation; either version 2 of the
7 License, or (at your option) any later version.
9 This program is distributed in the hope that it will be useful, but
10 WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
23 #include <data/case.h>
24 #include <data/dictionary.h>
25 #include <data/procedure.h>
26 #include <data/transformations.h>
27 #include <data/variable.h>
28 #include <data/vector.h>
29 #include <language/command.h>
30 #include <language/expressions/public.h>
31 #include <language/lexer/lexer.h>
32 #include <libpspp/alloc.h>
33 #include <libpspp/message.h>
34 #include <libpspp/message.h>
35 #include <libpspp/misc.h>
36 #include <libpspp/str.h>
39 #define _(msgid) gettext (msgid)
44 /* Target of a COMPUTE or IF assignment, either a variable or a
46 static struct lvalue *lvalue_parse (struct lexer *lexer, struct dataset *);
47 static int lvalue_get_type (const struct lvalue *);
48 static bool lvalue_is_vector (const struct lvalue *);
49 static void lvalue_finalize (struct lvalue *,
50 struct compute_trns *, struct dictionary *);
51 static void lvalue_destroy (struct lvalue *, struct dictionary *);
53 /* COMPUTE and IF transformation. */
56 /* Test expression (IF only). */
57 struct expression *test; /* Test expression. */
59 /* Variable lvalue, if variable != NULL. */
60 struct variable *variable; /* Destination variable, if any. */
61 int width; /* Lvalue string width; 0=numeric. */
63 /* Vector lvalue, if vector != NULL. */
64 const struct vector *vector; /* Destination vector, if any. */
65 struct expression *element; /* Destination vector element expr. */
68 struct expression *rvalue; /* Rvalue expression. */
71 static struct expression *parse_rvalue (struct lexer *lexer,
72 const struct lvalue *,
75 static struct compute_trns *compute_trns_create (void);
76 static trns_proc_func *get_proc_func (const struct lvalue *);
77 static trns_free_func compute_trns_free;
82 cmd_compute (struct lexer *lexer, struct dataset *ds)
84 struct dictionary *dict = dataset_dict (ds);
85 struct lvalue *lvalue = NULL;
86 struct compute_trns *compute = NULL;
88 compute = compute_trns_create ();
90 lvalue = lvalue_parse (lexer, ds);
94 if (!lex_force_match (lexer, '='))
96 compute->rvalue = parse_rvalue (lexer, lvalue, ds);
97 if (compute->rvalue == NULL)
100 add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
102 lvalue_finalize (lvalue, compute, dict);
104 return lex_end_of_command (lexer);
107 lvalue_destroy (lvalue, dict);
108 compute_trns_free (compute);
109 return CMD_CASCADING_FAILURE;
112 /* Transformation functions. */
114 /* Handle COMPUTE or IF with numeric target variable. */
116 compute_num (void *compute_, struct ccase *c, casenumber case_num)
118 struct compute_trns *compute = compute_;
120 if (compute->test == NULL
121 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
122 case_data_rw (c, compute->variable)->f
123 = expr_evaluate_num (compute->rvalue, c, case_num);
125 return TRNS_CONTINUE;
128 /* Handle COMPUTE or IF with numeric vector element target
131 compute_num_vec (void *compute_, struct ccase *c, casenumber case_num)
133 struct compute_trns *compute = compute_;
135 if (compute->test == NULL
136 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
138 double index; /* Index into the vector. */
139 int rindx; /* Rounded index value. */
141 index = expr_evaluate_num (compute->element, c, case_num);
142 rindx = floor (index + EPSILON);
144 || rindx < 1 || rindx > vector_get_var_cnt (compute->vector))
147 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value "
148 "as an index into vector %s."),
149 vector_get_name (compute->vector));
151 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
152 "an index into vector %s."),
153 index, vector_get_name (compute->vector));
154 return TRNS_CONTINUE;
156 case_data_rw (c, vector_get_var (compute->vector, rindx - 1))->f
157 = expr_evaluate_num (compute->rvalue, c, case_num);
160 return TRNS_CONTINUE;
163 /* Handle COMPUTE or IF with string target variable. */
165 compute_str (void *compute_, struct ccase *c, casenumber case_num)
167 struct compute_trns *compute = compute_;
169 if (compute->test == NULL
170 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
171 expr_evaluate_str (compute->rvalue, c, case_num,
172 case_data_rw (c, compute->variable)->s, compute->width);
174 return TRNS_CONTINUE;
177 /* Handle COMPUTE or IF with string vector element target
180 compute_str_vec (void *compute_, struct ccase *c, casenumber case_num)
182 struct compute_trns *compute = compute_;
184 if (compute->test == NULL
185 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
187 double index; /* Index into the vector. */
188 int rindx; /* Rounded index value. */
189 struct variable *vr; /* Variable reference by indexed vector. */
191 index = expr_evaluate_num (compute->element, c, case_num);
192 rindx = floor (index + EPSILON);
195 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
196 "value as an index into vector %s."),
197 vector_get_name (compute->vector));
198 return TRNS_CONTINUE;
200 else if (rindx < 1 || rindx > vector_get_var_cnt (compute->vector))
202 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
203 "an index into vector %s."),
204 index, vector_get_name (compute->vector));
205 return TRNS_CONTINUE;
208 vr = vector_get_var (compute->vector, rindx - 1);
209 expr_evaluate_str (compute->rvalue, c, case_num,
210 case_data_rw (c, vr)->s,
214 return TRNS_CONTINUE;
220 cmd_if (struct lexer *lexer, struct dataset *ds)
222 struct dictionary *dict = dataset_dict (ds);
223 struct compute_trns *compute = NULL;
224 struct lvalue *lvalue = NULL;
226 compute = compute_trns_create ();
228 /* Test expression. */
229 compute->test = expr_parse (lexer, ds, EXPR_BOOLEAN);
230 if (compute->test == NULL)
233 /* Lvalue variable. */
234 lvalue = lvalue_parse (lexer, ds);
238 /* Rvalue expression. */
239 if (!lex_force_match (lexer, '='))
241 compute->rvalue = parse_rvalue (lexer, lvalue, ds);
242 if (compute->rvalue == NULL)
245 add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
247 lvalue_finalize (lvalue, compute, dict);
249 return lex_end_of_command (lexer);
252 lvalue_destroy (lvalue, dict);
253 compute_trns_free (compute);
254 return CMD_CASCADING_FAILURE;
257 /* Code common to COMPUTE and IF. */
259 static trns_proc_func *
260 get_proc_func (const struct lvalue *lvalue)
262 bool is_numeric = lvalue_get_type (lvalue) == VAR_NUMERIC;
263 bool is_vector = lvalue_is_vector (lvalue);
266 ? (is_vector ? compute_num_vec : compute_num)
267 : (is_vector ? compute_str_vec : compute_str));
270 /* Parses and returns an rvalue expression of the same type as
271 LVALUE, or a null pointer on failure. */
272 static struct expression *
273 parse_rvalue (struct lexer *lexer,
274 const struct lvalue *lvalue, struct dataset *ds)
276 bool is_numeric = lvalue_get_type (lvalue) == VAR_NUMERIC;
278 return expr_parse (lexer, ds, is_numeric ? EXPR_NUMBER : EXPR_STRING);
281 /* Returns a new struct compute_trns after initializing its fields. */
282 static struct compute_trns *
283 compute_trns_create (void)
285 struct compute_trns *compute = xmalloc (sizeof *compute);
286 compute->test = NULL;
287 compute->variable = NULL;
288 compute->vector = NULL;
289 compute->element = NULL;
290 compute->rvalue = NULL;
294 /* Deletes all the fields in COMPUTE. */
296 compute_trns_free (void *compute_)
298 struct compute_trns *compute = compute_;
302 expr_free (compute->test);
303 expr_free (compute->element);
304 expr_free (compute->rvalue);
310 /* COMPUTE or IF target variable or vector element.
311 For a variable, the `variable' member is non-null.
312 For a vector element, the `vector' member is non-null. */
315 struct variable *variable; /* Destination variable. */
316 bool is_new_variable; /* Did we create the variable? */
318 const struct vector *vector; /* Destination vector, if any, or NULL. */
319 struct expression *element; /* Destination vector element, or NULL. */
322 /* Parses the target variable or vector element into a new
323 `struct lvalue', which is returned. */
324 static struct lvalue *
325 lvalue_parse (struct lexer *lexer, struct dataset *ds)
327 struct dictionary *dict = dataset_dict (ds);
328 struct lvalue *lvalue;
330 lvalue = xmalloc (sizeof *lvalue);
331 lvalue->variable = NULL;
332 lvalue->is_new_variable = false;
333 lvalue->vector = NULL;
334 lvalue->element = NULL;
336 if (!lex_force_id (lexer))
339 if (lex_look_ahead (lexer) == '(')
342 lvalue->vector = dict_lookup_vector (dict, lex_tokid (lexer));
343 if (lvalue->vector == NULL)
345 msg (SE, _("There is no vector named %s."), lex_tokid (lexer));
349 /* Vector element. */
351 if (!lex_force_match (lexer, '('))
353 lvalue->element = expr_parse (lexer, ds, EXPR_NUMBER);
354 if (lvalue->element == NULL)
356 if (!lex_force_match (lexer, ')'))
362 const char *var_name = lex_tokid (lexer);
363 lvalue->variable = dict_lookup_var (dict, var_name);
364 if (lvalue->variable == NULL)
366 lvalue->variable = dict_create_var_assert (dict, var_name, 0);
367 lvalue->is_new_variable = true;
374 lvalue_destroy (lvalue, dict);
378 /* Returns the type (NUMERIC or ALPHA) of the target variable or
381 lvalue_get_type (const struct lvalue *lvalue)
383 return (lvalue->variable != NULL
384 ? var_get_type (lvalue->variable)
385 : vector_get_type (lvalue->vector));
388 /* Returns true if LVALUE has a vector as its target. */
390 lvalue_is_vector (const struct lvalue *lvalue)
392 return lvalue->vector != NULL;
395 /* Finalizes making LVALUE the target of COMPUTE, by creating the
396 target variable if necessary and setting fields in COMPUTE. */
398 lvalue_finalize (struct lvalue *lvalue,
399 struct compute_trns *compute,
400 struct dictionary *dict)
402 if (lvalue->vector == NULL)
404 compute->variable = lvalue->variable;
405 compute->width = var_get_width (compute->variable);
407 /* Goofy behavior, but compatible: Turn off LEAVE. */
408 if (!var_must_leave (compute->variable))
409 var_set_leave (compute->variable, false);
411 /* Prevent lvalue_destroy from deleting variable. */
412 lvalue->is_new_variable = false;
416 compute->vector = lvalue->vector;
417 compute->element = lvalue->element;
418 lvalue->element = NULL;
421 lvalue_destroy (lvalue, dict);
424 /* Destroys LVALUE. */
426 lvalue_destroy (struct lvalue *lvalue, struct dictionary *dict)
431 if (lvalue->is_new_variable)
432 dict_delete_var (dict, lvalue->variable);
433 expr_free (lvalue->element);