pintos-os.org Git - pspp/blob - src/language/xforms/compute.c

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