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
26 #include "dictionary.h"
28 #include "expressions/public.h"
35 #define _(msgid) gettext (msgid)
40 /* Target of a COMPUTE or IF assignment, either a variable or a
42 static struct lvalue *lvalue_parse (void);
43 static int lvalue_get_type (const struct lvalue *);
44 static bool lvalue_is_vector (const struct lvalue *);
45 static void lvalue_finalize (struct lvalue *,
46 struct compute_trns *);
47 static void lvalue_destroy (struct lvalue *);
49 /* COMPUTE and IF transformation. */
52 /* Test expression (IF only). */
53 struct expression *test; /* Test expression. */
55 /* Variable lvalue, if variable != NULL. */
56 struct variable *variable; /* Destination variable, if any. */
57 int fv; /* `value' index of destination variable. */
58 int width; /* Lvalue string width; 0=numeric. */
60 /* Vector lvalue, if vector != NULL. */
61 const struct vector *vector; /* Destination vector, if any. */
62 struct expression *element; /* Destination vector element expr. */
65 struct expression *rvalue; /* Rvalue expression. */
68 static struct expression *parse_rvalue (const struct lvalue *);
69 static struct compute_trns *compute_trns_create (void);
70 static trns_proc_func *get_proc_func (const struct lvalue *);
71 static trns_free_func compute_trns_free;
78 struct lvalue *lvalue = NULL;
79 struct compute_trns *compute = NULL;
81 compute = compute_trns_create ();
83 lvalue = lvalue_parse ();
87 if (!lex_force_match ('='))
89 compute->rvalue = parse_rvalue (lvalue);
90 if (compute->rvalue == NULL)
93 add_transformation (get_proc_func (lvalue), compute_trns_free, compute);
95 lvalue_finalize (lvalue, compute);
97 return lex_end_of_command ();
100 lvalue_destroy (lvalue);
101 compute_trns_free (compute);
102 return CMD_CASCADING_FAILURE;
105 /* Transformation functions. */
107 /* Handle COMPUTE or IF with numeric target variable. */
109 compute_num (void *compute_, struct ccase *c, int case_num)
111 struct compute_trns *compute = compute_;
113 if (compute->test == NULL
114 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
115 case_data_rw (c, compute->fv)->f = expr_evaluate_num (compute->rvalue, c,
118 return TRNS_CONTINUE;
121 /* Handle COMPUTE or IF with numeric vector element target
124 compute_num_vec (void *compute_, struct ccase *c, int case_num)
126 struct compute_trns *compute = compute_;
128 if (compute->test == NULL
129 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
131 double index; /* Index into the vector. */
132 int rindx; /* Rounded index value. */
134 index = expr_evaluate_num (compute->element, c, case_num);
135 rindx = floor (index + EPSILON);
136 if (index == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
139 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
140 "an index into vector %s."), compute->vector->name);
142 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
143 "an index into vector %s."),
144 index, compute->vector->name);
145 return TRNS_CONTINUE;
147 case_data_rw (c, compute->vector->var[rindx - 1]->fv)->f
148 = expr_evaluate_num (compute->rvalue, c, case_num);
151 return TRNS_CONTINUE;
154 /* Handle COMPUTE or IF with string target variable. */
156 compute_str (void *compute_, struct ccase *c, int case_num)
158 struct compute_trns *compute = compute_;
160 if (compute->test == NULL
161 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
162 expr_evaluate_str (compute->rvalue, c, case_num,
163 case_data_rw (c, compute->fv)->s, compute->width);
165 return TRNS_CONTINUE;
168 /* Handle COMPUTE or IF with string vector element target
171 compute_str_vec (void *compute_, struct ccase *c, int case_num)
173 struct compute_trns *compute = compute_;
175 if (compute->test == NULL
176 || expr_evaluate_num (compute->test, c, case_num) == 1.0)
178 double index; /* Index into the vector. */
179 int rindx; /* Rounded index value. */
180 struct variable *vr; /* Variable reference by indexed vector. */
182 index = expr_evaluate_num (compute->element, c, case_num);
183 rindx = floor (index + EPSILON);
186 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
187 "value as an index into vector %s."),
188 compute->vector->name);
189 return TRNS_CONTINUE;
191 else if (rindx < 1 || rindx > compute->vector->cnt)
193 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
194 "an index into vector %s."),
195 index, compute->vector->name);
196 return TRNS_CONTINUE;
199 vr = compute->vector->var[rindx - 1];
200 expr_evaluate_str (compute->rvalue, c, case_num,
201 case_data_rw (c, vr->fv)->s, vr->width);
204 return TRNS_CONTINUE;
212 struct compute_trns *compute = NULL;
213 struct lvalue *lvalue = NULL;
215 compute = compute_trns_create ();
217 /* Test expression. */
218 compute->test = expr_parse (default_dict, EXPR_BOOLEAN);
219 if (compute->test == NULL)
222 /* Lvalue variable. */
223 lvalue = lvalue_parse ();
227 /* Rvalue expression. */
228 if (!lex_force_match ('='))
230 compute->rvalue = parse_rvalue (lvalue);
231 if (compute->rvalue == NULL)
234 add_transformation (get_proc_func (lvalue), compute_trns_free, compute);
236 lvalue_finalize (lvalue, compute);
238 return lex_end_of_command ();
241 lvalue_destroy (lvalue);
242 compute_trns_free (compute);
243 return CMD_CASCADING_FAILURE;
246 /* Code common to COMPUTE and IF. */
248 static trns_proc_func *
249 get_proc_func (const struct lvalue *lvalue)
251 bool is_numeric = lvalue_get_type (lvalue) == NUMERIC;
252 bool is_vector = lvalue_is_vector (lvalue);
255 ? (is_vector ? compute_num_vec : compute_num)
256 : (is_vector ? compute_str_vec : compute_str));
259 /* Parses and returns an rvalue expression of the same type as
260 LVALUE, or a null pointer on failure. */
261 static struct expression *
262 parse_rvalue (const struct lvalue *lvalue)
264 bool is_numeric = lvalue_get_type (lvalue) == NUMERIC;
266 return expr_parse (default_dict, is_numeric ? EXPR_NUMBER : EXPR_STRING);
269 /* Returns a new struct compute_trns after initializing its fields. */
270 static struct compute_trns *
271 compute_trns_create (void)
273 struct compute_trns *compute = xmalloc (sizeof *compute);
274 compute->test = NULL;
275 compute->variable = NULL;
276 compute->vector = NULL;
277 compute->element = NULL;
278 compute->rvalue = NULL;
282 /* Deletes all the fields in COMPUTE. */
284 compute_trns_free (void *compute_)
286 struct compute_trns *compute = compute_;
290 expr_free (compute->test);
291 expr_free (compute->element);
292 expr_free (compute->rvalue);
298 /* COMPUTE or IF target variable or vector element. */
301 char var_name[LONG_NAME_LEN + 1]; /* Destination variable name, or "". */
302 const struct vector *vector; /* Destination vector, if any, or NULL. */
303 struct expression *element; /* Destination vector element, or NULL. */
306 /* Parses the target variable or vector element into a new
307 `struct lvalue', which is returned. */
308 static struct lvalue *
311 struct lvalue *lvalue;
313 lvalue = xmalloc (sizeof *lvalue);
314 lvalue->var_name[0] = '\0';
315 lvalue->vector = NULL;
316 lvalue->element = NULL;
318 if (!lex_force_id ())
321 if (lex_look_ahead () == '(')
324 lvalue->vector = dict_lookup_vector (default_dict, tokid);
325 if (lvalue->vector == NULL)
327 msg (SE, _("There is no vector named %s."), tokid);
331 /* Vector element. */
333 if (!lex_force_match ('('))
335 lvalue->element = expr_parse (default_dict, EXPR_NUMBER);
336 if (lvalue->element == NULL)
338 if (!lex_force_match (')'))
344 str_copy_trunc (lvalue->var_name, sizeof lvalue->var_name, tokid);
350 lvalue_destroy (lvalue);
354 /* Returns the type (NUMERIC or ALPHA) of the target variable or
357 lvalue_get_type (const struct lvalue *lvalue)
359 if (lvalue->vector == NULL)
361 struct variable *var = dict_lookup_var (default_dict, lvalue->var_name);
368 return lvalue->vector->var[0]->type;
371 /* Returns nonzero if LVALUE has a vector as its target. */
373 lvalue_is_vector (const struct lvalue *lvalue)
375 return lvalue->vector != NULL;
378 /* Finalizes making LVALUE the target of COMPUTE, by creating the
379 target variable if necessary and setting fields in COMPUTE. */
381 lvalue_finalize (struct lvalue *lvalue, struct compute_trns *compute)
383 if (lvalue->vector == NULL)
385 compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
386 if (compute->variable == NULL)
387 compute->variable = dict_create_var_assert (default_dict,
388 lvalue->var_name, 0);
390 compute->fv = compute->variable->fv;
391 compute->width = compute->variable->width;
393 /* Goofy behavior, but compatible: Turn off LEAVE. */
394 if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
395 compute->variable->reinit = 1;
399 compute->vector = lvalue->vector;
400 compute->element = lvalue->element;
401 lvalue->element = NULL;
404 lvalue_destroy (lvalue);
407 /* Destroys LVALUE. */
409 lvalue_destroy (struct lvalue *lvalue)
414 expr_free (lvalue->element);