pintos-os.org Git - pspp/blob - src/language/stats/rank.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013 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 <math.h>
  20 #include <gsl/gsl_cdf.h>
  21
  22 #include "data/case.h"
  23 #include "data/casegrouper.h"
  24 #include "data/casereader.h"
  25 #include "data/dataset.h"
  26 #include "data/dictionary.h"
  27 #include "data/format.h"
  28 #include "data/variable.h"
  29 #include "data/subcase.h"
  30 #include "data/casewriter.h"
  31 #include "data/short-names.h"
  32 #include "language/command.h"
  33 #include "language/lexer/lexer.h"
  34 #include "language/lexer/variable-parser.h"
  35 #include "language/stats/sort-criteria.h"
  36 #include "math/sort.h"
  37 #include "libpspp/assertion.h"
  38 #include "libpspp/i18n.h"
  39 #include "libpspp/message.h"
  40 #include "libpspp/misc.h"
  41 #include "libpspp/pool.h"
  42 #include "libpspp/string-set.h"
  43 #include "libpspp/taint.h"
  44
  45 #include "output/tab.h"
  46
  47 #include "gettext.h"
  48 #define _(msgid) gettext (msgid)
  49 #define N_(msgid) (msgid)
  50
  51 struct rank;
  52
  53 typedef double (*rank_function_t) (const struct rank*, double c, double cc, double cc_1,
  54                                    int i, double w);
  55
  56 static double rank_proportion (const struct rank *, double c, double cc, double cc_1,
  57                                int i, double w);
  58
  59 static double rank_normal (const struct rank *, double c, double cc, double cc_1,
  60                            int i, double w);
  61
  62 static double rank_percent (const struct rank *, double c, double cc, double cc_1,
  63                             int i, double w);
  64
  65 static double rank_rfraction (const struct rank *, double c, double cc, double cc_1,
  66                               int i, double w);
  67
  68 static double rank_rank (const struct rank *, double c, double cc, double cc_1,
  69                          int i, double w);
  70
  71 static double rank_n (const struct rank *, double c, double cc, double cc_1,
  72                       int i, double w);
  73
  74 static double rank_savage (const struct rank *, double c, double cc, double cc_1,
  75                            int i, double w);
  76
  77 static double rank_ntiles (const struct rank *, double c, double cc, double cc_1,
  78                            int i, double w);
  79
  80
  81 enum rank_func
  82   {
  83     RANK,
  84     NORMAL,
  85     PERCENT,
  86     RFRACTION,
  87     PROPORTION,
  88     N,
  89     NTILES,
  90     SAVAGE,
  91     n_RANK_FUNCS
  92   };
  93
  94 static const struct fmt_spec dest_format[n_RANK_FUNCS] = {
  95   {FMT_F, 9, 3}, /* rank */
  96   {FMT_F, 6, 4}, /* normal */
  97   {FMT_F, 6, 2}, /* percent */
  98   {FMT_F, 6, 4}, /* rfraction */
  99   {FMT_F, 6, 4}, /* proportion */
 100   {FMT_F, 6, 0}, /* n */
 101   {FMT_F, 3, 0}, /* ntiles */
 102   {FMT_F, 8, 4}  /* savage */
 103 };
 104
 105 static const char * const function_name[n_RANK_FUNCS] = {
 106   "RANK",
 107   "NORMAL",
 108   "PERCENT",
 109   "RFRACTION",
 110   "PROPORTION",
 111   "N",
 112   "NTILES",
 113   "SAVAGE"
 114 };
 115
 116 static const rank_function_t rank_func[n_RANK_FUNCS] = {
 117   rank_rank,
 118   rank_normal,
 119   rank_percent,
 120   rank_rfraction,
 121   rank_proportion,
 122   rank_n,
 123   rank_ntiles,
 124   rank_savage
 125 };
 126
 127
 128 enum ties
 129   {
 130     TIES_LOW,
 131     TIES_HIGH,
 132     TIES_MEAN,
 133     TIES_CONDENSE
 134   };
 135
 136 enum fraction
 137   {
 138     FRAC_BLOM,
 139     FRAC_RANKIT,
 140     FRAC_TUKEY,
 141     FRAC_VW
 142   };
 143
 144 struct rank_spec
 145 {
 146   enum rank_func rfunc;
 147   struct variable **destvars;
 148   const char **dest_names;
 149 };
 150
 151 /* If NEW_NAME exists in DICT or NEW_NAMES, returns NULL without changing
 152    anything.  Otherwise, inserts NEW_NAME in NEW_NAMES and returns the copy of
 153    NEW_NAME now in NEW_NAMES. */
 154 static const char *
 155 try_new_name (const char *new_name,
 156               const struct dictionary *dict, struct string_set *new_names)
 157 {
 158   return (!dict_lookup_var (dict, new_name)
 159           && string_set_insert (new_names, new_name)
 160           ? string_set_find_node (new_names, new_name)->string
 161           : NULL);
 162 }
 163
 164 /* Returns a variable name for storing ranks of a variable named SRC_NAME
 165    accoring to the rank function F.  The name chosen will not be one already in
 166    DICT or NEW_NAMES.
 167
 168    If successful, adds the new name to NEW_NAMES and returns the name added.
 169    If no name can be generated, returns NULL. */
 170 static const char *
 171 rank_choose_dest_name (struct dictionary *dict, struct string_set *new_names,
 172                        enum rank_func f, const char *src_name)
 173 {
 174   char *src_name_7;
 175   char name[128];
 176   const char *s;
 177   int i;
 178
 179   /* Try the first character of the ranking function followed by the first 7
 180      bytes of the srcinal variable name. */
 181   src_name_7 = utf8_encoding_trunc (src_name, dict_get_encoding (dict), 7);
 182   snprintf (name, sizeof name, "%c%s", function_name[f][0], src_name_7);
 183   free (src_name_7);
 184   s = try_new_name (name, dict, new_names);
 185   if (s != NULL)
 186     return s;
 187
 188   /* Try "fun###". */
 189   for (i = 1; i <= 999; i++)
 190     {
 191       sprintf (name, "%.3s%03d", function_name[f], i);
 192       s = try_new_name (name, dict, new_names);
 193       if (s != NULL)
 194         return s;
 195     }
 196
 197   /* Try "RNKfn##". */
 198   for (i = 1; i <= 99; i++)
 199     {
 200       sprintf (name, "RNK%.2s%02d", function_name[f], i);
 201       s = try_new_name (name, dict, new_names);
 202       if (s != NULL)
 203         return s;
 204     }
 205
 206   msg (ME, _("Cannot generate variable name for ranking %s with %s.  "
 207              "All candidates in use."),
 208        src_name, function_name[f]);
 209   return NULL;
 210 }
 211
 212 struct rank
 213 {
 214   struct dictionary *dict;
 215
 216   struct subcase sc;
 217
 218   const struct variable **vars;
 219   size_t n_vars;
 220
 221   const struct variable **group_vars;
 222   size_t n_group_vars;
 223
 224
 225   enum mv_class exclude;
 226
 227   struct rank_spec *rs;
 228   size_t n_rs;
 229
 230   enum ties ties;
 231
 232   enum fraction fraction;
 233   int k_ntiles;
 234
 235   bool print;
 236
 237   /* Pool on which cell functions may allocate data */
 238   struct pool *pool;
 239 };
 240
 241
 242 static void
 243 destroy_rank (struct rank *rank)
 244 {
 245  free (rank->vars);
 246  free (rank->group_vars);
 247  subcase_destroy (&rank->sc);
 248  pool_destroy (rank->pool);
 249 }
 250
 251 static bool
 252 parse_into (struct lexer *lexer, struct rank *cmd,
 253             struct string_set *new_names)
 254 {
 255   int var_count = 0;
 256   struct rank_spec *rs = NULL;
 257
 258   cmd->rs = pool_realloc (cmd->pool, cmd->rs, sizeof (*cmd->rs) * (cmd->n_rs + 1));
 259   rs = &cmd->rs[cmd->n_rs];
 260
 261   if (lex_match_id (lexer, "RANK"))
 262     {
 263       rs->rfunc = RANK;
 264     }
 265   else if (lex_match_id (lexer, "NORMAL"))
 266     {
 267       rs->rfunc = NORMAL;
 268     }
 269   else if (lex_match_id (lexer, "RFRACTION"))
 270     {
 271       rs->rfunc = RFRACTION;
 272     }
 273   else if (lex_match_id (lexer, "N"))
 274     {
 275       rs->rfunc = N;
 276     }
 277   else if (lex_match_id (lexer, "SAVAGE"))
 278     {
 279       rs->rfunc = SAVAGE;
 280     }
 281   else if (lex_match_id (lexer, "PERCENT"))
 282     {
 283       rs->rfunc = PERCENT;
 284     }
 285   else if (lex_match_id (lexer, "PROPORTION"))
 286     {
 287       rs->rfunc = PROPORTION;
 288     }
 289   else if (lex_match_id (lexer, "NTILES"))
 290     {
 291       if ( !lex_force_match (lexer, T_LPAREN))
 292         return false;
 293
 294       if (! lex_force_int (lexer) )
 295         return false;
 296
 297       cmd->k_ntiles = lex_integer (lexer);
 298       lex_get (lexer);
 299
 300       if ( !lex_force_match (lexer, T_RPAREN))
 301         return false;
 302
 303       rs->rfunc = NTILES;
 304     }
 305   else
 306     {
 307       return false;
 308     }
 309
 310   cmd->n_rs++;
 311   rs->dest_names = pool_calloc (cmd->pool, cmd->n_vars,
 312                                 sizeof *rs->dest_names);
 313
 314   if (lex_match_id (lexer, "INTO"))
 315     {
 316       while( lex_token (lexer) == T_ID )
 317         {
 318           const char *name = lex_tokcstr (lexer);
 319
 320           if ( var_count >= subcase_get_n_fields (&cmd->sc) )
 321             msg (SE, _("Too many variables in INTO clause."));
 322           else if ( dict_lookup_var (cmd->dict, name) != NULL )
 323             msg (SE, _("Variable %s already exists."), name);
 324           else if (string_set_contains (new_names, name))
 325             msg (SE, _("Duplicate variable name %s."), name);
 326           else
 327             {
 328               string_set_insert (new_names, name);
 329               rs->dest_names[var_count++] = pool_strdup (cmd->pool, name);
 330               lex_get (lexer);
 331               continue;
 332             }
 333
 334           /* Error path. */
 335           return false;
 336         }
 337     }
 338
 339   return true;
 340 }
 341
 342 /* Hardly a rank function !! */
 343 static double
 344 rank_n (const struct rank *cmd UNUSED, double c UNUSED, double cc UNUSED, double cc_1 UNUSED,
 345         int i UNUSED, double w)
 346 {
 347   return w;
 348 }
 349
 350
 351 static double
 352 rank_rank (const struct rank *cmd, double c, double cc, double cc_1,
 353            int i, double w UNUSED)
 354 {
 355   double rank;
 356
 357   if ( c >= 1.0 )
 358     {
 359       switch (cmd->ties)
 360         {
 361         case TIES_LOW:
 362           rank = cc_1 + 1;
 363           break;
 364         case TIES_HIGH:
 365           rank = cc;
 366           break;
 367         case TIES_MEAN:
 368           rank = cc_1 + (c + 1.0)/ 2.0;
 369           break;
 370         case TIES_CONDENSE:
 371           rank = i;
 372           break;
 373         default:
 374           NOT_REACHED ();
 375         }
 376     }
 377   else
 378     {
 379       switch (cmd->ties)
 380         {
 381         case TIES_LOW:
 382           rank = cc_1;
 383           break;
 384         case TIES_HIGH:
 385           rank = cc;
 386           break;
 387         case TIES_MEAN:
 388           rank = cc_1 + c / 2.0 ;
 389           break;
 390         case TIES_CONDENSE:
 391           rank = i;
 392           break;
 393         default:
 394           NOT_REACHED ();
 395         }
 396     }
 397
 398   return rank;
 399 }
 400
 401
 402 static double
 403 rank_rfraction (const struct rank *cmd, double c, double cc, double cc_1,
 404                 int i, double w)
 405 {
 406   return rank_rank (cmd, c, cc, cc_1, i, w) / w ;
 407 }
 408
 409
 410 static double
 411 rank_percent (const struct rank *cmd, double c, double cc, double cc_1,
 412               int i, double w)
 413 {
 414   return rank_rank (cmd, c, cc, cc_1, i, w) * 100.0 / w ;
 415 }
 416
 417
 418 static double
 419 rank_proportion (const struct rank *cmd, double c, double cc, double cc_1,
 420                  int i, double w)
 421 {
 422   const double r =  rank_rank (cmd, c, cc, cc_1, i, w) ;
 423
 424   double f;
 425
 426   switch ( cmd->fraction )
 427     {
 428     case FRAC_BLOM:
 429       f =  (r - 3.0/8.0) / (w + 0.25);
 430       break;
 431     case FRAC_RANKIT:
 432       f = (r - 0.5) / w ;
 433       break;
 434     case FRAC_TUKEY:
 435       f = (r - 1.0/3.0) / (w + 1.0/3.0);
 436       break;
 437     case FRAC_VW:
 438       f = r / ( w + 1.0);
 439       break;
 440     default:
 441       NOT_REACHED ();
 442     }
 443
 444
 445   return (f > 0) ? f : SYSMIS;
 446 }
 447
 448 static double
 449 rank_normal (const struct rank *cmd, double c, double cc, double cc_1,
 450              int i, double w)
 451 {
 452   double f = rank_proportion (cmd, c, cc, cc_1, i, w);
 453
 454   return gsl_cdf_ugaussian_Pinv (f);
 455 }
 456
 457 static double
 458 rank_ntiles (const struct rank *cmd, double c, double cc, double cc_1,
 459              int i, double w)
 460 {
 461   double r = rank_rank (cmd, c, cc, cc_1, i, w);
 462
 463
 464   return ( floor (( r * cmd->k_ntiles) / ( w + 1) ) + 1);
 465 }
 466
 467 /* Expected value of the order statistics from an exponential distribution */
 468 static double
 469 ee (int j, double w_star)
 470 {
 471   int k;
 472   double sum = 0.0;
 473
 474   for (k = 1 ; k <= j; k++)
 475     sum += 1.0 / ( w_star + 1 - k );
 476
 477   return sum;
 478 }
 479
 480
 481 static double
 482 rank_savage (const struct rank *cmd UNUSED, double c, double cc, double cc_1,
 483              int i UNUSED, double w)
 484 {
 485   double int_part;
 486   const int i_1 = floor (cc_1);
 487   const int i_2 = floor (cc);
 488
 489   const double w_star = (modf (w, &int_part) == 0 ) ? w : floor (w) + 1;
 490
 491   const double g_1 = cc_1 - i_1;
 492   const double g_2 = cc - i_2;
 493
 494   /* The second factor is infinite, when the first is zero.
 495      Therefore, evaluate the second, only when the first is non-zero */
 496   const double expr1 =  (1 - g_1) ? (1 - g_1) * ee(i_1+1, w_star) : ( 1 - g_1);
 497   const double expr2 =  g_2 ? g_2 * ee (i_2+1, w_star) : g_2 ;
 498
 499   if ( i_1 == i_2 )
 500     return ee (i_1 + 1, w_star) - 1;
 501
 502   if ( i_1 + 1 == i_2 )
 503     return ( ( expr1 + expr2 )/c ) - 1;
 504
 505   if ( i_1 + 2 <= i_2 )
 506     {
 507       int j;
 508       double sigma = 0.0;
 509       for (j = i_1 + 2 ; j <= i_2; ++j )
 510         sigma += ee (j, w_star);
 511       return ( (expr1 + expr2 + sigma) / c) -1;
 512     }
 513
 514   NOT_REACHED();
 515 }
 516
 517 static double
 518 sum_weights (const struct casereader *input, int weight_idx)
 519 {
 520   if (weight_idx == -1)
 521     return casereader_count_cases (input);
 522   else
 523     {
 524       struct casereader *pass;
 525       struct ccase *c;
 526       double w;
 527
 528       w = 0.0;
 529       pass = casereader_clone (input);
 530       for (; (c = casereader_read (pass)) != NULL; case_unref (c))
 531         w += case_num_idx (c, weight_idx);
 532       casereader_destroy (pass);
 533
 534       return w;
 535     }
 536 }
 537
 538 static void
 539 rank_sorted_file (struct casereader *input,
 540                   struct casewriter *output,
 541                   const struct dictionary *dict,
 542                   int dest_idx,
 543                   const struct rank *cmd
 544                   )
 545 {
 546   struct variable *weight_var = dict_get_weight (dict);
 547   int weight_idx = weight_var ? var_get_case_index (weight_var) : -1;
 548   struct casegrouper *tie_grouper;
 549   struct casereader *tied_cases;
 550   struct ccase *c;
 551   double cc = 0.0;
 552   double w;
 553   int tie_group = 1;
 554
 555   input = casereader_create_filter_missing (input, &cmd->vars[dest_idx], 1,
 556                                             cmd->exclude, NULL, output);
 557   input = casereader_create_filter_weight (input, dict, NULL, output);
 558
 559   /* Get total group weight. */
 560   w = sum_weights (input, weight_idx);
 561
 562   /* Do ranking. */
 563   tie_grouper = casegrouper_create_vars (input, &cmd->vars[dest_idx], 1);
 564   for (; casegrouper_get_next_group (tie_grouper, &tied_cases);
 565        casereader_destroy (tied_cases))
 566     {
 567       double tw = sum_weights (tied_cases, weight_idx);
 568       double cc_1 = cc;
 569       cc += tw;
 570
 571       taint_propagate (casereader_get_taint (tied_cases),
 572                        casewriter_get_taint (output));
 573
 574       /* Rank tied cases. */
 575       while ((c = casereader_read (tied_cases)) != NULL)
 576         {
 577           size_t i;
 578
 579           c = case_unshare (c);
 580           for (i = 0; i < cmd->n_rs; ++i)
 581             {
 582               const struct variable *dst_var = cmd->rs[i].destvars[dest_idx];
 583               double *dst_value = &case_data_rw (c, dst_var)->f;
 584               *dst_value = rank_func[cmd->rs[i].rfunc] (cmd, tw, cc, cc_1, tie_group, w);
 585             }
 586           casewriter_write (output, c);
 587         }
 588
 589       tie_group++;
 590     }
 591   casegrouper_destroy (tie_grouper);
 592 }
 593
 594
 595 /* Transformation function to enumerate all the cases */
 596 static int
 597 create_resort_key (void *key_var_, struct ccase **cc, casenumber case_num)
 598 {
 599   struct variable *key_var = key_var_;
 600
 601   *cc = case_unshare (*cc);
 602   case_data_rw (*cc, key_var)->f = case_num;
 603
 604   return TRNS_CONTINUE;
 605 }
 606
 607 static bool
 608 rank_cmd (struct dataset *ds,  const struct rank *cmd);
 609
 610
 611 static const char *
 612 fraction_name (const struct rank *cmd)
 613 {
 614   switch (cmd->fraction )
 615     {
 616     case FRAC_BLOM:   return "BLOM";
 617     case FRAC_RANKIT: return "RANKIT";
 618     case FRAC_TUKEY:  return "TUKEY";
 619     case FRAC_VW:     return "VW";
 620     default:          NOT_REACHED ();
 621     }
 622 }
 623
 624 /* Returns a label for a variable derived from SRC_VAR with function F. */
 625 static const char *
 626 create_var_label (struct rank *cmd, const struct variable *src_var,
 627                   enum rank_func f)
 628 {
 629   struct string label;
 630   const char *pool_label;
 631
 632   ds_init_empty (&label);
 633
 634   if ( cmd->n_group_vars > 0 )
 635     {
 636       struct string group_var_str;
 637       int g;
 638
 639       ds_init_empty (&group_var_str);
 640
 641       for (g = 0 ; g < cmd->n_group_vars ; ++g )
 642         {
 643           if ( g > 0 ) ds_put_cstr (&group_var_str, " ");
 644           ds_put_cstr (&group_var_str, var_get_name (cmd->group_vars[g]));
 645         }
 646
 647       ds_put_format (&label, _("%s of %s by %s"), function_name[f],
 648                      var_get_name (src_var), ds_cstr (&group_var_str));
 649       ds_destroy (&group_var_str);
 650     }
 651   else
 652     ds_put_format (&label, _("%s of %s"),
 653                    function_name[f], var_get_name (src_var));
 654
 655   pool_label = pool_strdup (cmd->pool, ds_cstr (&label));
 656
 657   ds_destroy (&label);
 658
 659   return pool_label;
 660 }
 661
 662 int
 663 cmd_rank (struct lexer *lexer, struct dataset *ds)
 664 {
 665   struct string_set new_names;
 666   struct rank rank;
 667   struct variable *order;
 668   struct rank_spec *rs;
 669   bool result = true;
 670   int i;
 671
 672   subcase_init_empty (&rank.sc);
 673
 674   rank.rs = NULL;
 675   rank.n_rs = 0;
 676   rank.exclude = MV_ANY;
 677   rank.n_group_vars = 0;
 678   rank.group_vars = NULL;
 679   rank.dict = dataset_dict (ds);
 680   rank.ties = TIES_MEAN;
 681   rank.fraction = FRAC_BLOM;
 682   rank.print = true;
 683   rank.pool = pool_create ();
 684
 685   string_set_init (&new_names);
 686
 687   if (lex_match_id (lexer, "VARIABLES"))
 688     lex_force_match (lexer, T_EQUALS);
 689
 690   if (!parse_sort_criteria (lexer, rank.dict,
 691                             &rank.sc,
 692                             &rank.vars, NULL))
 693     goto error;
 694
 695   rank.n_vars = rank.sc.n_fields;
 696
 697   if (lex_match (lexer, T_BY) )
 698     {
 699       if ( ! parse_variables_const (lexer, rank.dict,
 700                                     &rank.group_vars, &rank.n_group_vars,
 701                                     PV_NO_DUPLICATE | PV_NO_SCRATCH))
 702         goto error;
 703     }
 704
 705
 706   while (lex_token (lexer) != T_ENDCMD )
 707     {
 708       lex_force_match (lexer, T_SLASH);
 709       if (lex_match_id (lexer, "TIES"))
 710         {
 711           lex_force_match (lexer, T_EQUALS);
 712           if (lex_match_id (lexer, "MEAN"))
 713             {
 714               rank.ties = TIES_MEAN;
 715             }
 716           else if (lex_match_id (lexer, "LOW"))
 717             {
 718               rank.ties = TIES_LOW;
 719             }
 720           else if (lex_match_id (lexer, "HIGH"))
 721             {
 722               rank.ties = TIES_HIGH;
 723             }
 724           else if (lex_match_id (lexer, "CONDENSE"))
 725             {
 726               rank.ties = TIES_CONDENSE;
 727             }
 728           else
 729             {
 730               lex_error (lexer, NULL);
 731               goto error;
 732             }
 733         }
 734       else if (lex_match_id (lexer, "FRACTION"))
 735         {
 736           lex_force_match (lexer, T_EQUALS);
 737           if (lex_match_id (lexer, "BLOM"))
 738             {
 739               rank.fraction = FRAC_BLOM;
 740             }
 741           else if (lex_match_id (lexer, "TUKEY"))
 742             {
 743               rank.fraction = FRAC_TUKEY;
 744             }
 745           else if (lex_match_id (lexer, "VW"))
 746             {
 747               rank.fraction = FRAC_VW;
 748             }
 749           else if (lex_match_id (lexer, "RANKIT"))
 750             {
 751               rank.fraction = FRAC_RANKIT;
 752             }
 753           else
 754             {
 755               lex_error (lexer, NULL);
 756               goto error;
 757             }
 758         }
 759       else if (lex_match_id (lexer, "PRINT"))
 760         {
 761           lex_force_match (lexer, T_EQUALS);
 762           if (lex_match_id (lexer, "YES"))
 763             {
 764               rank.print = true;
 765             }
 766           else if (lex_match_id (lexer, "NO"))
 767             {
 768               rank.print = false;
 769             }
 770           else
 771             {
 772               lex_error (lexer, NULL);
 773               goto error;
 774             }
 775         }
 776       else if (lex_match_id (lexer, "MISSING"))
 777         {
 778           lex_force_match (lexer, T_EQUALS);
 779           if (lex_match_id (lexer, "INCLUDE"))
 780             {
 781               rank.exclude = MV_SYSTEM;
 782             }
 783           else if (lex_match_id (lexer, "EXCLUDE"))
 784             {
 785               rank.exclude = MV_ANY;
 786             }
 787           else
 788             {
 789               lex_error (lexer, NULL);
 790               goto error;
 791             }
 792         }
 793       else if (! parse_into (lexer, &rank, &new_names))
 794         goto error;
 795     }
 796
 797
 798   /* If no rank specs are given, then apply a default */
 799   if ( rank.n_rs == 0)
 800     {
 801       struct rank_spec *rs;
 802
 803       rs = pool_calloc (rank.pool, 1, sizeof *rs);
 804       rs->rfunc = RANK;
 805       rs->dest_names = pool_calloc (rank.pool, 1, sizeof *rs->dest_names);
 806
 807       rank.rs = rs;
 808       rank.n_rs = 1;
 809     }
 810
 811   /* Choose variable names for all rank destinations which haven't already been
 812      created with INTO. */
 813   for (rs = rank.rs; rs < &rank.rs[rank.n_rs]; rs++)
 814     {
 815       int v;
 816
 817       for ( v = 0 ; v < rank.n_vars ;  v ++ )
 818         {
 819           const char **dst_name = &rs->dest_names[v];
 820           if ( *dst_name == NULL )
 821             {
 822               *dst_name = rank_choose_dest_name (rank.dict, &new_names,
 823                                                  rs->rfunc,
 824                                                  var_get_name (rank.vars[v]));
 825               if (*dst_name == NULL)
 826                 goto error;
 827             }
 828         }
 829     }
 830
 831   /* Create variables. */
 832   for (rs = rank.rs; rs < &rank.rs[rank.n_rs]; rs++)
 833     rs->destvars = pool_nmalloc (rank.pool, rank.n_vars, sizeof *rs->destvars);
 834   for ( i = 0 ; i < rank.n_vars ;  i ++ )
 835     {
 836       struct variable *var;
 837
 838       for (rs = rank.rs; rs < &rank.rs[rank.n_rs]; rs++)
 839         {
 840           var = dict_create_var_assert (dataset_dict (ds),
 841                                         rs->dest_names[i], 0);
 842           var_set_both_formats (var, &dest_format[rs->rfunc]);
 843           var_set_label (var, create_var_label (&rank, rank.vars[i],
 844                                                 rs->rfunc),
 845                          false);
 846
 847           rs->destvars[i] = var;
 848         }
 849     }
 850
 851   if ( rank.print )
 852     {
 853       int v;
 854
 855       tab_output_text (0, _("Variables Created By RANK"));
 856       tab_output_text (0, "");
 857
 858       for (i = 0 ; i <  rank.n_rs ; ++i )
 859         {
 860           for ( v = 0 ; v < rank.n_vars ;  v ++ )
 861             {
 862               if ( rank.n_group_vars > 0 )
 863                 {
 864                   struct string varlist;
 865                   int g;
 866
 867                   ds_init_empty (&varlist);
 868                   for ( g = 0 ; g < rank.n_group_vars ; ++g )
 869                     {
 870                       ds_put_cstr (&varlist, var_get_name (rank.group_vars[g]));
 871
 872                       if ( g < rank.n_group_vars - 1)
 873                         ds_put_cstr (&varlist, " ");
 874                     }
 875
 876                   if ( rank.rs[i].rfunc == NORMAL ||
 877                        rank.rs[i].rfunc == PROPORTION )
 878                     tab_output_text_format (0,
 879                                             _("%s into %s(%s of %s using %s BY %s)"),
 880                                             var_get_name (rank.vars[v]),
 881                                             rank.rs[i].dest_names[v],
 882                                             function_name[rank.rs[i].rfunc],
 883                                             var_get_name (rank.vars[v]),
 884                                             fraction_name (&rank),
 885                                             ds_cstr (&varlist));
 886
 887                   else
 888                     tab_output_text_format (0,
 889                                             _("%s into %s(%s of %s BY %s)"),
 890                                             var_get_name (rank.vars[v]),
 891                                             rank.rs[i].dest_names[v],
 892                                             function_name[rank.rs[i].rfunc],
 893                                             var_get_name (rank.vars[v]),
 894                                             ds_cstr (&varlist));
 895                   ds_destroy (&varlist);
 896                 }
 897               else
 898                 {
 899                   if ( rank.rs[i].rfunc == NORMAL ||
 900                        rank.rs[i].rfunc == PROPORTION )
 901                     tab_output_text_format (0,
 902                                             _("%s into %s(%s of %s using %s)"),
 903                                             var_get_name (rank.vars[v]),
 904                                             rank.rs[i].dest_names[v],
 905                                             function_name[rank.rs[i].rfunc],
 906                                             var_get_name (rank.vars[v]),
 907                                             fraction_name (&rank));
 908
 909                   else
 910                     tab_output_text_format (0,
 911                                             _("%s into %s(%s of %s)"),
 912                                             var_get_name (rank.vars[v]),
 913                                             rank.rs[i].dest_names[v],
 914                                             function_name[rank.rs[i].rfunc],
 915                                             var_get_name (rank.vars[v]));
 916                 }
 917             }
 918         }
 919     }
 920
 921   /* Add a variable which we can sort by to get back the original
 922      order */
 923   order = dict_create_var_assert (dataset_dict (ds), "$ORDER_", 0);
 924
 925   add_transformation (ds, create_resort_key, 0, order);
 926
 927   /* Do the ranking */
 928   result = rank_cmd (ds, &rank);
 929
 930   /* Put the active dataset back in its original order.  Delete
 931      our sort key, which we don't need anymore.  */
 932   {
 933     struct casereader *sorted;
 934
 935
 936     /* FIXME: loses error conditions. */
 937
 938     proc_discard_output (ds);
 939     sorted = sort_execute_1var (proc_open (ds), order);
 940     result = proc_commit (ds) && result;
 941
 942     dict_delete_var (dataset_dict (ds), order);
 943     result = dataset_set_source (ds, sorted) && result;
 944     if ( result != true)
 945       goto error;
 946   }
 947
 948   destroy_rank (&rank);
 949   string_set_destroy (&new_names);
 950   return CMD_SUCCESS;
 951
 952  error:
 953
 954   destroy_rank (&rank);
 955   string_set_destroy (&new_names);
 956   return CMD_FAILURE;
 957 }
 958
 959
 960
 961 static bool
 962 rank_cmd (struct dataset *ds, const struct rank *cmd)
 963 {
 964   struct dictionary *d = dataset_dict (ds);
 965   bool ok = true;
 966   int i;
 967
 968   for (i = 0 ; i < subcase_get_n_fields (&cmd->sc) ; ++i )
 969     {
 970       /* Rank variable at index I in SC. */
 971       struct casegrouper *split_grouper;
 972       struct casereader *split_group;
 973       struct casewriter *output;
 974
 975       proc_discard_output (ds);
 976       split_grouper = casegrouper_create_splits (proc_open (ds), d);
 977       output = autopaging_writer_create (dict_get_proto (d));
 978
 979       while (casegrouper_get_next_group (split_grouper, &split_group))
 980         {
 981           struct subcase ordering;
 982           struct casereader *ordered;
 983           struct casegrouper *by_grouper;
 984           struct casereader *by_group;
 985
 986           /* Sort this split group by the BY variables as primary
 987              keys and the rank variable as secondary key. */
 988           subcase_init_vars (&ordering, cmd->group_vars, cmd->n_group_vars);
 989           subcase_add_var (&ordering, cmd->vars[i],
 990                            subcase_get_direction (&cmd->sc, i));
 991           ordered = sort_execute (split_group, &ordering);
 992           subcase_destroy (&ordering);
 993
 994           /* Rank the rank variable within this split group. */
 995           by_grouper = casegrouper_create_vars (ordered,
 996                                                 cmd->group_vars, cmd->n_group_vars);
 997           while (casegrouper_get_next_group (by_grouper, &by_group))
 998             {
 999               /* Rank the rank variable within this BY group
1000                  within the split group. */
1001
1002               rank_sorted_file (by_group, output, d,  i, cmd);
1003
1004             }
1005           ok = casegrouper_destroy (by_grouper) && ok;
1006         }
1007       ok = casegrouper_destroy (split_grouper);
1008       ok = proc_commit (ds) && ok;
1009       ok = (dataset_set_source (ds, casewriter_make_reader (output))
1010             && ok);
1011       if (!ok)
1012         break;
1013     }
1014
1015   return ok;
1016 }