src/language/stats/rank.q

   1 /* PSPP - RANK. -*-c-*-
   2
   3 Copyright (C) 2005, 2006 Free Software Foundation, Inc.
   4 Author: John Darrington <john@darrington.wattle.id.au>,
   5         Ben Pfaff <blp@gnu.org>.
   6
   7 This program is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public License as
   9 published by the Free Software Foundation; either version 2 of the
  10 License, or (at your option) any later version.
  11
  12 This program is distributed in the hope that it will be useful, but
  13 WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program; if not, write to the Free Software
  19 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  20 02110-1301, USA. */
  21
  22 #include <config.h>
  23
  24 #include "sort-criteria.h"
  25
  26 #include <data/dictionary.h>
  27 #include <data/procedure.h>
  28 #include <data/variable.h>
  29 #include <data/case.h>
  30 #include <data/casefile.h>
  31 #include <data/fastfile.h>
  32 #include <data/storage-stream.h>
  33 #include <language/command.h>
  34 #include <language/stats/sort-criteria.h>
  35 #include <limits.h>
  36 #include <libpspp/compiler.h>
  37 #include <math/sort.h>
  38 #include <output/table.h>
  39 #include <output/manager.h>
  40
  41 #include <gsl/gsl_cdf.h>
  42 #include <math.h>
  43
  44 #include "gettext.h"
  45 #define _(msgid) gettext (msgid)
  46
  47 /* (headers) */
  48
  49 /* (specification)
  50    "RANK" (rank_):
  51    *^variables=custom;
  52    +rank=custom;
  53    +normal=custom;
  54    +percent=custom;
  55    +ntiles=custom;
  56    +rfraction=custom;
  57    +proportion=custom;
  58    +n=custom;
  59    +savage=custom;
  60    +print=print:!yes/no;
  61    +fraction=fraction:!blom/tukey/vw/rankit;
  62    +ties=ties:!mean/low/high/condense;
  63    missing=miss:!exclude/include.
  64 */
  65 /* (declarations) */
  66 /* (functions) */
  67
  68 typedef double (*rank_function_t) (double c, double cc, double cc_1,
  69                                  int i, double w);
  70
  71 static double rank_proportion (double c, double cc, double cc_1,
  72                                int i, double w);
  73
  74 static double rank_normal (double c, double cc, double cc_1,
  75                            int i, double w);
  76
  77 static double rank_percent (double c, double cc, double cc_1,
  78                             int i, double w);
  79
  80 static double rank_rfraction (double c, double cc, double cc_1,
  81                               int i, double w);
  82
  83 static double rank_rank (double c, double cc, double cc_1,
  84                          int i, double w);
  85
  86 static double rank_n (double c, double cc, double cc_1,
  87                       int i, double w);
  88
  89 static double rank_savage (double c, double cc, double cc_1,
  90                       int i, double w);
  91
  92 static double rank_ntiles (double c, double cc, double cc_1,
  93                       int i, double w);
  94
  95
  96 enum RANK_FUNC
  97   {
  98     RANK,
  99     NORMAL,
 100     PERCENT,
 101     RFRACTION,
 102     PROPORTION,
 103     N,
 104     NTILES,
 105     SAVAGE,
 106     n_RANK_FUNCS
 107   };
 108
 109 static const struct fmt_spec dest_format[n_RANK_FUNCS] = {
 110   {FMT_F, 9, 3}, /* rank */
 111   {FMT_F, 6, 4}, /* normal */
 112   {FMT_F, 6, 2}, /* percent */
 113   {FMT_F, 6, 4}, /* rfraction */
 114   {FMT_F, 6, 4}, /* proportion */
 115   {FMT_F, 6, 0}, /* n */
 116   {FMT_F, 3, 0}, /* ntiles */
 117   {FMT_F, 8, 4}  /* savage */
 118 };
 119
 120 static const char *function_name[n_RANK_FUNCS] = {
 121   "RANK",
 122   "NORMAL",
 123   "PERCENT",
 124   "RFRACTION",
 125   "PROPORTION",
 126   "N",
 127   "NTILES",
 128   "SAVAGE"
 129 };
 130
 131 static rank_function_t rank_func[n_RANK_FUNCS] = {
 132   rank_rank,
 133   rank_normal,
 134   rank_percent,
 135   rank_rfraction,
 136   rank_proportion,
 137   rank_n,
 138   rank_ntiles,
 139   rank_savage
 140   };
 141
 142
 143 struct rank_spec
 144 {
 145   enum RANK_FUNC rfunc;
 146   struct variable **destvars;
 147 };
 148
 149
 150 /* Function to use for testing for missing values */
 151 static is_missing_func *value_is_missing;
 152
 153 static struct rank_spec *rank_specs;
 154 static size_t n_rank_specs;
 155
 156 static struct sort_criteria *sc;
 157
 158 static struct variable **group_vars;
 159 static size_t n_group_vars;
 160
 161 static struct variable **src_vars;
 162 static size_t n_src_vars;
 163
 164
 165 static int k_ntiles;
 166
 167 static struct cmd_rank cmd;
 168
 169 static struct casefile *rank_sorted_casefile (struct casefile *cf,
 170                                               const struct sort_criteria *,
 171                                               const struct rank_spec *rs,
 172                                               int n_rank_specs,
 173                                               int idx,
 174                                               const struct missing_values *miss
 175                                               );
 176 static const char *
 177 fraction_name(void)
 178 {
 179   static char name[10];
 180   switch ( cmd.fraction )
 181     {
 182     case RANK_BLOM:
 183       strcpy (name, "BLOM");
 184       break;
 185     case RANK_RANKIT:
 186       strcpy (name, "RANKIT");
 187       break;
 188     case RANK_TUKEY:
 189       strcpy (name, "TUKEY");
 190       break;
 191     case RANK_VW:
 192       strcpy (name, "VW");
 193       break;
 194     default:
 195       NOT_REACHED ();
 196     }
 197   return name;
 198 }
 199
 200 /* Create a label on DEST_VAR, describing its derivation from SRC_VAR and F */
 201 static void
 202 create_var_label (struct variable *dest_var,
 203                   const struct variable *src_var, enum RANK_FUNC f)
 204 {
 205   struct string label;
 206   ds_init_empty (&label);
 207
 208   if ( n_group_vars > 0 )
 209     {
 210       struct string group_var_str;
 211       int g;
 212
 213       ds_init_empty (&group_var_str);
 214
 215       for (g = 0 ; g < n_group_vars ; ++g )
 216         {
 217           if ( g > 0 ) ds_put_cstr (&group_var_str, " ");
 218           ds_put_cstr (&group_var_str, group_vars[g]->name);
 219         }
 220
 221       ds_put_format (&label, _("%s of %s by %s"), function_name[f],
 222                      src_var->name, ds_cstr (&group_var_str));
 223       ds_destroy (&group_var_str);
 224     }
 225   else
 226     ds_put_format (&label,_("%s of %s"), function_name[f], src_var->name);
 227
 228   dest_var->label = strdup (ds_cstr (&label) );
 229
 230   ds_destroy (&label);
 231 }
 232
 233
 234 static bool
 235 rank_cmd (const struct sort_criteria *sc,
 236       const struct rank_spec *rank_specs, int n_rank_specs)
 237 {
 238   struct sort_criteria criteria;
 239   bool result = true;
 240   int i;
 241   const int n_splits = dict_get_split_cnt (default_dict);
 242
 243   criteria.crit_cnt = n_splits + n_group_vars + 1;
 244   criteria.crits = xnmalloc (criteria.crit_cnt, sizeof *criteria.crits);
 245   for (i = 0; i < n_splits ; i++)
 246     {
 247       struct variable *v = dict_get_split_vars (default_dict)[i];
 248       criteria.crits[i].fv = v->fv;
 249       criteria.crits[i].width = v->width;
 250       criteria.crits[i].dir = SRT_ASCEND;
 251     }
 252   for (i = 0; i < n_group_vars; i++)
 253     {
 254       criteria.crits[i + n_splits].fv = group_vars[i]->fv;
 255       criteria.crits[i + n_splits].width = group_vars[i]->width;
 256       criteria.crits[i + n_splits].dir = SRT_ASCEND;
 257     }
 258   for (i = 0 ; i < sc->crit_cnt ; ++i )
 259     {
 260       struct casefile *out ;
 261       struct casefile *cf ;
 262       struct casereader *reader ;
 263       struct casefile *sorted_cf ;
 264
 265       /* Obtain active file in CF. */
 266       if (!procedure (NULL, NULL))
 267         return false;
 268       cf = proc_capture_output ();
 269
 270       /* Sort CF into SORTED_CF. */
 271       reader = casefile_get_destructive_reader (cf) ;
 272       criteria.crits[criteria.crit_cnt - 1] = sc->crits[i];
 273       assert ( sc->crits[i].fv == src_vars[i]->fv );
 274       sorted_cf = sort_execute (reader, &criteria);
 275       casefile_destroy (cf);
 276
 277       out = rank_sorted_casefile (sorted_cf, &criteria,
 278                                   rank_specs, n_rank_specs,
 279                                   i, &src_vars[i]->miss)  ;
 280       if ( NULL == out )
 281         {
 282           result = false ;
 283           continue ;
 284         }
 285
 286       proc_set_source (storage_source_create (out));
 287     }
 288   free (criteria.crits);
 289
 290   return result ;
 291 }
 292
 293 /* Hardly a rank function !! */
 294 static double
 295 rank_n (double c UNUSED, double cc UNUSED, double cc_1 UNUSED,
 296           int i UNUSED, double w)
 297 {
 298   return w;
 299 }
 300
 301
 302 static double
 303 rank_rank (double c, double cc, double cc_1,
 304           int i, double w UNUSED)
 305 {
 306   double rank;
 307   if ( c >= 1.0 )
 308     {
 309       switch (cmd.ties)
 310         {
 311         case RANK_LOW:
 312           rank = cc_1 + 1;
 313           break;
 314         case RANK_HIGH:
 315           rank = cc;
 316           break;
 317         case RANK_MEAN:
 318           rank = cc_1 + (c + 1.0)/ 2.0;
 319           break;
 320         case RANK_CONDENSE:
 321           rank = i;
 322           break;
 323         default:
 324           NOT_REACHED ();
 325         }
 326     }
 327   else
 328     {
 329       switch (cmd.ties)
 330         {
 331         case RANK_LOW:
 332           rank = cc_1;
 333           break;
 334         case RANK_HIGH:
 335           rank = cc;
 336           break;
 337         case RANK_MEAN:
 338           rank = cc_1 + c / 2.0 ;
 339           break;
 340         case RANK_CONDENSE:
 341           rank = i;
 342           break;
 343         default:
 344           NOT_REACHED ();
 345         }
 346     }
 347
 348   return rank;
 349 }
 350
 351
 352 static double
 353 rank_rfraction (double c, double cc, double cc_1,
 354                 int i, double w)
 355 {
 356   return rank_rank (c, cc, cc_1, i, w) / w ;
 357 }
 358
 359
 360 static double
 361 rank_percent (double c, double cc, double cc_1,
 362                 int i, double w)
 363 {
 364   return rank_rank (c, cc, cc_1, i, w) * 100.0 / w ;
 365 }
 366
 367
 368 static double
 369 rank_proportion (double c, double cc, double cc_1,
 370                  int i, double w)
 371 {
 372   const double r =  rank_rank (c, cc, cc_1, i, w) ;
 373
 374   double f;
 375
 376   switch ( cmd.fraction )
 377     {
 378     case RANK_BLOM:
 379       f =  (r - 3.0/8.0) / (w + 0.25);
 380       break;
 381     case RANK_RANKIT:
 382       f = (r - 0.5) / w ;
 383       break;
 384     case RANK_TUKEY:
 385       f = (r - 1.0/3.0) / (w + 1.0/3.0);
 386       break;
 387     case RANK_VW:
 388       f = r / ( w + 1.0);
 389       break;
 390     default:
 391       NOT_REACHED ();
 392     }
 393
 394
 395   return (f > 0) ? f : SYSMIS;
 396 }
 397
 398 static double
 399 rank_normal (double c, double cc, double cc_1,
 400              int i, double w)
 401 {
 402   double f = rank_proportion (c, cc, cc_1, i, w);
 403
 404   return gsl_cdf_ugaussian_Pinv (f);
 405 }
 406
 407 static double
 408 rank_ntiles (double c, double cc, double cc_1,
 409                 int i, double w)
 410 {
 411   double r = rank_rank (c, cc, cc_1, i, w);
 412
 413
 414   return ( floor (( r * k_ntiles) / ( w + 1) ) + 1);
 415 }
 416
 417 /* Expected value of the order statistics from an exponential distribution */
 418 static double
 419 ee (int j, double w_star)
 420 {
 421   int k;
 422   double sum = 0.0;
 423
 424   for (k = 1 ; k <= j; k++)
 425     sum += 1.0 / ( w_star + 1 - k );
 426
 427   return sum;
 428 }
 429
 430
 431 static double
 432 rank_savage (double c, double cc, double cc_1,
 433                 int i UNUSED, double w)
 434 {
 435   double int_part;
 436   const int i_1 = floor (cc_1);
 437   const int i_2 = floor (cc);
 438
 439   const double w_star = (modf (w, &int_part) == 0 ) ? w : floor (w) + 1;
 440
 441   const double g_1 = cc_1 - i_1;
 442   const double g_2 = cc - i_2;
 443
 444   /* The second factor is infinite, when the first is zero.
 445      Therefore, evaluate the second, only when the first is non-zero */
 446   const double expr1 =  (1 - g_1) ? (1 - g_1) * ee(i_1+1, w_star) : ( 1 - g_1);
 447   const double expr2 =  g_2 ? g_2 * ee (i_2+1, w_star) : g_2 ;
 448
 449   if ( i_1 == i_2 )
 450     return ee (i_1 + 1, w_star) - 1;
 451
 452   if ( i_1 + 1 == i_2 )
 453     return ( ( expr1 + expr2 )/c ) - 1;
 454
 455   if ( i_1 + 2 <= i_2 )
 456     {
 457       int j;
 458       double sigma = 0.0;
 459       for (j = i_1 + 2 ; j <= i_2; ++j )
 460         sigma += ee (j, w_star);
 461       return ( (expr1 + expr2 + sigma) / c) -1;
 462     }
 463
 464   NOT_REACHED();
 465 }
 466
 467
 468 /* Rank the casefile belonging to CR, starting from the current
 469    postition of CR continuing up to and including the ENDth case.
 470
 471    RS points to an array containing  the rank specifications to
 472    use. N_RANK_SPECS is the number of elements of RS.
 473
 474
 475    DEST_VAR_INDEX is the index into the rank_spec destvar element
 476    to be used for this ranking.
 477
 478    Prerequisites: 1. The casefile must be sorted according to CRITERION.
 479                   2. W is the sum of the non-missing caseweights for this
 480                   range of the casefile.
 481 */
 482 static void
 483 rank_cases (struct casereader *cr,
 484             unsigned long end,
 485             const struct sort_criterion *criterion,
 486             const struct missing_values *mv,
 487             double w,
 488             const struct rank_spec *rs,
 489             int n_rank_specs,
 490             int dest_var_index,
 491             struct casefile *dest)
 492 {
 493   bool warn = true;
 494   double cc = 0.0;
 495   double cc_1;
 496   int iter = 1;
 497
 498   const int fv = criterion->fv;
 499   const int width = criterion->width;
 500
 501   while (casereader_cnum (cr) < end)
 502     {
 503       struct casereader *lookahead;
 504       const union value *this_value;
 505       struct ccase this_case, lookahead_case;
 506       double c;
 507       int i;
 508       size_t n = 0;
 509
 510       if (!casereader_read_xfer (cr, &this_case))
 511         break;
 512
 513       this_value = case_data (&this_case, fv);
 514       c = dict_get_case_weight (default_dict, &this_case, &warn);
 515
 516       lookahead = casereader_clone (cr);
 517       n = 0;
 518       while (casereader_cnum (lookahead) < end
 519              && casereader_read_xfer (lookahead, &lookahead_case))
 520         {
 521           const union value *lookahead_value = case_data (&lookahead_case, fv);
 522           int diff = compare_values (this_value, lookahead_value, width);
 523
 524           if (diff != 0)
 525             {
 526               /* Make sure the casefile was sorted */
 527               assert ( diff == ((criterion->dir == SRT_ASCEND) ? -1 :1));
 528
 529               case_destroy (&lookahead_case);
 530               break;
 531             }
 532
 533           c += dict_get_case_weight (default_dict, &lookahead_case, &warn);
 534           case_destroy (&lookahead_case);
 535           n++;
 536         }
 537       casereader_destroy (lookahead);
 538
 539       cc_1 = cc;
 540       if ( !value_is_missing (mv, this_value) )
 541         cc += c;
 542
 543       do
 544         {
 545           for (i = 0; i < n_rank_specs; ++i)
 546             {
 547               const int dest_idx = rs[i].destvars[dest_var_index]->fv;
 548
 549               if  ( value_is_missing (mv, this_value) )
 550                 case_data_rw (&this_case, dest_idx)->f = SYSMIS;
 551               else
 552                 case_data_rw (&this_case, dest_idx)->f =
 553                   rank_func[rs[i].rfunc](c, cc, cc_1, iter, w);
 554             }
 555           casefile_append_xfer (dest, &this_case);
 556         }
 557       while (n-- > 0 && casereader_read_xfer (cr, &this_case));
 558
 559       if ( !value_is_missing (mv, this_value) )
 560         iter++;
 561     }
 562
 563   /* If this isn't true, then all the results will be wrong */
 564   assert ( w == cc );
 565 }
 566
 567 static bool
 568 same_group (const struct ccase *a, const struct ccase *b,
 569             const struct sort_criteria *crit)
 570 {
 571   size_t i;
 572
 573   for (i = 0; i < crit->crit_cnt - 1; i++)
 574     {
 575       struct sort_criterion *c = &crit->crits[i];
 576       if (compare_values (case_data (a, c->fv), case_data (b, c->fv),
 577                           c->width) != 0)
 578         return false;
 579     }
 580
 581   return true;
 582 }
 583
 584 static struct casefile *
 585 rank_sorted_casefile (struct casefile *cf,
 586                       const struct sort_criteria *crit,
 587                       const struct rank_spec *rs,
 588                       int n_rank_specs,
 589                       int dest_idx,
 590                       const struct missing_values *mv)
 591 {
 592   struct casefile *dest = fastfile_create (casefile_get_value_cnt (cf));
 593   struct casereader *lookahead = casefile_get_reader (cf);
 594   struct casereader *pos = casereader_clone (lookahead);
 595   struct ccase group_case;
 596   bool warn = true;
 597
 598   struct sort_criterion *ultimate_crit = &crit->crits[crit->crit_cnt - 1];
 599
 600   if (casereader_read (lookahead, &group_case))
 601     {
 602       struct ccase this_case;
 603       const union value *this_value ;
 604       double w = 0.0;
 605       this_value = case_data( &group_case, ultimate_crit->fv);
 606
 607       if ( !value_is_missing(mv, this_value) )
 608         w = dict_get_case_weight (default_dict, &group_case, &warn);
 609
 610       while (casereader_read (lookahead, &this_case))
 611         {
 612           const union value *this_value =
 613             case_data(&this_case, ultimate_crit->fv);
 614           double c = dict_get_case_weight (default_dict, &this_case, &warn);
 615           if (!same_group (&group_case, &this_case, crit))
 616             {
 617               rank_cases (pos, casereader_cnum (lookahead) - 1,
 618                           ultimate_crit,
 619                           mv, w,
 620                           rs, n_rank_specs,
 621                           dest_idx, dest);
 622
 623               w = 0.0;
 624               case_move (&group_case, &this_case);
 625             }
 626           if ( !value_is_missing (mv, this_value) )
 627             w += c;
 628         }
 629       rank_cases (pos, ULONG_MAX, ultimate_crit, mv, w,
 630                   rs, n_rank_specs, dest_idx, dest);
 631     }
 632
 633   if (casefile_error (dest))
 634     {
 635       casefile_destroy (dest);
 636       dest = NULL;
 637     }
 638
 639   casefile_destroy (cf);
 640   return dest;
 641 }
 642
 643
 644 /* Transformation function to enumerate all the cases */
 645 static int
 646 create_resort_key (void *key_var_, struct ccase *cc, casenum_t case_num)
 647 {
 648   struct variable *key_var = key_var_;
 649
 650   case_data_rw(cc, key_var->fv)->f = case_num;
 651
 652   return TRNS_CONTINUE;
 653 }
 654
 655
 656 /* Create and return a new variable in which to store the ranks of SRC_VAR
 657    accoring to the rank function F.
 658    VNAME is the name of the variable to be created.
 659    If VNAME is NULL, then a name will be automatically chosen.
 660  */
 661 static struct variable *
 662 create_rank_variable (enum RANK_FUNC f,
 663                       const struct variable *src_var,
 664                       const char *vname)
 665 {
 666   int i;
 667   struct variable *var = NULL;
 668   char name[SHORT_NAME_LEN + 1];
 669
 670   if ( vname )
 671     var = dict_create_var(default_dict, vname, 0);
 672
 673   if ( NULL == var )
 674     {
 675       snprintf(name, SHORT_NAME_LEN + 1, "%c%s",
 676                function_name[f][0], src_var->name);
 677
 678       var = dict_create_var(default_dict, name, 0);
 679     }
 680
 681   i = 1;
 682   while( NULL == var )
 683     {
 684       char func_abb[4];
 685       snprintf(func_abb, 4, "%s", function_name[f]);
 686       snprintf(name, SHORT_NAME_LEN + 1, "%s%03d", func_abb,
 687                i);
 688
 689       var = dict_create_var(default_dict, name, 0);
 690       if (i++ >= 999)
 691         break;
 692     }
 693
 694   i = 1;
 695   while ( NULL == var )
 696     {
 697       char func_abb[3];
 698       snprintf(func_abb, 3, "%s", function_name[f]);
 699
 700       snprintf(name, SHORT_NAME_LEN + 1,
 701                "RNK%s%02d", func_abb, i);
 702
 703       var = dict_create_var(default_dict, name, 0);
 704       if ( i++ >= 99 )
 705         break;
 706     }
 707
 708   if ( NULL == var )
 709     {
 710       msg(ME, _("Cannot create new rank variable.  All candidates in use."));
 711       return NULL;
 712     }
 713
 714   var->write = var->print = dest_format[f];
 715
 716   return var;
 717 }
 718
 719 int cmd_rank(void);
 720
 721 static void
 722 rank_cleanup(void)
 723 {
 724   int i;
 725
 726   free (group_vars);
 727   group_vars = NULL;
 728   n_group_vars = 0;
 729
 730   for (i = 0 ; i <  n_rank_specs ; ++i )
 731     {
 732       free (rank_specs[i].destvars);
 733     }
 734
 735   free (rank_specs);
 736   rank_specs = NULL;
 737   n_rank_specs = 0;
 738
 739   sort_destroy_criteria (sc);
 740   sc = NULL;
 741
 742   free (src_vars);
 743   src_vars = NULL;
 744   n_src_vars = 0;
 745 }
 746
 747 int
 748 cmd_rank(void)
 749 {
 750   bool result;
 751   struct variable *order;
 752   size_t i;
 753   n_rank_specs = 0;
 754
 755   if ( !parse_rank(&cmd, NULL) )
 756     {
 757       rank_cleanup ();
 758     return CMD_FAILURE;
 759     }
 760
 761   /* If /MISSING=INCLUDE is set, then user missing values are ignored */
 762   if (cmd.miss == RANK_INCLUDE )
 763     value_is_missing = mv_is_value_system_missing;
 764   else
 765     value_is_missing = mv_is_value_missing;
 766
 767
 768   /* Default to /RANK if no function subcommands are given */
 769   if ( !( cmd.sbc_normal  || cmd.sbc_ntiles || cmd.sbc_proportion ||
 770           cmd.sbc_rfraction || cmd.sbc_savage || cmd.sbc_n ||
 771           cmd.sbc_percent || cmd.sbc_rank ) )
 772     {
 773       assert ( n_rank_specs == 0 );
 774
 775       rank_specs = xmalloc (sizeof (*rank_specs));
 776       rank_specs[0].rfunc = RANK;
 777       rank_specs[0].destvars =
 778         xcalloc (sc->crit_cnt, sizeof (struct variable *));
 779
 780       n_rank_specs = 1;
 781     }
 782
 783   assert ( sc->crit_cnt == n_src_vars);
 784
 785   /* Create variables for all rank destinations which haven't
 786      already been created with INTO.
 787      Add labels to all the destination variables.
 788   */
 789   for (i = 0 ; i <  n_rank_specs ; ++i )
 790     {
 791       int v;
 792       for ( v = 0 ; v < n_src_vars ;  v ++ )
 793         {
 794           if ( rank_specs[i].destvars[v] == NULL )
 795             {
 796               rank_specs[i].destvars[v] =
 797                 create_rank_variable (rank_specs[i].rfunc, src_vars[v], NULL);
 798             }
 799
 800           create_var_label ( rank_specs[i].destvars[v],
 801                              src_vars[v],
 802                              rank_specs[i].rfunc);
 803         }
 804     }
 805
 806   if ( cmd.print == RANK_YES )
 807     {
 808       int v;
 809
 810       tab_output_text (0, _("Variables Created By RANK"));
 811       tab_output_text (0, "\n");
 812
 813       for (i = 0 ; i <  n_rank_specs ; ++i )
 814         {
 815           for ( v = 0 ; v < n_src_vars ;  v ++ )
 816             {
 817               if ( n_group_vars > 0 )
 818                 {
 819                   struct string varlist;
 820                   int g;
 821
 822                   ds_init_empty (&varlist);
 823                   for ( g = 0 ; g < n_group_vars ; ++g )
 824                     {
 825                       ds_put_cstr (&varlist, group_vars[g]->name);
 826
 827                       if ( g < n_group_vars - 1)
 828                         ds_put_cstr (&varlist, " ");
 829                     }
 830
 831                   if ( rank_specs[i].rfunc == NORMAL ||
 832                        rank_specs[i].rfunc == PROPORTION )
 833                     tab_output_text (TAT_PRINTF,
 834                                      _("%s into %s(%s of %s using %s BY %s)"),
 835                                      src_vars[v]->name,
 836                                      rank_specs[i].destvars[v]->name,
 837                                      function_name[rank_specs[i].rfunc],
 838                                      src_vars[v]->name,
 839                                      fraction_name(),
 840                                      ds_cstr (&varlist)
 841                                      );
 842
 843                   else
 844                     tab_output_text (TAT_PRINTF,
 845                                      _("%s into %s(%s of %s BY %s)"),
 846                                      src_vars[v]->name,
 847                                      rank_specs[i].destvars[v]->name,
 848                                      function_name[rank_specs[i].rfunc],
 849                                      src_vars[v]->name,
 850                                      ds_cstr (&varlist)
 851                                      );
 852                   ds_destroy (&varlist);
 853                 }
 854               else
 855                 {
 856                   if ( rank_specs[i].rfunc == NORMAL ||
 857                        rank_specs[i].rfunc == PROPORTION )
 858                     tab_output_text (TAT_PRINTF,
 859                                      _("%s into %s(%s of %s using %s)"),
 860                                      src_vars[v]->name,
 861                                      rank_specs[i].destvars[v]->name,
 862                                      function_name[rank_specs[i].rfunc],
 863                                      src_vars[v]->name,
 864                                      fraction_name()
 865                                      );
 866
 867                   else
 868                     tab_output_text (TAT_PRINTF,
 869                                      _("%s into %s(%s of %s)"),
 870                                      src_vars[v]->name,
 871                                      rank_specs[i].destvars[v]->name,
 872                                      function_name[rank_specs[i].rfunc],
 873                                      src_vars[v]->name
 874                                      );
 875                 }
 876             }
 877         }
 878     }
 879
 880   if ( cmd.sbc_fraction &&
 881        ( ! cmd.sbc_normal && ! cmd.sbc_proportion) )
 882     msg(MW, _("FRACTION has been specified, but NORMAL and PROPORTION rank functions have not been requested.  The FRACTION subcommand will be ignored.") );
 883
 884   /* Add a variable which we can sort by to get back the original
 885      order */
 886   order = dict_create_var_assert (default_dict, "$ORDER_", 0);
 887
 888   add_transformation (create_resort_key, 0, order);
 889
 890   /* Do the ranking */
 891   result = rank_cmd (sc, rank_specs, n_rank_specs);
 892
 893   /* Put the active file back in its original order */
 894   {
 895     struct sort_criteria criteria;
 896     struct sort_criterion restore_criterion ;
 897     restore_criterion.fv = order->fv;
 898     restore_criterion.width = 0;
 899     restore_criterion.dir = SRT_ASCEND;
 900
 901     criteria.crits = &restore_criterion;
 902     criteria.crit_cnt = 1;
 903
 904     sort_active_file_in_place (&criteria);
 905 }
 906
 907   /* ... and we don't need our sort key anymore. So delete it */
 908   dict_delete_var (default_dict, order);
 909
 910   rank_cleanup();
 911
 912   return (result ? CMD_SUCCESS : CMD_CASCADING_FAILURE);
 913 }
 914
 915
 916 /* Parser for the variables sub command
 917    Returns 1 on success */
 918 static int
 919 rank_custom_variables(struct cmd_rank *cmd UNUSED, void *aux UNUSED)
 920 {
 921   static const int terminators[2] = {T_BY, 0};
 922
 923   lex_match('=');
 924
 925   if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
 926       && token != T_ALL)
 927       return 2;
 928
 929   sc = sort_parse_criteria (default_dict,
 930                             &src_vars, &n_src_vars, 0, terminators);
 931
 932   if ( lex_match(T_BY)  )
 933     {
 934       if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL))
 935         {
 936           return 2;
 937         }
 938
 939       if (!parse_variables (default_dict, &group_vars, &n_group_vars,
 940                             PV_NO_DUPLICATE | PV_NUMERIC | PV_NO_SCRATCH) )
 941         {
 942           free (group_vars);
 943           return 0;
 944         }
 945     }
 946
 947   return 1;
 948 }
 949
 950
 951 /* Parse the [/rank INTO var1 var2 ... varN ] clause */
 952 static int
 953 parse_rank_function(struct cmd_rank *cmd UNUSED, enum RANK_FUNC f)
 954 {
 955   int var_count = 0;
 956
 957   n_rank_specs++;
 958   rank_specs = xnrealloc(rank_specs, n_rank_specs, sizeof *rank_specs);
 959   rank_specs[n_rank_specs - 1].rfunc = f;
 960   rank_specs[n_rank_specs - 1].destvars = NULL;
 961
 962   rank_specs[n_rank_specs - 1].destvars =
 963             xcalloc (sc->crit_cnt, sizeof (struct variable *));
 964
 965   if (lex_match_id("INTO"))
 966     {
 967       struct variable *destvar;
 968
 969       while( token == T_ID )
 970         {
 971
 972           if ( dict_lookup_var (default_dict, tokid) != NULL )
 973             {
 974               msg(SE, _("Variable %s already exists."), tokid);
 975               return 0;
 976             }
 977           if ( var_count >= sc->crit_cnt )
 978             {
 979               msg(SE, _("Too many variables in INTO clause."));
 980               return 0;
 981             }
 982
 983           destvar = create_rank_variable (f, src_vars[var_count], tokid);
 984           rank_specs[n_rank_specs - 1].destvars[var_count] = destvar ;
 985
 986           lex_get();
 987           ++var_count;
 988         }
 989     }
 990
 991   return 1;
 992 }
 993
 994
 995 static int
 996 rank_custom_rank(struct cmd_rank *cmd, void *aux UNUSED )
 997 {
 998   return parse_rank_function(cmd, RANK);
 999 }
1000
1001 static int
1002 rank_custom_normal(struct cmd_rank *cmd, void *aux UNUSED )
1003 {
1004   return parse_rank_function(cmd, NORMAL);
1005 }
1006
1007 static int
1008 rank_custom_percent(struct cmd_rank *cmd, void *aux UNUSED )
1009 {
1010   return parse_rank_function (cmd, PERCENT);
1011 }
1012
1013 static int
1014 rank_custom_rfraction(struct cmd_rank *cmd, void *aux UNUSED )
1015 {
1016   return parse_rank_function(cmd, RFRACTION);
1017 }
1018
1019 static int
1020 rank_custom_proportion(struct cmd_rank *cmd, void *aux UNUSED )
1021 {
1022   return parse_rank_function(cmd, PROPORTION);
1023 }
1024
1025 static int
1026 rank_custom_n(struct cmd_rank *cmd, void *aux UNUSED )
1027 {
1028   return parse_rank_function(cmd, N);
1029 }
1030
1031 static int
1032 rank_custom_savage(struct cmd_rank *cmd, void *aux UNUSED )
1033 {
1034   return parse_rank_function(cmd, SAVAGE);
1035 }
1036
1037
1038 static int
1039 rank_custom_ntiles(struct cmd_rank *cmd, void *aux UNUSED )
1040 {
1041   if ( lex_force_match('(') )
1042     {
1043       if ( lex_force_int() )
1044         {
1045           k_ntiles = lex_integer ();
1046           lex_get();
1047           lex_force_match(')');
1048         }
1049       else
1050         return 0;
1051     }
1052   else
1053     return 0;
1054
1055   return parse_rank_function(cmd, NTILES);
1056 }