src/language/xforms/compute.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2009 Free Software Foundation, Inc.
   3
   4    This program is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This program is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU General Public License for more details.
  13
  14    You should have received a copy of the GNU General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  16
  17 #include <config.h>
  18
  19 #include <stdint.h>
  20 #include <stdlib.h>
  21
  22 #include <data/case.h>
  23 #include <data/dictionary.h>
  24 #include <data/procedure.h>
  25 #include <data/transformations.h>
  26 #include <data/variable.h>
  27 #include <data/vector.h>
  28 #include <language/command.h>
  29 #include <language/expressions/public.h>
  30 #include <language/lexer/lexer.h>
  31 #include <libpspp/message.h>
  32 #include <libpspp/misc.h>
  33 #include <libpspp/str.h>
  34
  35 #include "xalloc.h"
  36
  37 #include "gettext.h"
  38 #define _(msgid) gettext (msgid)
  39
  40 struct compute_trns;
  41 struct lvalue;
  42
  43 /* Target of a COMPUTE or IF assignment, either a variable or a
  44    vector element. */
  45 static struct lvalue *lvalue_parse (struct lexer *lexer, struct dataset *);
  46 static int lvalue_get_type (const struct lvalue *);
  47 static bool lvalue_is_vector (const struct lvalue *);
  48 static void lvalue_finalize (struct lvalue *,
  49                              struct compute_trns *, struct dictionary *);
  50 static void lvalue_destroy (struct lvalue *, struct dictionary *);
  51
  52 /* COMPUTE and IF transformation. */
  53 struct compute_trns
  54   {
  55     /* Test expression (IF only). */
  56     struct expression *test;     /* Test expression. */
  57
  58     /* Variable lvalue, if variable != NULL. */
  59     struct variable *variable;   /* Destination variable, if any. */
  60     int width;                   /* Lvalue string width; 0=numeric. */
  61
  62     /* Vector lvalue, if vector != NULL. */
  63     const struct vector *vector; /* Destination vector, if any. */
  64     struct expression *element;  /* Destination vector element expr. */
  65
  66     /* Rvalue. */
  67     struct expression *rvalue;   /* Rvalue expression. */
  68   };
  69
  70 static struct expression *parse_rvalue (struct lexer *lexer,
  71                                         const struct lvalue *,
  72                                         struct dataset *);
  73
  74 static struct compute_trns *compute_trns_create (void);
  75 static trns_proc_func *get_proc_func (const struct lvalue *);
  76 static trns_free_func compute_trns_free;
  77 \f
  78 /* COMPUTE. */
  79
  80 int
  81 cmd_compute (struct lexer *lexer, struct dataset *ds)
  82 {
  83   struct dictionary *dict = dataset_dict (ds);
  84   struct lvalue *lvalue = NULL;
  85   struct compute_trns *compute = NULL;
  86
  87   compute = compute_trns_create ();
  88
  89   lvalue = lvalue_parse (lexer, ds);
  90   if (lvalue == NULL)
  91     goto fail;
  92
  93   if (!lex_force_match (lexer, '='))
  94     goto fail;
  95   compute->rvalue = parse_rvalue (lexer, lvalue, ds);
  96   if (compute->rvalue == NULL)
  97     goto fail;
  98
  99   add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
 100
 101   lvalue_finalize (lvalue, compute, dict);
 102
 103   return lex_end_of_command (lexer);
 104
 105  fail:
 106   lvalue_destroy (lvalue, dict);
 107   compute_trns_free (compute);
 108   return CMD_CASCADING_FAILURE;
 109 }
 110 \f
 111 /* Transformation functions. */
 112
 113 /* Handle COMPUTE or IF with numeric target variable. */
 114 static int
 115 compute_num (void *compute_, struct ccase **c, casenumber case_num)
 116 {
 117   struct compute_trns *compute = compute_;
 118
 119   if (compute->test == NULL
 120       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 121     {
 122       *c = case_unshare (*c);
 123       case_data_rw (*c, compute->variable)->f
 124         = expr_evaluate_num (compute->rvalue, *c, case_num);
 125     }
 126
 127   return TRNS_CONTINUE;
 128 }
 129
 130 /* Handle COMPUTE or IF with numeric vector element target
 131    variable. */
 132 static int
 133 compute_num_vec (void *compute_, struct ccase **c, casenumber case_num)
 134 {
 135   struct compute_trns *compute = compute_;
 136
 137   if (compute->test == NULL
 138       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 139     {
 140       double index;     /* Index into the vector. */
 141       int rindx;        /* Rounded index value. */
 142
 143       index = expr_evaluate_num (compute->element, *c, case_num);
 144       rindx = floor (index + EPSILON);
 145       if (index == SYSMIS
 146           || rindx < 1 || rindx > vector_get_var_cnt (compute->vector))
 147         {
 148           if (index == SYSMIS)
 149             msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value "
 150                        "as an index into vector %s."),
 151                  vector_get_name (compute->vector));
 152           else
 153             msg (SW, _("When executing COMPUTE: %g is not a valid value as "
 154                        "an index into vector %s."),
 155                  index, vector_get_name (compute->vector));
 156           return TRNS_CONTINUE;
 157         }
 158
 159       *c = case_unshare (*c);
 160       case_data_rw (*c, vector_get_var (compute->vector, rindx - 1))->f
 161         = expr_evaluate_num (compute->rvalue, *c, case_num);
 162     }
 163
 164   return TRNS_CONTINUE;
 165 }
 166
 167 /* Handle COMPUTE or IF with string target variable. */
 168 static int
 169 compute_str (void *compute_, struct ccase **c, casenumber case_num)
 170 {
 171   struct compute_trns *compute = compute_;
 172
 173   if (compute->test == NULL
 174       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 175     {
 176       *c = case_unshare (*c);
 177       expr_evaluate_str (compute->rvalue, *c, case_num,
 178                          case_data_rw (*c, compute->variable)->s,
 179                          compute->width);
 180     }
 181
 182   return TRNS_CONTINUE;
 183 }
 184
 185 /* Handle COMPUTE or IF with string vector element target
 186    variable. */
 187 static int
 188 compute_str_vec (void *compute_, struct ccase **c, casenumber case_num)
 189 {
 190   struct compute_trns *compute = compute_;
 191
 192   if (compute->test == NULL
 193       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 194     {
 195       double index;             /* Index into the vector. */
 196       int rindx;                /* Rounded index value. */
 197       struct variable *vr;      /* Variable reference by indexed vector. */
 198
 199       index = expr_evaluate_num (compute->element, *c, case_num);
 200       rindx = floor (index + EPSILON);
 201       if (index == SYSMIS)
 202         {
 203           msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
 204                      "value as an index into vector %s."),
 205                vector_get_name (compute->vector));
 206           return TRNS_CONTINUE;
 207         }
 208       else if (rindx < 1 || rindx > vector_get_var_cnt (compute->vector))
 209         {
 210           msg (SW, _("When executing COMPUTE: %g is not a valid value as "
 211                      "an index into vector %s."),
 212                index, vector_get_name (compute->vector));
 213           return TRNS_CONTINUE;
 214         }
 215
 216       vr = vector_get_var (compute->vector, rindx - 1);
 217       *c = case_unshare (*c);
 218       expr_evaluate_str (compute->rvalue, *c, case_num,
 219                          case_data_rw (*c, vr)->s,
 220                          var_get_width (vr));
 221     }
 222
 223   return TRNS_CONTINUE;
 224 }
 225 \f
 226 /* IF. */
 227
 228 int
 229 cmd_if (struct lexer *lexer, struct dataset *ds)
 230 {
 231   struct dictionary *dict = dataset_dict (ds);
 232   struct compute_trns *compute = NULL;
 233   struct lvalue *lvalue = NULL;
 234
 235   compute = compute_trns_create ();
 236
 237   /* Test expression. */
 238   compute->test = expr_parse (lexer, ds, EXPR_BOOLEAN);
 239   if (compute->test == NULL)
 240     goto fail;
 241
 242   /* Lvalue variable. */
 243   lvalue = lvalue_parse (lexer, ds);
 244   if (lvalue == NULL)
 245     goto fail;
 246
 247   /* Rvalue expression. */
 248   if (!lex_force_match (lexer, '='))
 249     goto fail;
 250   compute->rvalue = parse_rvalue (lexer, lvalue, ds);
 251   if (compute->rvalue == NULL)
 252     goto fail;
 253
 254   add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
 255
 256   lvalue_finalize (lvalue, compute, dict);
 257
 258   return lex_end_of_command (lexer);
 259
 260  fail:
 261   lvalue_destroy (lvalue, dict);
 262   compute_trns_free (compute);
 263   return CMD_CASCADING_FAILURE;
 264 }
 265 \f
 266 /* Code common to COMPUTE and IF. */
 267
 268 static trns_proc_func *
 269 get_proc_func (const struct lvalue *lvalue)
 270 {
 271   bool is_numeric = lvalue_get_type (lvalue) == VAL_NUMERIC;
 272   bool is_vector = lvalue_is_vector (lvalue);
 273
 274   return (is_numeric
 275           ? (is_vector ? compute_num_vec : compute_num)
 276           : (is_vector ? compute_str_vec : compute_str));
 277 }
 278
 279 /* Parses and returns an rvalue expression of the same type as
 280    LVALUE, or a null pointer on failure. */
 281 static struct expression *
 282 parse_rvalue (struct lexer *lexer,
 283               const struct lvalue *lvalue, struct dataset *ds)
 284 {
 285   bool is_numeric = lvalue_get_type (lvalue) == VAL_NUMERIC;
 286
 287   return expr_parse (lexer, ds, is_numeric ? EXPR_NUMBER : EXPR_STRING);
 288 }
 289
 290 /* Returns a new struct compute_trns after initializing its fields. */
 291 static struct compute_trns *
 292 compute_trns_create (void)
 293 {
 294   struct compute_trns *compute = xmalloc (sizeof *compute);
 295   compute->test = NULL;
 296   compute->variable = NULL;
 297   compute->vector = NULL;
 298   compute->element = NULL;
 299   compute->rvalue = NULL;
 300   return compute;
 301 }
 302
 303 /* Deletes all the fields in COMPUTE. */
 304 static bool
 305 compute_trns_free (void *compute_)
 306 {
 307   struct compute_trns *compute = compute_;
 308
 309   if (compute != NULL)
 310     {
 311       expr_free (compute->test);
 312       expr_free (compute->element);
 313       expr_free (compute->rvalue);
 314       free (compute);
 315     }
 316   return true;
 317 }
 318 \f
 319 /* COMPUTE or IF target variable or vector element.
 320    For a variable, the `variable' member is non-null.
 321    For a vector element, the `vector' member is non-null. */
 322 struct lvalue
 323   {
 324     struct variable *variable;   /* Destination variable. */
 325     bool is_new_variable;        /* Did we create the variable? */
 326
 327     const struct vector *vector; /* Destination vector, if any, or NULL. */
 328     struct expression *element;  /* Destination vector element, or NULL. */
 329   };
 330
 331 /* Parses the target variable or vector element into a new
 332    `struct lvalue', which is returned. */
 333 static struct lvalue *
 334 lvalue_parse (struct lexer *lexer, struct dataset *ds)
 335 {
 336   struct dictionary *dict = dataset_dict (ds);
 337   struct lvalue *lvalue;
 338
 339   lvalue = xmalloc (sizeof *lvalue);
 340   lvalue->variable = NULL;
 341   lvalue->is_new_variable = false;
 342   lvalue->vector = NULL;
 343   lvalue->element = NULL;
 344
 345   if (!lex_force_id (lexer))
 346     goto lossage;
 347
 348   if (lex_look_ahead (lexer) == '(')
 349     {
 350       /* Vector. */
 351       lvalue->vector = dict_lookup_vector (dict, lex_tokid (lexer));
 352       if (lvalue->vector == NULL)
 353         {
 354           msg (SE, _("There is no vector named %s."), lex_tokid (lexer));
 355           goto lossage;
 356         }
 357
 358       /* Vector element. */
 359       lex_get (lexer);
 360       if (!lex_force_match (lexer, '('))
 361         goto lossage;
 362       lvalue->element = expr_parse (lexer, ds, EXPR_NUMBER);
 363       if (lvalue->element == NULL)
 364         goto lossage;
 365       if (!lex_force_match (lexer, ')'))
 366         goto lossage;
 367     }
 368   else
 369     {
 370       /* Variable name. */
 371       const char *var_name = lex_tokid (lexer);
 372       lvalue->variable = dict_lookup_var (dict, var_name);
 373       if (lvalue->variable == NULL)
 374         {
 375           lvalue->variable = dict_create_var_assert (dict, var_name, 0);
 376           lvalue->is_new_variable = true;
 377         }
 378       lex_get (lexer);
 379     }
 380   return lvalue;
 381
 382  lossage:
 383   lvalue_destroy (lvalue, dict);
 384   return NULL;
 385 }
 386
 387 /* Returns the type (NUMERIC or ALPHA) of the target variable or
 388    vector in LVALUE. */
 389 static int
 390 lvalue_get_type (const struct lvalue *lvalue)
 391 {
 392   return (lvalue->variable != NULL
 393           ? var_get_type (lvalue->variable)
 394           : vector_get_type (lvalue->vector));
 395 }
 396
 397 /* Returns true if LVALUE has a vector as its target. */
 398 static bool
 399 lvalue_is_vector (const struct lvalue *lvalue)
 400 {
 401   return lvalue->vector != NULL;
 402 }
 403
 404 /* Finalizes making LVALUE the target of COMPUTE, by creating the
 405    target variable if necessary and setting fields in COMPUTE. */
 406 static void
 407 lvalue_finalize (struct lvalue *lvalue,
 408                  struct compute_trns *compute,
 409                  struct dictionary *dict)
 410 {
 411   if (lvalue->vector == NULL)
 412     {
 413       compute->variable = lvalue->variable;
 414       compute->width = var_get_width (compute->variable);
 415
 416       /* Goofy behavior, but compatible: Turn off LEAVE. */
 417       if (!var_must_leave (compute->variable))
 418         var_set_leave (compute->variable, false);
 419
 420       /* Prevent lvalue_destroy from deleting variable. */
 421       lvalue->is_new_variable = false;
 422     }
 423   else
 424     {
 425       compute->vector = lvalue->vector;
 426       compute->element = lvalue->element;
 427       lvalue->element = NULL;
 428     }
 429
 430   lvalue_destroy (lvalue, dict);
 431 }
 432
 433 /* Destroys LVALUE. */
 434 static void
 435 lvalue_destroy (struct lvalue *lvalue, struct dictionary *dict)
 436 {
 437   if (lvalue == NULL)
 438      return;
 439
 440   if (lvalue->is_new_variable)
 441     dict_delete_var (dict, lvalue->variable);
 442   expr_free (lvalue->element);
 443   free (lvalue);
 444 }