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