src/recode.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21 #include <assert.h>
  22 #include <ctype.h>
  23 #include <stdlib.h>
  24 #include "alloc.h"
  25 #include "approx.h"
  26 #include "cases.h"
  27 #include "command.h"
  28 #include "error.h"
  29 #include "lexer.h"
  30 #include "magic.h"
  31 #include "str.h"
  32 #include "var.h"
  33
  34 #undef DEBUGGING
  35 /*#define DEBUGGING 1 */
  36 #include "debug-print.h"
  37 \f
  38 /* Definitions. */
  39
  40 enum
  41   {
  42     RCD_END,                    /* sentinel value */
  43     RCD_USER,                   /* user-missing => one */
  44     RCD_SINGLE,                 /* one => one */
  45     RCD_HIGH,                   /* x > a => one */
  46     RCD_LOW,                    /* x < b => one */
  47     RCD_RANGE,                  /* b < x < a => one */
  48     RCD_ELSE,                   /* any but SYSMIS => one */
  49     RCD_CONVERT                 /* "123" => 123 */
  50   };
  51
  52 /* Describes how to recode a single value or range of values into a
  53    single value.  */
  54 struct coding
  55   {
  56     int type;                   /* RCD_* */
  57     union value f1, f2;         /* Describe value or range as src.  Long
  58                                    strings are stored in `c'. */
  59     union value t;              /* Describes value as dest. Long strings in `c'. */
  60   };
  61
  62 /* Describes how to recode a single variable. */
  63 struct rcd_var
  64   {
  65     struct rcd_var *next;
  66
  67     unsigned flags;             /* RCD_SRC_* | RCD_DEST_* | RCD_MISC_* */
  68
  69     struct variable *src;       /* Source variable. */
  70     struct variable *dest;      /* Destination variable. */
  71     char dest_name[9];          /* Name of dest variable if we're creating it. */
  72
  73     int has_sysmis;             /* Do we recode for SYSMIS? */
  74     union value sysmis;         /* Coding for SYSMIS (if src is numeric). */
  75
  76     struct coding *map;         /* Coding for other values. */
  77     int nmap, mmap;             /* Length of map, max capacity of map. */
  78   };
  79
  80 /* RECODE transformation. */
  81 struct recode_trns
  82   {
  83     struct trns_header h;
  84     struct rcd_var *codings;
  85   };
  86
  87 /* What we're recoding from (`src'==`source'). */
  88 #define RCD_SRC_ERROR           0000u   /* Bad value for src. */
  89 #define RCD_SRC_NUMERIC         0001u   /* Src is numeric. */
  90 #define RCD_SRC_STRING          0002u   /* Src is short string. */
  91 #define RCD_SRC_MASK            0003u   /* AND mask to isolate src bits. */
  92
  93 /* What we're recoding to (`dest'==`destination'). */
  94 #define RCD_DEST_ERROR          0000u   /* Bad value for dest. */
  95 #define RCD_DEST_NUMERIC        0004u   /* Dest is numeric. */
  96 #define RCD_DEST_STRING         0010u   /* Dest is short string. */
  97 #define RCD_DEST_MASK           0014u   /* AND mask to isolate dest bits. */
  98
  99 /* Miscellaneous bits. */
 100 #define RCD_MISC_CREATE         0020u   /* We create dest var (numeric only) */
 101 #define RCD_MISC_DUPLICATE      0040u   /* This var_info has the same MAP
 102                                            value as the previous var_info.
 103                                            Prevents redundant free()ing. */
 104 #define RCD_MISC_MISSING        0100u   /* Encountered MISSING or SYSMIS in
 105                                            this input spec. */
 106
 107 static int parse_dest_spec (struct rcd_var * rcd, union value *v,
 108                             size_t *max_dst_width);
 109 static int parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width);
 110 static int recode_trns_proc (struct trns_header *, struct ccase *);
 111 static void recode_trns_free (struct trns_header *);
 112 static double convert_to_double (char *, int);
 113
 114 #if DEBUGGING
 115 static void debug_print (rcd_var * head);
 116 #endif
 117 \f
 118 /* Parser. */
 119
 120 /* First transformation in the list.  rcd is in this list. */
 121 static struct rcd_var *head;
 122
 123 /* Variables in the current part of the recoding. */
 124 struct variable **v;
 125 int nv;
 126
 127 /* Parses the RECODE transformation. */
 128 int
 129 cmd_recode (void)
 130 {
 131   int i;
 132
 133   /* Transformation that we're constructing. */
 134   struct rcd_var *rcd;
 135
 136   /* Type of the src variables. */
 137   int type;
 138
 139   /* Length of longest src string. */
 140   size_t max_src_width;
 141
 142   /* Length of longest dest string. */
 143   size_t max_dst_width;
 144
 145   /* For stepping through, constructing the linked list of
 146      recodings. */
 147   struct rcd_var *iter;
 148
 149   /* The real transformation, just a wrapper for a list of
 150      rcd_var's. */
 151   struct recode_trns *trns;
 152
 153   lex_match_id ("RECODE");
 154
 155   /* Parses each specification between slashes. */
 156   head = rcd = xmalloc (sizeof *rcd);
 157   for (;;)
 158     {
 159       /* Whether we've already encountered a specification for SYSMIS. */
 160       int had_sysmis = 0;
 161
 162       /* Initialize this rcd_var to ensure proper cleanup. */
 163       rcd->next = NULL;
 164       rcd->map = NULL;
 165       rcd->nmap = rcd->mmap = 0;
 166       rcd->has_sysmis = 0;
 167       rcd->sysmis.f = 0;
 168
 169       /* Parse variable names. */
 170       if (!parse_variables (NULL, &v, &nv, PV_SAME_TYPE))
 171         goto lossage;
 172
 173       /* Ensure all variables are same type; find length of longest
 174          source variable. */
 175       type = v[0]->type;
 176       max_src_width = v[0]->width;
 177
 178       if (type == ALPHA)
 179         for (i = 0; i < nv; i++)
 180           if (v[i]->width > (int) max_src_width)
 181             max_src_width = v[i]->width;
 182
 183       /* Set up flags. */
 184       rcd->flags = 0;
 185       if (type == NUMERIC)
 186         rcd->flags |= RCD_SRC_NUMERIC;
 187       else
 188         rcd->flags |= RCD_SRC_STRING;
 189
 190       /* Parse each coding in parentheses. */
 191       max_dst_width = 0;
 192       if (!lex_force_match ('('))
 193         goto lossage;
 194       for (;;)
 195         {
 196           /* Get the input value (before the `='). */
 197           int mark = rcd->nmap;
 198           int code = parse_src_spec (rcd, type, max_src_width);
 199           if (!code)
 200             goto lossage;
 201
 202           /* ELSE is the same as any other input spec except that it
 203              precludes later sysmis specifications. */
 204           if (code == 3)
 205             {
 206               had_sysmis = 1;
 207               code = 1;
 208             }
 209
 210           /* If keyword CONVERT was specified, there is no output
 211              specification.  */
 212           if (code == 1)
 213             {
 214               union value output;
 215
 216               /* Get the output value (after the `='). */
 217               lex_get ();       /* Skip `='. */
 218               if (!parse_dest_spec (rcd, &output, &max_dst_width))
 219                 goto lossage;
 220
 221               /* Set the value for SYSMIS if requested and if we don't
 222                  already have one. */
 223               if ((rcd->flags & RCD_MISC_MISSING) && !had_sysmis)
 224                 {
 225                   rcd->has_sysmis = 1;
 226                   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 227                     rcd->sysmis.f = output.f;
 228                   else
 229                     rcd->sysmis.c = xstrdup (output.c);
 230                   had_sysmis = 1;
 231
 232                   rcd->flags &= ~RCD_MISC_MISSING;
 233                 }
 234
 235               /* Since there may be multiple input values for a single
 236                  output, the output value need to propagated among all
 237                  of them. */
 238               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 239                 for (i = mark; i < rcd->nmap; i++)
 240                   rcd->map[i].t.f = output.f;
 241               else
 242                 {
 243                   for (i = mark; i < rcd->nmap; i++)
 244                     rcd->map[i].t.c = xstrdup (output.c);
 245                   free (output.c);
 246                 }
 247             }
 248           lex_get ();           /* Skip `)'. */
 249           if (!lex_match ('('))
 250             break;
 251         }
 252
 253       /* Append sentinel value. */
 254       rcd->map[rcd->nmap++].type = RCD_END;
 255
 256       /* Since multiple variables may use the same recodings, it is
 257          necessary to propogate the codings to all of them. */
 258       rcd->src = v[0];
 259       rcd->dest = v[0];
 260       rcd->dest_name[0] = 0;
 261       iter = rcd;
 262       for (i = 1; i < nv; i++)
 263         {
 264           iter = iter->next = xmalloc (sizeof *iter);
 265           iter->next = NULL;
 266           iter->flags = rcd->flags | RCD_MISC_DUPLICATE;
 267           iter->src = v[i];
 268           iter->dest = v[i];
 269           iter->dest_name[0] = 0;
 270           iter->has_sysmis = rcd->has_sysmis;
 271           iter->sysmis = rcd->sysmis;
 272           iter->map = rcd->map;
 273         }
 274
 275       if (lex_match_id ("INTO"))
 276         {
 277           char **names;
 278           int nnames;
 279
 280           int success = 0;
 281
 282           if (!parse_mixed_vars (&names, &nnames, PV_NONE))
 283             goto lossage;
 284
 285           if (nnames != nv)
 286             {
 287               for (i = 0; i < nnames; i++)
 288                 free (names[i]);
 289               free (names);
 290               msg (SE, _("%d variable(s) cannot be recoded into "
 291                          "%d variable(s).  Specify the same number "
 292                          "of variables as input and output variables."),
 293                    nv, nnames);
 294               goto lossage;
 295             }
 296
 297           if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
 298             for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
 299               {
 300                 struct variable *v = find_variable (names[i]);
 301
 302                 if (!v)
 303                   {
 304                     msg (SE, _("There is no string variable named "
 305                          "%s.  (All string variables specified "
 306                          "on INTO must already exist.  Use the "
 307                          "STRING command to create a string "
 308                          "variable.)"), names[i]);
 309                     goto INTO_fail;
 310                   }
 311                 if (v->type != ALPHA)
 312                   {
 313                     msg (SE, _("Type mismatch between input and output "
 314                          "variables.  Output variable %s is not "
 315                          "a string variable, but all the input "
 316                          "variables are string variables."), v->name);
 317                     goto INTO_fail;
 318                   }
 319                 if (v->width > (int) max_dst_width)
 320                   max_dst_width = v->width;
 321                 iter->dest = v;
 322               }
 323           else
 324             for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
 325               {
 326                 struct variable *v = find_variable (names[i]);
 327
 328                 if (v)
 329                   {
 330                     if (v->type != NUMERIC)
 331                       {
 332                         msg (SE, _("Type mismatch after INTO: %s "
 333                                    "is not a numeric variable."), v->name);
 334                         goto INTO_fail;
 335                       }
 336                     else
 337                       iter->dest = v;
 338                   }
 339                 else
 340                   strcpy (iter->dest_name, names[i]);
 341               }
 342           success = 1;
 343
 344           /* Note that regardless of whether we succeed or fail,
 345              flow-of-control comes here.  `success' is the important
 346              factor.  Ah, if C had garbage collection...  */
 347         INTO_fail:
 348           for (i = 0; i < nnames; i++)
 349             free (names[i]);
 350           free (names);
 351           if (!success)
 352             goto lossage;
 353         }
 354       else
 355         {
 356           if (max_src_width > max_dst_width)
 357             max_dst_width = max_src_width;
 358
 359           if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC
 360               && (rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
 361             {
 362               msg (SE, _("INTO must be used when the input values are "
 363                          "numeric and output values are string."));
 364               goto lossage;
 365             }
 366
 367           if ((rcd->flags & RCD_SRC_MASK) != RCD_SRC_NUMERIC
 368               && (rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 369             {
 370               msg (SE, _("INTO must be used when the input values are "
 371                          "string and output values are numeric."));
 372               goto lossage;
 373             }
 374         }
 375
 376       if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
 377         {
 378           struct coding *cp;
 379
 380           for (cp = rcd->map; cp->type != RCD_END; cp++)
 381             if (cp->t.c)
 382               {
 383                 if (strlen (cp->t.c) < max_dst_width)
 384                   {
 385                     /* The NULL is only really necessary for the
 386                        debugging code. */
 387                     char *repl = xmalloc (max_dst_width + 1);
 388                     st_pad_copy (repl, cp->t.c, max_dst_width + 1);
 389                     free (cp->t.c);
 390                     cp->t.c = repl;
 391                   }
 392                 else
 393                   /* The strings are guaranteed to be in order of
 394                      nondecreasing length. */
 395                   break;
 396               }
 397
 398         }
 399
 400       if (!lex_match ('/'))
 401         break;
 402       while (rcd->next)
 403         rcd = rcd->next;
 404       rcd = rcd->next = xmalloc (sizeof *rcd);
 405
 406       free (v);
 407     }
 408
 409   if (token != '.')
 410     {
 411       lex_error (_("expecting end of command"));
 412       goto lossage;
 413     }
 414
 415   for (rcd = head; rcd; rcd = rcd->next)
 416     if (rcd->dest_name[0])
 417       {
 418         rcd->dest = create_variable (&default_dict, rcd->dest_name,
 419                                      NUMERIC, 0);
 420         if (!rcd->dest)
 421           {
 422             /* This can occur if a destname is duplicated.  We could
 423                give an error at parse time but I don't care enough. */
 424             rcd->dest = find_variable (rcd->dest_name);
 425             assert (rcd->dest != NULL);
 426           }
 427         else
 428           envector (rcd->dest);
 429       }
 430
 431   trns = xmalloc (sizeof *trns);
 432   trns->h.proc = recode_trns_proc;
 433   trns->h.free = recode_trns_free;
 434   trns->codings = head;
 435   add_transformation ((struct trns_header *) trns);
 436
 437 #if DEBUGGING
 438   debug_print (head);
 439 #endif
 440
 441   return CMD_SUCCESS;
 442
 443  lossage:
 444   {
 445     struct recode_trns t;
 446
 447     t.codings = head;
 448     recode_trns_free ((struct trns_header *) &t);
 449     return CMD_FAILURE;
 450   }
 451 }
 452
 453 static int
 454 parse_dest_spec (struct rcd_var * rcd, union value * v, size_t *max_dst_width)
 455 {
 456   int flags;
 457
 458   v->c = NULL;
 459
 460   if (token == T_NUM)
 461     {
 462       v->f = tokval;
 463       lex_get ();
 464       flags = RCD_DEST_NUMERIC;
 465     }
 466   else if (lex_match_id ("SYSMIS"))
 467     {
 468       v->f = SYSMIS;
 469       flags = RCD_DEST_NUMERIC;
 470     }
 471   else if (token == T_STRING)
 472     {
 473       size_t max = *max_dst_width;
 474       size_t toklen = ds_length (&tokstr);
 475       if (toklen > max)
 476         max = toklen;
 477       v->c = xmalloc (max + 1);
 478       st_pad_copy (v->c, ds_value (&tokstr), max + 1);
 479       flags = RCD_DEST_STRING;
 480       *max_dst_width = max;
 481       lex_get ();
 482     }
 483   else if (lex_match_id ("COPY"))
 484     {
 485       if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
 486         {
 487           flags = RCD_DEST_NUMERIC;
 488           v->f = -SYSMIS;
 489         }
 490       else
 491         {
 492           flags = RCD_DEST_STRING;
 493           v->c = NULL;
 494         }
 495     }
 496
 497   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
 498     rcd->flags |= flags;
 499 #if 0
 500   else if (((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC
 501             && flags != RCD_DEST_NUMERIC)
 502            || ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING
 503                && flags != RCD_DEST_STRING))
 504 #endif
 505     else if ((rcd->flags & RCD_DEST_MASK) ^ flags)
 506       {
 507         msg (SE, _("Inconsistent output types.  The output values "
 508                    "must be all numeric or all string."));
 509         return 0;
 510       }
 511
 512   return 1;
 513 }
 514
 515 /* Reads a set of source specifications and returns one of the
 516    following values: 0 on failure; 1 for normal success; 2 for success
 517    but with CONVERT as the keyword; 3 for success but with ELSE as the
 518    keyword. */
 519 static int
 520 parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width)
 521 {
 522   struct coding *c;
 523
 524   for (;;)
 525     {
 526       if (rcd->nmap >= rcd->mmap - 1)
 527         {
 528           rcd->mmap += 16;
 529           rcd->map = xrealloc (rcd->map, rcd->mmap * sizeof *rcd->map);
 530         }
 531
 532       c = &rcd->map[rcd->nmap];
 533       c->f1.c = c->f2.c = NULL;
 534       if (lex_match_id ("ELSE"))
 535         {
 536           c->type = RCD_ELSE;
 537           rcd->nmap++;
 538           return 3;
 539         }
 540       else if (type == NUMERIC)
 541         {
 542           if (token == T_ID)
 543             {
 544               if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
 545                 {
 546                   if (!lex_force_match_id ("THRU"))
 547                     return 0;
 548                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
 549                     c->type = RCD_ELSE;
 550                   else if (token == T_NUM)
 551                     {
 552                       c->type = RCD_LOW;
 553                       c->f1.f = tokval;
 554                       lex_get ();
 555                     }
 556                   else
 557                     {
 558                       lex_error (_("following LO THRU"));
 559                       return 0;
 560                     }
 561                 }
 562               else if (lex_match_id ("MISSING"))
 563                 {
 564                   c->type = RCD_USER;
 565                   rcd->flags |= RCD_MISC_MISSING;
 566                 }
 567               else if (lex_match_id ("SYSMIS"))
 568                 {
 569                   c->type = RCD_END;
 570                   rcd->flags |= RCD_MISC_MISSING;
 571                 }
 572               else
 573                 {
 574                   lex_error (_("in source value"));
 575                   return 0;
 576                 }
 577             }
 578           else if (token == T_NUM)
 579             {
 580               c->f1.f = tokval;
 581               lex_get ();
 582               if (lex_match_id ("THRU"))
 583                 {
 584                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
 585                     c->type = RCD_HIGH;
 586                   else if (token == T_NUM)
 587                     {
 588                       c->type = RCD_RANGE;
 589                       c->f2.f = tokval;
 590                       lex_get ();
 591                     }
 592                   else
 593                     {
 594                       lex_error (NULL);
 595                       return 0;
 596                     }
 597                 }
 598               else
 599                 c->type = RCD_SINGLE;
 600             }
 601           else
 602             {
 603               lex_error (_("in source value"));
 604               return 0;
 605             }
 606         }
 607       else
 608         {
 609           assert (type == ALPHA);
 610           if (lex_match_id ("CONVERT"))
 611             {
 612               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
 613                 rcd->flags |= RCD_DEST_NUMERIC;
 614               else if ((rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
 615                 {
 616                   msg (SE, _("Keyword CONVERT may only be used with "
 617                              "string input values and numeric output "
 618                              "values."));
 619                   return 0;
 620                 }
 621
 622               c->type = RCD_CONVERT;
 623               rcd->nmap++;
 624               return 2;
 625             }
 626           else
 627             {
 628               /* Only the debugging code needs the NULLs at the ends
 629                  of the strings.  However, changing code behavior more
 630                  than necessary based on the DEBUGGING `#define' is just
 631                  *inviting* bugs. */
 632               c->type = RCD_SINGLE;
 633               if (!lex_force_string ())
 634                 return 0;
 635               c->f1.c = xmalloc (max_src_width + 1);
 636               st_pad_copy (c->f1.c, ds_value (&tokstr), max_src_width + 1);
 637               lex_get ();
 638             }
 639         }
 640
 641       if (c->type != RCD_END)
 642         rcd->nmap++;
 643
 644       lex_match (',');
 645       if (token == '=')
 646         break;
 647     }
 648   return 1;
 649 }
 650 \f
 651 /* Data transformation. */
 652
 653 static void
 654 recode_trns_free (struct trns_header * t)
 655 {
 656   int i;
 657   struct rcd_var *head, *next;
 658
 659   head = ((struct recode_trns *) t)->codings;
 660   while (head)
 661     {
 662       if (head->map && !(head->flags & RCD_MISC_DUPLICATE))
 663         {
 664           if (head->flags & RCD_SRC_STRING)
 665             for (i = 0; i < head->nmap; i++)
 666               switch (head->map[i].type)
 667                 {
 668                 case RCD_RANGE:
 669                   free (head->map[i].f2.c);
 670                   /* fall through */
 671                 case RCD_USER:
 672                 case RCD_SINGLE:
 673                 case RCD_HIGH:
 674                 case RCD_LOW:
 675                   free (head->map[i].f1.c);
 676                   break;
 677                 case RCD_END:
 678                 case RCD_ELSE:
 679                 case RCD_CONVERT:
 680                   break;
 681                 default:
 682                   assert (0);
 683                 }
 684           if (head->flags & RCD_DEST_STRING)
 685             for (i = 0; i < head->nmap; i++)
 686               if (head->map[i].type != RCD_CONVERT && head->map[i].type != RCD_END)
 687                 free (head->map[i].t.c);
 688           free (head->map);
 689         }
 690       next = head->next;
 691       free (head);
 692       head = next;
 693     }
 694 }
 695
 696 static inline struct coding *
 697 find_src_numeric (struct rcd_var * v, struct ccase * c)
 698 {
 699   double cmp = c->data[v->src->fv].f;
 700   struct coding *cp;
 701
 702   if (cmp == SYSMIS)
 703     {
 704       if (v->sysmis.f != -SYSMIS)
 705         {
 706           if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 707             c->data[v->dest->fv].f = v->sysmis.f;
 708           else
 709             memcpy (c->data[v->dest->fv].s, v->sysmis.c,
 710                     v->dest->width);
 711         }
 712       return NULL;
 713     }
 714
 715   for (cp = v->map;; cp++)
 716     switch (cp->type)
 717       {
 718       case RCD_END:
 719         return NULL;
 720       case RCD_USER:
 721         if (is_num_user_missing (cmp, v->src))
 722           return cp;
 723         break;
 724       case RCD_SINGLE:
 725         if (approx_eq (cmp, cp->f1.f))
 726           return cp;
 727         break;
 728       case RCD_HIGH:
 729         if (approx_ge (cmp, cp->f1.f))
 730           return cp;
 731         break;
 732       case RCD_LOW:
 733         if (approx_le (cmp, cp->f1.f))
 734           return cp;
 735         break;
 736       case RCD_RANGE:
 737         if (approx_in_range (cmp, cp->f1.f, cp->f2.f))
 738           return cp;
 739         break;
 740       case RCD_ELSE:
 741         return cp;
 742       default:
 743         assert (0);
 744       }
 745 }
 746
 747 static inline struct coding *
 748 find_src_string (struct rcd_var * v, struct ccase * c)
 749 {
 750   char *cmp = c->data[v->src->fv].s;
 751   int w = v->src->width;
 752   struct coding *cp;
 753
 754   for (cp = v->map;; cp++)
 755     switch (cp->type)
 756       {
 757       case RCD_END:
 758         return NULL;
 759       case RCD_SINGLE:
 760         if (!memcmp (cp->f1.c, cmp, w))
 761           return cp;
 762         break;
 763       case RCD_ELSE:
 764         return cp;
 765       case RCD_CONVERT:
 766         {
 767           double f = convert_to_double (cmp, w);
 768           if (f != -SYSMIS)
 769             {
 770               c->data[v->dest->fv].f = f;
 771               return NULL;
 772             }
 773           break;
 774         }
 775       default:
 776         assert (0);
 777       }
 778 }
 779
 780 static int
 781 recode_trns_proc (struct trns_header * t, struct ccase * c)
 782 {
 783   struct rcd_var *v;
 784   struct coding *cp;
 785
 786   for (v = ((struct recode_trns *) t)->codings; v; v = v->next)
 787     {
 788       switch (v->flags & RCD_SRC_MASK)
 789         {
 790         case RCD_SRC_NUMERIC:
 791           cp = find_src_numeric (v, c);
 792           break;
 793         case RCD_SRC_STRING:
 794           cp = find_src_string (v, c);
 795           break;
 796         }
 797       if (!cp)
 798         continue;
 799
 800       /* A matching input value was found. */
 801       if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 802         {
 803           double val = cp->t.f;
 804           if (val == -SYSMIS)
 805             c->data[v->dest->fv].f = c->data[v->src->fv].f;
 806           else
 807             c->data[v->dest->fv].f = val;
 808         }
 809       else
 810         {
 811           char *val = cp->t.c;
 812           if (val == NULL)
 813             st_bare_pad_len_copy (c->data[v->dest->fv].s,
 814                                   c->data[v->src->fv].c,
 815                                   v->dest->width, v->src->width);
 816           else
 817             memcpy (c->data[v->dest->fv].s, cp->t.c, v->dest->width);
 818         }
 819     }
 820
 821   return -1;
 822 }
 823 \f
 824 /* Debug output. */
 825
 826 #if DEBUGGING
 827 static void
 828 dump_dest (struct rcd_var * v, union value * c)
 829 {
 830   if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 831     if (c->f == SYSMIS)
 832       printf ("=SYSMIS");
 833     else if (c->f == -SYSMIS)
 834       printf ("=COPY");
 835     else
 836       printf ("=%g", c->f);
 837   else if (c->c)
 838     printf ("=\"%s\"", c->c);
 839   else
 840     printf ("=COPY");
 841 }
 842
 843 static void
 844 debug_print (struct rcd_var * head)
 845 {
 846   struct rcd_var *iter, *start;
 847   struct coding *c;
 848
 849   printf ("RECODE\n");
 850   for (iter = head; iter; iter = iter->next)
 851     {
 852       start = iter;
 853       printf ("  %s%s", iter == head ? "" : "/", iter->src->name);
 854       while (iter->next && (iter->next->flags & RCD_MISC_DUPLICATE))
 855         {
 856           iter = iter->next;
 857           printf (" %s", iter->src->name);
 858         }
 859       if (iter->has_sysmis)
 860         {
 861           printf ("(SYSMIS");
 862           dump_dest (iter, &iter->sysmis);
 863           printf (")");
 864         }
 865       for (c = iter->map; c->type != RCD_END; c++)
 866         {
 867           printf ("(");
 868           if ((iter->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
 869             switch (c->type)
 870               {
 871               case RCD_END:
 872                 printf (_("!!END!!"));
 873                 break;
 874               case RCD_USER:
 875                 printf ("MISSING");
 876                 break;
 877               case RCD_SINGLE:
 878                 printf ("%g", c->f1.f);
 879                 break;
 880               case RCD_HIGH:
 881                 printf ("%g THRU HIGH", c->f1.f);
 882                 break;
 883               case RCD_LOW:
 884                 printf ("LOW THRU %g", c->f1.f);
 885                 break;
 886               case RCD_RANGE:
 887                 printf ("%g THRU %g", c->f1.f, c->f2.f);
 888                 break;
 889               case RCD_ELSE:
 890                 printf ("ELSE");
 891                 break;
 892               default:
 893                 printf (_("!!ERROR!!"));
 894                 break;
 895               }
 896           else
 897             switch (c->type)
 898               {
 899               case RCD_SINGLE:
 900                 printf ("\"%s\"", c->f1.c);
 901                 break;
 902               case RCD_ELSE:
 903                 printf ("ELSE");
 904                 break;
 905               case RCD_CONVERT:
 906                 printf ("CONVERT");
 907                 break;
 908               default:
 909                 printf (_("!!ERROR!!"));
 910                 break;
 911               }
 912           if (c->type != RCD_CONVERT)
 913             dump_dest (iter, &c->t);
 914           printf (")");
 915         }
 916       printf ("\n    INTO");
 917       for (;;)
 918         {
 919           printf (" %s",
 920                 start->dest_name[0] ? start->dest_name : start->dest->name);
 921           if (start == iter)
 922             break;
 923           start = start->next;
 924         }
 925       printf ("\n");
 926     }
 927 }
 928 #endif
 929
 930 /* Convert NPTR to a `long int' in base 10.  Returns the long int on
 931    success, NOT_LONG on failure.  On success stores a pointer to the
 932    first character after the number into *ENDPTR.  From the GNU C
 933    library. */
 934 long int
 935 string_to_long (char *nptr, int width, char **endptr)
 936 {
 937   int negative;
 938   register unsigned long int cutoff;
 939   register unsigned int cutlim;
 940   register unsigned long int i;
 941   register char *s;
 942   register unsigned char c;
 943   const char *save;
 944
 945   s = nptr;
 946
 947   /* Check for a sign.  */
 948   if (*s == '-')
 949     {
 950       negative = 1;
 951       ++s;
 952     }
 953   else if (*s == '+')
 954     {
 955       negative = 0;
 956       ++s;
 957     }
 958   else
 959     negative = 0;
 960   if (s >= nptr + width)
 961     return NOT_LONG;
 962
 963   /* Save the pointer so we can check later if anything happened.  */
 964   save = s;
 965
 966   cutoff = ULONG_MAX / 10ul;
 967   cutlim = ULONG_MAX % 10ul;
 968
 969   i = 0;
 970   for (c = *s;;)
 971     {
 972       if (isdigit ((unsigned char) c))
 973         c -= '0';
 974       else
 975         break;
 976       /* Check for overflow.  */
 977       if (i > cutoff || (i == cutoff && c > cutlim))
 978         return NOT_LONG;
 979       else
 980         i = i * 10ul + c;
 981
 982       s++;
 983       if (s >= nptr + width)
 984         break;
 985       c = *s;
 986     }
 987
 988   /* Check if anything actually happened.  */
 989   if (s == save)
 990     return NOT_LONG;
 991
 992   /* Check for a value that is within the range of `unsigned long
 993      int', but outside the range of `long int'.  We limit LONG_MIN and
 994      LONG_MAX by one point because we know that NOT_LONG is out there
 995      somewhere. */
 996   if (i > (negative
 997            ? -((unsigned long int) LONG_MIN) - 1
 998            : ((unsigned long int) LONG_MAX) - 1))
 999     return NOT_LONG;
1000
1001   *endptr = s;
1002
1003   /* Return the result of the appropriate sign.  */
1004   return (negative ? -i : i);
1005 }
1006
1007 /* Converts S to a double according to format Fx.0.  Returns the value
1008    found, or -SYSMIS if there was no valid number in s.  WIDTH is the
1009    length of string S.  From the GNU C library. */
1010 static double
1011 convert_to_double (char *s, int width)
1012 {
1013   register const char *end = &s[width];
1014
1015   short int sign;
1016
1017   /* The number so far.  */
1018   double num;
1019
1020   int got_dot;                  /* Found a decimal point.  */
1021   int got_digit;                /* Count of digits.  */
1022
1023   /* The exponent of the number.  */
1024   long int exponent;
1025
1026   /* Eat whitespace.  */
1027   while (s < end && isspace ((unsigned char) *s))
1028     ++s;
1029   if (s >= end)
1030     return SYSMIS;
1031
1032   /* Get the sign.  */
1033   sign = *s == '-' ? -1 : 1;
1034   if (*s == '-' || *s == '+')
1035     {
1036       ++s;
1037       if (s >= end)
1038         return -SYSMIS;
1039     }
1040
1041   num = 0.0;
1042   got_dot = 0;
1043   got_digit = 0;
1044   exponent = 0;
1045   for (; s < end; ++s)
1046     {
1047       if (isdigit ((unsigned char) *s))
1048         {
1049           got_digit++;
1050
1051           /* Make sure that multiplication by 10 will not overflow.  */
1052           if (num > DBL_MAX * 0.1)
1053             /* The value of the digit doesn't matter, since we have already
1054                gotten as many digits as can be represented in a `double'.
1055                This doesn't necessarily mean the result will overflow.
1056                The exponent may reduce it to within range.
1057
1058                We just need to record that there was another
1059                digit so that we can multiply by 10 later.  */
1060             ++exponent;
1061           else
1062             num = (num * 10.0) + (*s - '0');
1063
1064           /* Keep track of the number of digits after the decimal point.
1065              If we just divided by 10 here, we would lose precision.  */
1066           if (got_dot)
1067             --exponent;
1068         }
1069       else if (!got_dot && *s == '.')
1070         /* Record that we have found the decimal point.  */
1071         got_dot = 1;
1072       else
1073         break;
1074     }
1075
1076   if (!got_digit)
1077     return -SYSMIS;
1078
1079   if (s < end && (tolower ((unsigned char) (*s)) == 'e'
1080                   || tolower ((unsigned char) (*s)) == 'd'))
1081     {
1082       /* Get the exponent specified after the `e' or `E'.  */
1083       long int exp;
1084
1085       s++;
1086       if (s >= end)
1087         return -SYSMIS;
1088
1089       exp = string_to_long (s, end - s, &s);
1090       if (exp == NOT_LONG || end == s)
1091         return -SYSMIS;
1092       exponent += exp;
1093     }
1094
1095   while (s < end && isspace ((unsigned char) *s))
1096     s++;
1097   if (s < end)
1098     return -SYSMIS;
1099
1100   if (num == 0.0)
1101     return 0.0;
1102
1103   /* Multiply NUM by 10 to the EXPONENT power,
1104      checking for overflow and underflow.  */
1105
1106   if (exponent < 0)
1107     {
1108       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
1109           || num < DBL_MIN * pow (10.0, (double) -exponent))
1110         return -SYSMIS;
1111       num *= pow (10.0, (double) exponent);
1112     }
1113   else if (exponent > 0)
1114     {
1115       if (num > DBL_MAX * pow (10.0, (double) -exponent))
1116         return -SYSMIS;
1117       num *= pow (10.0, (double) exponent);
1118     }
1119
1120   return sign > 0 ? num : -num;
1121 }