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_str_rw (*c, compute->variable),
 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_str_rw (*c, vr), var_get_width (vr));
 220     }
 221
 222   return TRNS_CONTINUE;
 223 }
 224 \f
 225 /* IF. */
 226
 227 int
 228 cmd_if (struct lexer *lexer, struct dataset *ds)
 229 {
 230   struct dictionary *dict = dataset_dict (ds);
 231   struct compute_trns *compute = NULL;
 232   struct lvalue *lvalue = NULL;
 233
 234   compute = compute_trns_create ();
 235
 236   /* Test expression. */
 237   compute->test = expr_parse (lexer, ds, EXPR_BOOLEAN);
 238   if (compute->test == NULL)
 239     goto fail;
 240
 241   /* Lvalue variable. */
 242   lvalue = lvalue_parse (lexer, ds);
 243   if (lvalue == NULL)
 244     goto fail;
 245
 246   /* Rvalue expression. */
 247   if (!lex_force_match (lexer, '='))
 248     goto fail;
 249   compute->rvalue = parse_rvalue (lexer, lvalue, ds);
 250   if (compute->rvalue == NULL)
 251     goto fail;
 252
 253   add_transformation (ds, get_proc_func (lvalue), compute_trns_free, compute);
 254
 255   lvalue_finalize (lvalue, compute, dict);
 256
 257   return lex_end_of_command (lexer);
 258
 259  fail:
 260   lvalue_destroy (lvalue, dict);
 261   compute_trns_free (compute);
 262   return CMD_CASCADING_FAILURE;
 263 }
 264 \f
 265 /* Code common to COMPUTE and IF. */
 266
 267 static trns_proc_func *
 268 get_proc_func (const struct lvalue *lvalue)
 269 {
 270   bool is_numeric = lvalue_get_type (lvalue) == VAL_NUMERIC;
 271   bool is_vector = lvalue_is_vector (lvalue);
 272
 273   return (is_numeric
 274           ? (is_vector ? compute_num_vec : compute_num)
 275           : (is_vector ? compute_str_vec : compute_str));
 276 }
 277
 278 /* Parses and returns an rvalue expression of the same type as
 279    LVALUE, or a null pointer on failure. */
 280 static struct expression *
 281 parse_rvalue (struct lexer *lexer,
 282               const struct lvalue *lvalue, struct dataset *ds)
 283 {
 284   bool is_numeric = lvalue_get_type (lvalue) == VAL_NUMERIC;
 285
 286   return expr_parse (lexer, ds, is_numeric ? EXPR_NUMBER : EXPR_STRING);
 287 }
 288
 289 /* Returns a new struct compute_trns after initializing its fields. */
 290 static struct compute_trns *
 291 compute_trns_create (void)
 292 {
 293   struct compute_trns *compute = xmalloc (sizeof *compute);
 294   compute->test = NULL;
 295   compute->variable = NULL;
 296   compute->vector = NULL;
 297   compute->element = NULL;
 298   compute->rvalue = NULL;
 299   return compute;
 300 }
 301
 302 /* Deletes all the fields in COMPUTE. */
 303 static bool
 304 compute_trns_free (void *compute_)
 305 {
 306   struct compute_trns *compute = compute_;
 307
 308   if (compute != NULL)
 309     {
 310       expr_free (compute->test);
 311       expr_free (compute->element);
 312       expr_free (compute->rvalue);
 313       free (compute);
 314     }
 315   return true;
 316 }
 317 \f
 318 /* COMPUTE or IF target variable or vector element.
 319    For a variable, the `variable' member is non-null.
 320    For a vector element, the `vector' member is non-null. */
 321 struct lvalue
 322   {
 323     struct variable *variable;   /* Destination variable. */
 324     bool is_new_variable;        /* Did we create the variable? */
 325
 326     const struct vector *vector; /* Destination vector, if any, or NULL. */
 327     struct expression *element;  /* Destination vector element, or NULL. */
 328   };
 329
 330 /* Parses the target variable or vector element into a new
 331    `struct lvalue', which is returned. */
 332 static struct lvalue *
 333 lvalue_parse (struct lexer *lexer, struct dataset *ds)
 334 {
 335   struct dictionary *dict = dataset_dict (ds);
 336   struct lvalue *lvalue;
 337
 338   lvalue = xmalloc (sizeof *lvalue);
 339   lvalue->variable = NULL;
 340   lvalue->is_new_variable = false;
 341   lvalue->vector = NULL;
 342   lvalue->element = NULL;
 343
 344   if (!lex_force_id (lexer))
 345     goto lossage;
 346
 347   if (lex_look_ahead (lexer) == '(')
 348     {
 349       /* Vector. */
 350       lvalue->vector = dict_lookup_vector (dict, lex_tokid (lexer));
 351       if (lvalue->vector == NULL)
 352         {
 353           msg (SE, _("There is no vector named %s."), lex_tokid (lexer));
 354           goto lossage;
 355         }
 356
 357       /* Vector element. */
 358       lex_get (lexer);
 359       if (!lex_force_match (lexer, '('))
 360         goto lossage;
 361       lvalue->element = expr_parse (lexer, ds, EXPR_NUMBER);
 362       if (lvalue->element == NULL)
 363         goto lossage;
 364       if (!lex_force_match (lexer, ')'))
 365         goto lossage;
 366     }
 367   else
 368     {
 369       /* Variable name. */
 370       const char *var_name = lex_tokid (lexer);
 371       lvalue->variable = dict_lookup_var (dict, var_name);
 372       if (lvalue->variable == NULL)
 373         {
 374           lvalue->variable = dict_create_var_assert (dict, var_name, 0);
 375           lvalue->is_new_variable = true;
 376         }
 377       lex_get (lexer);
 378     }
 379   return lvalue;
 380
 381  lossage:
 382   lvalue_destroy (lvalue, dict);
 383   return NULL;
 384 }
 385
 386 /* Returns the type (NUMERIC or ALPHA) of the target variable or
 387    vector in LVALUE. */
 388 static int
 389 lvalue_get_type (const struct lvalue *lvalue)
 390 {
 391   return (lvalue->variable != NULL
 392           ? var_get_type (lvalue->variable)
 393           : vector_get_type (lvalue->vector));
 394 }
 395
 396 /* Returns true if LVALUE has a vector as its target. */
 397 static bool
 398 lvalue_is_vector (const struct lvalue *lvalue)
 399 {
 400   return lvalue->vector != NULL;
 401 }
 402
 403 /* Finalizes making LVALUE the target of COMPUTE, by creating the
 404    target variable if necessary and setting fields in COMPUTE. */
 405 static void
 406 lvalue_finalize (struct lvalue *lvalue,
 407                  struct compute_trns *compute,
 408                  struct dictionary *dict)
 409 {
 410   if (lvalue->vector == NULL)
 411     {
 412       compute->variable = lvalue->variable;
 413       compute->width = var_get_width (compute->variable);
 414
 415       /* Goofy behavior, but compatible: Turn off LEAVE. */
 416       if (!var_must_leave (compute->variable))
 417         var_set_leave (compute->variable, false);
 418
 419       /* Prevent lvalue_destroy from deleting variable. */
 420       lvalue->is_new_variable = false;
 421     }
 422   else
 423     {
 424       compute->vector = lvalue->vector;
 425       compute->element = lvalue->element;
 426       lvalue->element = NULL;
 427     }
 428
 429   lvalue_destroy (lvalue, dict);
 430 }
 431
 432 /* Destroys LVALUE. */
 433 static void
 434 lvalue_destroy (struct lvalue *lvalue, struct dictionary *dict)
 435 {
 436   if (lvalue == NULL)
 437      return;
 438
 439   if (lvalue->is_new_variable)
 440     dict_delete_var (dict, lvalue->variable);
 441   expr_free (lvalue->element);
 442   free (lvalue);
 443 }