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   printf ("compute\n");
 133   if (compute->test == NULL
 134       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 135     {
 136       *c = case_unshare (*c);
 137       *case_num_rw (*c, compute->variable)
 138         = expr_evaluate_num (compute->rvalue, *c, case_num);
 139     }
 140
 141   return TRNS_CONTINUE;
 142 }
 143
 144 /* Handle COMPUTE or IF with numeric vector element target
 145    variable. */
 146 static enum trns_result
 147 compute_num_vec (void *compute_, struct ccase **c, casenumber case_num)
 148 {
 149   struct compute_trns *compute = compute_;
 150
 151   if (compute->test == NULL
 152       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 153     {
 154       double index;     /* Index into the vector. */
 155       int rindx;        /* Rounded index value. */
 156
 157       index = expr_evaluate_num (compute->element, *c, case_num);
 158       rindx = floor (index + EPSILON);
 159       if (index == SYSMIS
 160           || rindx < 1 || rindx > vector_get_n_vars (compute->vector))
 161         {
 162           if (index == SYSMIS)
 163             msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value "
 164                        "as an index into vector %s."),
 165                  vector_get_name (compute->vector));
 166           else
 167             msg (SW, _("When executing COMPUTE: %.*g is not a valid value as "
 168                        "an index into vector %s."),
 169                  DBL_DIG + 1, index, vector_get_name (compute->vector));
 170           return TRNS_CONTINUE;
 171         }
 172
 173       *c = case_unshare (*c);
 174       *case_num_rw (*c, vector_get_var (compute->vector, rindx - 1))
 175         = expr_evaluate_num (compute->rvalue, *c, case_num);
 176     }
 177
 178   return TRNS_CONTINUE;
 179 }
 180
 181 /* Handle COMPUTE or IF with string target variable. */
 182 static enum trns_result
 183 compute_str (void *compute_, struct ccase **c, casenumber case_num)
 184 {
 185   struct compute_trns *compute = compute_;
 186
 187   if (compute->test == NULL
 188       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 189     {
 190       char *s;
 191
 192       *c = case_unshare (*c);
 193       s = CHAR_CAST_BUG (char *, case_str_rw (*c, compute->variable));
 194       expr_evaluate_str (compute->rvalue, *c, case_num, s, compute->width);
 195     }
 196
 197   return TRNS_CONTINUE;
 198 }
 199
 200 /* Handle COMPUTE or IF with string vector element target
 201    variable. */
 202 static enum trns_result
 203 compute_str_vec (void *compute_, struct ccase **c, casenumber case_num)
 204 {
 205   struct compute_trns *compute = compute_;
 206
 207   if (compute->test == NULL
 208       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
 209     {
 210       double index;             /* Index into the vector. */
 211       int rindx;                /* Rounded index value. */
 212       struct variable *vr;      /* Variable reference by indexed vector. */
 213
 214       index = expr_evaluate_num (compute->element, *c, case_num);
 215       rindx = floor (index + EPSILON);
 216       if (index == SYSMIS)
 217         {
 218           msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
 219                      "value as an index into vector %s."),
 220                vector_get_name (compute->vector));
 221           return TRNS_CONTINUE;
 222         }
 223       else if (rindx < 1 || rindx > vector_get_n_vars (compute->vector))
 224         {
 225           msg (SW, _("When executing COMPUTE: %.*g is not a valid value as "
 226                      "an index into vector %s."),
 227                DBL_DIG + 1, index, vector_get_name (compute->vector));
 228           return TRNS_CONTINUE;
 229         }
 230
 231       vr = vector_get_var (compute->vector, rindx - 1);
 232       *c = case_unshare (*c);
 233       expr_evaluate_str (compute->rvalue, *c, case_num,
 234                          CHAR_CAST_BUG (char *, case_str_rw (*c, vr)),
 235                          var_get_width (vr));
 236     }
 237
 238   return TRNS_CONTINUE;
 239 }
 240 \f
 241 /* IF. */
 242
 243 int
 244 cmd_if (struct lexer *lexer, struct dataset *ds)
 245 {
 246   struct dictionary *dict = dataset_dict (ds);
 247   struct compute_trns *compute = NULL;
 248   struct lvalue *lvalue = NULL;
 249
 250   compute = compute_trns_create ();
 251
 252   /* Test expression. */
 253   compute->test = expr_parse_bool (lexer, ds);
 254   if (compute->test == NULL)
 255     goto fail;
 256
 257   /* Lvalue variable. */
 258   lvalue = lvalue_parse (lexer, ds);
 259   if (lvalue == NULL)
 260     goto fail;
 261
 262   /* Rvalue expression. */
 263   if (!lex_force_match (lexer, T_EQUALS))
 264     goto fail;
 265   compute->rvalue = parse_rvalue (lexer, lvalue, ds);
 266   if (compute->rvalue == NULL)
 267     goto fail;
 268
 269   add_transformation (ds, get_trns_class (lvalue), compute);
 270
 271   lvalue_finalize (lvalue, compute, dict);
 272
 273   return CMD_SUCCESS;
 274
 275  fail:
 276   lvalue_destroy (lvalue, dict);
 277   compute_trns_free (compute);
 278   return CMD_CASCADING_FAILURE;
 279 }
 280 \f
 281 /* Code common to COMPUTE and IF. */
 282
 283 static const struct trns_class *
 284 get_trns_class (const struct lvalue *lvalue)
 285 {
 286   static const struct trns_class classes[2][2] = {
 287     [false][false] = {
 288       .name = "COMPUTE",
 289       .execute = compute_str,
 290       .destroy = compute_trns_free
 291     },
 292     [false][true] = {
 293       .name = "COMPUTE",
 294       .execute = compute_str_vec,
 295       .destroy = compute_trns_free
 296     },
 297     [true][false] = {
 298       .name = "COMPUTE",
 299       .execute = compute_num,
 300       .destroy = compute_trns_free
 301     },
 302     [true][true] = {
 303       .name = "COMPUTE",
 304       .execute = compute_num_vec,
 305       .destroy = compute_trns_free
 306     },
 307   };
 308
 309   bool is_numeric = lvalue_get_type (lvalue) == VAL_NUMERIC;
 310   bool is_vector = lvalue_is_vector (lvalue);
 311   return &classes[is_numeric][is_vector];
 312 }
 313
 314 /* Parses and returns an rvalue expression of the same type as
 315    LVALUE, or a null pointer on failure. */
 316 static struct expression *
 317 parse_rvalue (struct lexer *lexer,
 318               const struct lvalue *lvalue, struct dataset *ds)
 319 {
 320   if (lvalue->is_new_variable)
 321     return expr_parse_new_variable (lexer, ds, var_get_name (lvalue->variable));
 322   else
 323     return expr_parse (lexer, ds, lvalue_get_type (lvalue));
 324 }
 325
 326 /* Returns a new struct compute_trns after initializing its fields. */
 327 static struct compute_trns *
 328 compute_trns_create (void)
 329 {
 330   struct compute_trns *compute = xmalloc (sizeof *compute);
 331   compute->test = NULL;
 332   compute->variable = NULL;
 333   compute->vector = NULL;
 334   compute->element = NULL;
 335   compute->rvalue = NULL;
 336   return compute;
 337 }
 338
 339 /* Deletes all the fields in COMPUTE. */
 340 static bool
 341 compute_trns_free (void *compute_)
 342 {
 343   struct compute_trns *compute = compute_;
 344
 345   if (compute != NULL)
 346     {
 347       expr_free (compute->test);
 348       expr_free (compute->element);
 349       expr_free (compute->rvalue);
 350       free (compute);
 351     }
 352   return true;
 353 }
 354 \f
 355 /* Parses the target variable or vector element into a new
 356    `struct lvalue', which is returned. */
 357 static struct lvalue *
 358 lvalue_parse (struct lexer *lexer, struct dataset *ds)
 359 {
 360   struct dictionary *dict = dataset_dict (ds);
 361   struct lvalue *lvalue;
 362
 363   lvalue = xmalloc (sizeof *lvalue);
 364   lvalue->variable = NULL;
 365   lvalue->is_new_variable = false;
 366   lvalue->vector = NULL;
 367   lvalue->element = NULL;
 368
 369   if (!lex_force_id (lexer))
 370     goto lossage;
 371
 372   if (lex_next_token (lexer, 1) == T_LPAREN)
 373     {
 374       /* Vector. */
 375       lvalue->vector = dict_lookup_vector (dict, lex_tokcstr (lexer));
 376       if (lvalue->vector == NULL)
 377         {
 378           msg (SE, _("There is no vector named %s."), 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 }