src/language/stats/npar.c

   1 /* PSPP - a program for statistical analysis. -*-c-*-
   2    Copyright (C) 2006, 2008, 2009, 2010 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 <language/stats/npar.h>
  20 #include "npar-summary.h"
  21
  22 #include <stdlib.h>
  23 #include <math.h>
  24
  25 #include "xalloc.h"
  26
  27 #include <data/case.h>
  28 #include <data/casegrouper.h>
  29 #include <data/casereader.h>
  30 #include <data/dictionary.h>
  31 #include <data/procedure.h>
  32 #include <data/settings.h>
  33 #include <data/variable.h>
  34 #include <libpspp/assertion.h>
  35 #include <libpspp/cast.h>
  36 #include <libpspp/hmapx.h>
  37 #include <libpspp/hash-functions.h>
  38 #include <libpspp/message.h>
  39 #include <libpspp/pool.h>
  40 #include <libpspp/str.h>
  41 #include <libpspp/taint.h>
  42 #include <language/command.h>
  43 #include <language/lexer/lexer.h>
  44 #include <language/lexer/variable-parser.h>
  45 #include <language/lexer/value-parser.h>
  46 #include <language/stats/binomial.h>
  47 #include <language/stats/chisquare.h>
  48 #include <language/stats/kruskal-wallis.h>
  49 #include <language/stats/wilcoxon.h>
  50 #include <language/stats/sign.h>
  51 #include <math/moments.h>
  52
  53 #include "gettext.h"
  54 #define _(msgid) gettext (msgid)
  55
  56 /* Settings for subcommand specifiers. */
  57 enum missing_type
  58   {
  59     MISS_ANALYSIS,
  60     MISS_LISTWISE,
  61   };
  62
  63 /* Array indices for STATISTICS subcommand. */
  64 enum
  65   {
  66     NPAR_ST_DESCRIPTIVES = 0,
  67     NPAR_ST_QUARTILES = 1,
  68     NPAR_ST_ALL = 2,
  69     NPAR_ST_count
  70   };
  71
  72 /* NPAR TESTS structure. */
  73 struct cmd_npar_tests
  74   {
  75     /* Count variables indicating how many
  76        of the subcommands have been given. */
  77     int chisquare;
  78     int binomial;
  79     int wilcoxon;
  80     int sign;
  81     int kruskal_wallis;
  82     int missing;
  83     int method;
  84     int statistics;
  85
  86     /* How missing values should be treated */
  87     long miss;
  88
  89     /* Which statistics have been requested */
  90     int a_statistics[NPAR_ST_count];
  91   };
  92
  93
  94 struct npar_specs
  95 {
  96   struct pool *pool;
  97   struct npar_test **test;
  98   size_t n_tests;
  99
 100   const struct variable **vv; /* Compendium of all variables
 101                                   (those mentioned on ANY subcommand */
 102   int n_vars; /* Number of variables in vv */
 103
 104   enum mv_class filter;    /* Missing values to filter. */
 105
 106   bool descriptives;       /* Descriptive statistics should be calculated */
 107   bool quartiles;          /* Quartiles should be calculated */
 108
 109   bool exact;  /* Whether exact calculations have been requested */
 110   double timer;   /* Maximum time (in minutes) to wait for exact calculations */
 111 };
 112
 113
 114 /* Prototype for custom subcommands of NPAR TESTS. */
 115 static int npar_chisquare (struct lexer *, struct dataset *, struct npar_specs *);
 116 static int npar_binomial (struct lexer *, struct dataset *,  struct npar_specs *);
 117 static int npar_wilcoxon (struct lexer *, struct dataset *, struct npar_specs *);
 118 static int npar_sign (struct lexer *, struct dataset *, struct npar_specs *);
 119 static int npar_kruskal_wallis (struct lexer *, struct dataset *, struct npar_specs *);
 120 static int npar_method (struct lexer *, struct npar_specs *);
 121
 122 /* Command parsing functions. */
 123 static int parse_npar_tests (struct lexer *lexer, struct dataset *ds, struct cmd_npar_tests *p,
 124                              struct npar_specs *npar_specs );
 125
 126 static int
 127 parse_npar_tests (struct lexer *lexer, struct dataset *ds, struct cmd_npar_tests *npt,
 128                   struct npar_specs *nps)
 129 {
 130   npt->chisquare = 0;
 131   npt->binomial = 0;
 132   npt->wilcoxon = 0;
 133   npt->sign = 0;
 134   npt->missing = 0;
 135   npt->miss = MISS_ANALYSIS;
 136   npt->method = 0;
 137   npt->statistics = 0;
 138   memset (npt->a_statistics, 0, sizeof npt->a_statistics);
 139   for (;;)
 140     {
 141       if (lex_match_hyphenated_word (lexer, "CHISQUARE"))
 142         {
 143           lex_match (lexer, '=');
 144           npt->chisquare++;
 145           switch (npar_chisquare (lexer, ds, nps))
 146             {
 147             case 0:
 148               goto lossage;
 149             case 1:
 150               break;
 151             case 2:
 152               lex_error (lexer, NULL);
 153               goto lossage;
 154             default:
 155               NOT_REACHED ();
 156             }
 157         }
 158       else if (lex_match_hyphenated_word (lexer, "BINOMIAL"))
 159         {
 160           lex_match (lexer, '=');
 161           npt->binomial++;
 162           switch (npar_binomial (lexer, ds, nps))
 163             {
 164             case 0:
 165               goto lossage;
 166             case 1:
 167               break;
 168             case 2:
 169               lex_error (lexer, NULL);
 170               goto lossage;
 171             default:
 172               NOT_REACHED ();
 173             }
 174         }
 175       else if (lex_match_hyphenated_word (lexer, "K-W") ||
 176                lex_match_hyphenated_word (lexer, "KRUSKAL-WALLIS"))
 177         {
 178           lex_match (lexer, '=');
 179           npt->kruskal_wallis++;
 180           switch (npar_kruskal_wallis (lexer, ds, nps))
 181             {
 182             case 0:
 183               goto lossage;
 184             case 1:
 185               break;
 186             case 2:
 187               lex_error (lexer, NULL);
 188               goto lossage;
 189             default:
 190               NOT_REACHED ();
 191             }
 192         }
 193       else if (lex_match_hyphenated_word (lexer, "WILCOXON"))
 194         {
 195           lex_match (lexer, '=');
 196           npt->wilcoxon++;
 197           switch (npar_wilcoxon (lexer, ds, nps))
 198             {
 199             case 0:
 200               goto lossage;
 201             case 1:
 202               break;
 203             case 2:
 204               lex_error (lexer, NULL);
 205               goto lossage;
 206             default:
 207               NOT_REACHED ();
 208             }
 209         }
 210       else if (lex_match_hyphenated_word (lexer, "SIGN"))
 211         {
 212           lex_match (lexer, '=');
 213           npt->sign++;
 214           switch (npar_sign (lexer, ds, nps))
 215             {
 216             case 0:
 217               goto lossage;
 218             case 1:
 219               break;
 220             case 2:
 221               lex_error (lexer, NULL);
 222               goto lossage;
 223             default:
 224               NOT_REACHED ();
 225             }
 226         }
 227       else if (lex_match_hyphenated_word (lexer, "MISSING"))
 228         {
 229           lex_match (lexer, '=');
 230           npt->missing++;
 231           if (npt->missing > 1)
 232             {
 233               msg (SE, _("The %s subcommand may be given only once."), "MISSING");
 234               goto lossage;
 235             }
 236           while (lex_token (lexer) != '/' && lex_token (lexer) != '.')
 237             {
 238               if (lex_match_hyphenated_word (lexer, "ANALYSIS"))
 239                 npt->miss = MISS_ANALYSIS;
 240               else if (lex_match_hyphenated_word (lexer, "LISTWISE"))
 241                 npt->miss = MISS_LISTWISE;
 242               else if (lex_match_hyphenated_word (lexer, "INCLUDE"))
 243                 nps->filter = MV_SYSTEM;
 244               else if (lex_match_hyphenated_word (lexer, "EXCLUDE"))
 245                 nps->filter = MV_ANY;
 246               else
 247                 {
 248                   lex_error (lexer, NULL);
 249                   goto lossage;
 250                 }
 251               lex_match (lexer, ',');
 252             }
 253         }
 254       else if (lex_match_hyphenated_word (lexer, "METHOD"))
 255         {
 256           lex_match (lexer, '=');
 257           npt->method++;
 258           if (npt->method > 1)
 259             {
 260               msg (SE, _("The %s subcommand may be given only once."), "METHOD");
 261               goto lossage;
 262             }
 263           switch (npar_method (lexer, nps))
 264             {
 265             case 0:
 266               goto lossage;
 267             case 1:
 268               break;
 269             case 2:
 270               lex_error (lexer, NULL);
 271               goto lossage;
 272             default:
 273               NOT_REACHED ();
 274             }
 275         }
 276       else if (lex_match_hyphenated_word (lexer, "STATISTICS"))
 277         {
 278           lex_match (lexer, '=');
 279           npt->statistics++;
 280           while (lex_token (lexer) != '/' && lex_token (lexer) != '.')
 281             {
 282               if (lex_match_hyphenated_word (lexer, "DESCRIPTIVES"))
 283                 npt->a_statistics[NPAR_ST_DESCRIPTIVES] = 1;
 284               else if (lex_match_hyphenated_word (lexer, "QUARTILES"))
 285                 npt->a_statistics[NPAR_ST_QUARTILES] = 1;
 286               else if (lex_match (lexer, T_ALL))
 287                 npt->a_statistics[NPAR_ST_ALL] = 1;
 288               else
 289                 {
 290                   lex_error (lexer, NULL);
 291                   goto lossage;
 292                 }
 293               lex_match (lexer, ',');
 294             }
 295         }
 296       else if ( settings_get_syntax () != COMPATIBLE && lex_match_id (lexer, "ALGORITHM"))
 297         {
 298           lex_match (lexer, '=');
 299           if (lex_match_id (lexer, "COMPATIBLE"))
 300             settings_set_cmd_algorithm (COMPATIBLE);
 301           else if (lex_match_id (lexer, "ENHANCED"))
 302             settings_set_cmd_algorithm (ENHANCED);
 303           }
 304         if (!lex_match (lexer, '/'))
 305           break;
 306       }
 307
 308     if (lex_token (lexer) != '.')
 309       {
 310         lex_error (lexer, _("expecting end of command"));
 311         goto lossage;
 312       }
 313
 314   return true;
 315
 316 lossage:
 317   return false;
 318 }
 319
 320
 321 static void one_sample_insert_variables (const struct npar_test *test,
 322                                          struct hmapx *);
 323
 324 static void two_sample_insert_variables (const struct npar_test *test,
 325                                          struct hmapx *);
 326
 327 static void n_sample_insert_variables (const struct npar_test *test,
 328                                        struct hmapx *);
 329
 330 static void
 331 npar_execute (struct casereader *input,
 332              const struct npar_specs *specs,
 333              const struct dataset *ds)
 334 {
 335   int t;
 336   struct descriptives *summary_descriptives = NULL;
 337
 338   for ( t = 0 ; t < specs->n_tests; ++t )
 339     {
 340       const struct npar_test *test = specs->test[t];
 341       if ( NULL == test->execute )
 342         {
 343           msg (SW, _("NPAR subcommand not currently implemented."));
 344           continue;
 345         }
 346       test->execute (ds, casereader_clone (input), specs->filter, test, specs->exact, specs->timer);
 347     }
 348
 349   if ( specs->descriptives )
 350     {
 351       summary_descriptives = xnmalloc (sizeof (*summary_descriptives),
 352                                        specs->n_vars);
 353
 354       npar_summary_calc_descriptives (summary_descriptives,
 355                                       casereader_clone (input),
 356                                       dataset_dict (ds),
 357                                       specs->vv, specs->n_vars,
 358                                       specs->filter);
 359     }
 360
 361   if ( (specs->descriptives || specs->quartiles)
 362        && !taint_has_tainted_successor (casereader_get_taint (input)) )
 363     do_summary_box (summary_descriptives, specs->vv, specs->n_vars );
 364
 365   free (summary_descriptives);
 366   casereader_destroy (input);
 367 }
 368
 369 int
 370 cmd_npar_tests (struct lexer *lexer, struct dataset *ds)
 371 {
 372   struct cmd_npar_tests cmd;
 373   bool ok;
 374   int i;
 375   struct npar_specs npar_specs = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
 376   struct casegrouper *grouper;
 377   struct casereader *input, *group;
 378   struct hmapx var_map = HMAPX_INITIALIZER (var_map);
 379
 380
 381   npar_specs.pool = pool_create ();
 382   npar_specs.filter = MV_ANY;
 383   npar_specs.n_vars = -1;
 384   npar_specs.vv = NULL;
 385
 386   if ( ! parse_npar_tests (lexer, ds, &cmd, &npar_specs) )
 387     {
 388       pool_destroy (npar_specs.pool);
 389       return CMD_FAILURE;
 390     }
 391
 392   for (i = 0; i < npar_specs.n_tests; ++i )
 393     {
 394       const struct npar_test *test = npar_specs.test[i];
 395       test->insert_variables (test, &var_map);
 396     }
 397
 398   {
 399     struct hmapx_node *node;
 400     struct variable *var;
 401     npar_specs.n_vars = 0;
 402
 403     HMAPX_FOR_EACH (var, node, &var_map)
 404       {
 405         npar_specs.n_vars ++;
 406         npar_specs.vv = pool_nrealloc (npar_specs.pool, npar_specs.vv, npar_specs.n_vars, sizeof (*npar_specs.vv));
 407         npar_specs.vv[npar_specs.n_vars - 1] = var;
 408       }
 409   }
 410
 411   qsort (npar_specs.vv, npar_specs.n_vars, sizeof (*npar_specs.vv),
 412          compare_var_ptrs_by_name);
 413
 414   if ( cmd.statistics )
 415     {
 416       int i;
 417
 418       for ( i = 0 ; i < NPAR_ST_count; ++i )
 419         {
 420           if ( cmd.a_statistics[i] )
 421             {
 422               switch ( i )
 423                 {
 424                 case NPAR_ST_DESCRIPTIVES:
 425                   npar_specs.descriptives = true;
 426                   break;
 427                 case NPAR_ST_QUARTILES:
 428                   npar_specs.quartiles = true;
 429                   break;
 430                 case NPAR_ST_ALL:
 431                   npar_specs.quartiles = true;
 432                   npar_specs.descriptives = true;
 433                   break;
 434                 default:
 435                   NOT_REACHED ();
 436                 };
 437             }
 438         }
 439     }
 440
 441   input = proc_open (ds);
 442   if ( cmd.miss == MISS_LISTWISE )
 443     {
 444       input = casereader_create_filter_missing (input,
 445                                                 npar_specs.vv,
 446                                                 npar_specs.n_vars,
 447                                                 npar_specs.filter,
 448                                                 NULL, NULL);
 449     }
 450
 451
 452   grouper = casegrouper_create_splits (input, dataset_dict (ds));
 453   while (casegrouper_get_next_group (grouper, &group))
 454     npar_execute (group, &npar_specs, ds);
 455   ok = casegrouper_destroy (grouper);
 456   ok = proc_commit (ds) && ok;
 457
 458   pool_destroy (npar_specs.pool);
 459   hmapx_destroy (&var_map);
 460
 461   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
 462 }
 463
 464 static int
 465 npar_chisquare (struct lexer *lexer, struct dataset *ds,
 466                 struct npar_specs *specs)
 467 {
 468   struct chisquare_test *cstp = pool_alloc (specs->pool, sizeof (*cstp));
 469   struct one_sample_test *tp = &cstp->parent;
 470   struct npar_test *nt = &tp->parent;
 471
 472   nt->execute = chisquare_execute;
 473   nt->insert_variables = one_sample_insert_variables;
 474
 475   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 476                                    &tp->vars, &tp->n_vars,
 477                                    PV_NO_SCRATCH | PV_NO_DUPLICATE))
 478     {
 479       return 2;
 480     }
 481
 482   cstp->ranged = false;
 483
 484   if ( lex_match (lexer, '('))
 485     {
 486       cstp->ranged = true;
 487       if ( ! lex_force_num (lexer)) return 0;
 488       cstp->lo = lex_integer (lexer);
 489       lex_get (lexer);
 490       lex_force_match (lexer, ',');
 491       if (! lex_force_num (lexer) ) return 0;
 492       cstp->hi = lex_integer (lexer);
 493       if ( cstp->lo >= cstp->hi )
 494         {
 495           msg (ME,
 496               _("The specified value of HI (%d) is "
 497                 "lower than the specified value of LO (%d)"),
 498               cstp->hi, cstp->lo);
 499           return 0;
 500         }
 501       lex_get (lexer);
 502       if (! lex_force_match (lexer, ')')) return 0;
 503     }
 504
 505   cstp->n_expected = 0;
 506   cstp->expected = NULL;
 507   if ( lex_match (lexer, '/') )
 508     {
 509       if ( lex_match_id (lexer, "EXPECTED") )
 510         {
 511           lex_force_match (lexer, '=');
 512           if ( ! lex_match_id (lexer, "EQUAL") )
 513             {
 514               double f;
 515               int n;
 516               while ( lex_is_number (lexer) )
 517                 {
 518                   int i;
 519                   n = 1;
 520                   f = lex_number (lexer);
 521                   lex_get (lexer);
 522                   if ( lex_match (lexer, '*'))
 523                     {
 524                       n = f;
 525                       f = lex_number (lexer);
 526                       lex_get (lexer);
 527                     }
 528                   lex_match (lexer, ',');
 529
 530                   cstp->n_expected += n;
 531                   cstp->expected = pool_realloc (specs->pool,
 532                                                  cstp->expected,
 533                                                  sizeof (double) *
 534                                                  cstp->n_expected);
 535                   for ( i = cstp->n_expected - n ;
 536                         i < cstp->n_expected;
 537                         ++i )
 538                     cstp->expected[i] = f;
 539
 540                 }
 541             }
 542         }
 543       else
 544         lex_put_back (lexer, '/');
 545     }
 546
 547   if ( cstp->ranged && cstp->n_expected > 0 &&
 548        cstp->n_expected != cstp->hi - cstp->lo + 1 )
 549     {
 550       msg (ME,
 551           _("%d expected values were given, but the specified "
 552             "range (%d-%d) requires exactly %d values."),
 553           cstp->n_expected, cstp->lo, cstp->hi,
 554           cstp->hi - cstp->lo +1);
 555       return 0;
 556     }
 557
 558   specs->n_tests++;
 559   specs->test = pool_realloc (specs->pool,
 560                               specs->test,
 561                               sizeof (*specs->test) * specs->n_tests);
 562
 563   specs->test[specs->n_tests - 1] = nt;
 564
 565   return 1;
 566 }
 567
 568
 569 static int
 570 npar_binomial (struct lexer *lexer, struct dataset *ds,
 571                struct npar_specs *specs)
 572 {
 573   struct binomial_test *btp = pool_alloc (specs->pool, sizeof (*btp));
 574   struct one_sample_test *tp = &btp->parent;
 575   struct npar_test *nt = &tp->parent;
 576
 577   nt->execute = binomial_execute;
 578   nt->insert_variables = one_sample_insert_variables;
 579
 580   btp->category1 = btp->category2 = btp->cutpoint = SYSMIS;
 581
 582   btp->p = 0.5;
 583
 584   if ( lex_match (lexer, '(') )
 585     {
 586       if ( lex_force_num (lexer) )
 587         {
 588           btp->p = lex_number (lexer);
 589           lex_get (lexer);
 590           lex_force_match (lexer, ')');
 591         }
 592       else
 593         return 0;
 594     }
 595   else
 596     /* Kludge: q2c swallows the '=' so put it back here  */
 597      lex_put_back (lexer, '=');
 598
 599   if (lex_match (lexer, '=') )
 600     {
 601       if (parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 602                                       &tp->vars, &tp->n_vars,
 603                                       PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE) )
 604         {
 605           if (lex_match (lexer, '('))
 606             {
 607               lex_force_num (lexer);
 608               btp->category1 = lex_number (lexer);
 609               lex_get (lexer);
 610               if ( lex_match (lexer, ','))
 611                 {
 612                   if ( ! lex_force_num (lexer) ) return 2;
 613                   btp->category2 = lex_number (lexer);
 614                   lex_get (lexer);
 615                 }
 616               else
 617                 {
 618                   btp->cutpoint = btp->category1;
 619                 }
 620
 621               lex_force_match (lexer, ')');
 622             }
 623         }
 624       else
 625         return 2;
 626
 627     }
 628
 629   specs->n_tests++;
 630   specs->test = pool_realloc (specs->pool,
 631                               specs->test,
 632                               sizeof (*specs->test) * specs->n_tests);
 633
 634   specs->test[specs->n_tests - 1] = nt;
 635
 636   return 1;
 637 }
 638
 639
 640 static bool
 641 parse_two_sample_related_test (struct lexer *lexer,
 642                                     const struct dictionary *dict,
 643                                     struct two_sample_test *test_parameters,
 644                                     struct pool *pool
 645                                     );
 646
 647
 648 static bool
 649 parse_two_sample_related_test (struct lexer *lexer,
 650                                const struct dictionary *dict,
 651                                struct two_sample_test *test_parameters,
 652                                struct pool *pool
 653                                )
 654 {
 655   int n = 0;
 656   bool paired = false;
 657   bool with = false;
 658   const struct variable **vlist1;
 659   size_t n_vlist1;
 660
 661   const struct variable **vlist2;
 662   size_t n_vlist2;
 663
 664   test_parameters->parent.insert_variables = two_sample_insert_variables;
 665
 666   if (!parse_variables_const_pool (lexer, pool,
 667                                    dict,
 668                                    &vlist1, &n_vlist1,
 669                                    PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE) )
 670     return false;
 671
 672   if ( lex_match (lexer, T_WITH))
 673     {
 674       with = true;
 675       if ( !parse_variables_const_pool (lexer, pool, dict,
 676                                         &vlist2, &n_vlist2,
 677                                         PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE) )
 678         return false;
 679
 680       paired = (lex_match (lexer, '(') &&
 681                 lex_match_id (lexer, "PAIRED") && lex_match (lexer, ')'));
 682     }
 683
 684
 685   if ( with )
 686     {
 687       if (paired)
 688         {
 689           if ( n_vlist1 != n_vlist2)
 690             msg (SE, _("PAIRED was specified but the number of variables "
 691                        "preceding WITH (%zu) did not match the number "
 692                        "following (%zu)."), n_vlist1, n_vlist2);
 693
 694           test_parameters->n_pairs = n_vlist1 ;
 695         }
 696       else
 697         {
 698           test_parameters->n_pairs = n_vlist1 * n_vlist2;
 699         }
 700     }
 701   else
 702     {
 703       test_parameters->n_pairs = (n_vlist1 * (n_vlist1 - 1)) / 2 ;
 704     }
 705
 706   test_parameters->pairs =
 707     pool_alloc (pool, sizeof ( variable_pair) * test_parameters->n_pairs);
 708
 709   if ( with )
 710     {
 711       if (paired)
 712         {
 713           int i;
 714           assert (n_vlist1 == n_vlist2);
 715           for ( i = 0 ; i < n_vlist1; ++i )
 716             {
 717               test_parameters->pairs[n][1] = vlist1[i];
 718               test_parameters->pairs[n][0] = vlist2[i];
 719               n++;
 720             }
 721         }
 722       else
 723         {
 724           int i,j;
 725           for ( i = 0 ; i < n_vlist1; ++i )
 726             {
 727               for ( j = 0 ; j < n_vlist2; ++j )
 728                 {
 729                   test_parameters->pairs[n][1] = vlist1[i];
 730                   test_parameters->pairs[n][0] = vlist2[j];
 731                   n++;
 732                 }
 733             }
 734         }
 735     }
 736   else
 737     {
 738       int i,j;
 739       for ( i = 0 ; i < n_vlist1 - 1; ++i )
 740         {
 741           for ( j = i + 1 ; j < n_vlist1; ++j )
 742             {
 743               assert ( n < test_parameters->n_pairs);
 744               test_parameters->pairs[n][1] = vlist1[i];
 745               test_parameters->pairs[n][0] = vlist1[j];
 746               n++;
 747             }
 748         }
 749     }
 750
 751   assert ( n == test_parameters->n_pairs);
 752
 753   return true;
 754 }
 755
 756
 757 static bool
 758 parse_n_sample_related_test (struct lexer *lexer,
 759                              const struct dictionary *dict,
 760                              struct n_sample_test *nst,
 761                              struct pool *pool
 762                              )
 763 {
 764   if (!parse_variables_const_pool (lexer, pool,
 765                                    dict,
 766                                    &nst->vars, &nst->n_vars,
 767                                    PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE) )
 768     return false;
 769
 770   if ( ! lex_force_match (lexer, T_BY))
 771     return false;
 772
 773   nst->indep_var = parse_variable_const (lexer, dict);
 774
 775   if ( ! lex_force_match (lexer, '('))
 776     return false;
 777
 778   value_init (&nst->val1, var_get_width (nst->indep_var));
 779   if ( ! parse_value (lexer, &nst->val1, var_get_width (nst->indep_var)))
 780     {
 781       value_destroy (&nst->val1, var_get_width (nst->indep_var));
 782       return false;
 783     }
 784
 785   if ( ! lex_force_match (lexer, ','))
 786     return false;
 787
 788   value_init (&nst->val2, var_get_width (nst->indep_var));
 789   if ( ! parse_value (lexer, &nst->val2, var_get_width (nst->indep_var)))
 790     {
 791       value_destroy (&nst->val2, var_get_width (nst->indep_var));
 792       return false;
 793     }
 794
 795   if ( ! lex_force_match (lexer, ')'))
 796     return false;
 797
 798   return true;
 799 }
 800
 801 static int
 802 npar_wilcoxon (struct lexer *lexer,
 803                struct dataset *ds,
 804                struct npar_specs *specs )
 805 {
 806
 807
 808   struct two_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 809   struct npar_test *nt = &tp->parent;
 810   nt->execute = wilcoxon_execute;
 811
 812   if (!parse_two_sample_related_test (lexer, dataset_dict (ds),
 813                                       tp, specs->pool) )
 814     return 0;
 815
 816   specs->n_tests++;
 817   specs->test = pool_realloc (specs->pool,
 818                               specs->test,
 819                               sizeof (*specs->test) * specs->n_tests);
 820   specs->test[specs->n_tests - 1] = nt;
 821
 822   return 1;
 823 }
 824
 825 static int
 826 npar_sign (struct lexer *lexer, struct dataset *ds,
 827            struct npar_specs *specs)
 828 {
 829   struct two_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 830   struct npar_test *nt = &tp->parent;
 831
 832   nt->execute = sign_execute;
 833
 834   if (!parse_two_sample_related_test (lexer, dataset_dict (ds),
 835                                       tp, specs->pool) )
 836     return 0;
 837
 838   specs->n_tests++;
 839   specs->test = pool_realloc (specs->pool,
 840                               specs->test,
 841                               sizeof (*specs->test) * specs->n_tests);
 842   specs->test[specs->n_tests - 1] = nt;
 843
 844   return 1;
 845 }
 846
 847 static int
 848 npar_kruskal_wallis (struct lexer *lexer, struct dataset *ds,
 849                       struct npar_specs *specs)
 850 {
 851   struct n_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 852   struct npar_test *nt = &tp->parent;
 853
 854   nt->insert_variables = n_sample_insert_variables;
 855
 856   nt->execute = kruskal_wallis_execute;
 857
 858   if (!parse_n_sample_related_test (lexer, dataset_dict (ds),
 859                                       tp, specs->pool) )
 860     return 0;
 861
 862   specs->n_tests++;
 863   specs->test = pool_realloc (specs->pool,
 864                               specs->test,
 865                               sizeof (*specs->test) * specs->n_tests);
 866   specs->test[specs->n_tests - 1] = nt;
 867
 868   return 1;
 869 }
 870
 871 static void
 872 insert_variable_into_map (struct hmapx *var_map, const struct variable *var)
 873 {
 874   size_t hash = hash_pointer (var, 0);
 875   struct hmapx_node *node;
 876   const struct variable *v = NULL;
 877
 878   HMAPX_FOR_EACH_WITH_HASH (v, node, hash, var_map)
 879     {
 880       if ( v == var)
 881         return ;
 882     }
 883
 884   hmapx_insert (var_map, CONST_CAST (struct variable *, var), hash);
 885 }
 886
 887 /* Insert the variables for TEST into VAR_MAP */
 888 static void
 889 one_sample_insert_variables (const struct npar_test *test,
 890                              struct hmapx *var_map)
 891 {
 892   int i;
 893   const struct one_sample_test *ost = UP_CAST (test, const struct one_sample_test, parent);
 894
 895   for ( i = 0 ; i < ost->n_vars ; ++i )
 896     insert_variable_into_map (var_map, ost->vars[i]);
 897 }
 898
 899
 900 static void
 901 two_sample_insert_variables (const struct npar_test *test,
 902                              struct hmapx *var_map)
 903 {
 904   int i;
 905   const struct two_sample_test *tst = UP_CAST (test, const struct two_sample_test, parent);
 906
 907   for ( i = 0 ; i < tst->n_pairs ; ++i )
 908     {
 909       variable_pair *pair = &tst->pairs[i];
 910
 911       insert_variable_into_map (var_map, (*pair)[0]);
 912       insert_variable_into_map (var_map, (*pair)[1]);
 913     }
 914 }
 915
 916 static void
 917 n_sample_insert_variables (const struct npar_test *test,
 918                            struct hmapx *var_map)
 919 {
 920   int i;
 921   const struct n_sample_test *tst = UP_CAST (test, const struct n_sample_test, parent);
 922
 923   for ( i = 0 ; i < tst->n_vars ; ++i )
 924     insert_variable_into_map (var_map, tst->vars[i]);
 925
 926   insert_variable_into_map (var_map, tst->indep_var);
 927 }
 928
 929
 930 static int
 931 npar_method (struct lexer *lexer,  struct npar_specs *specs)
 932 {
 933   if ( lex_match_id (lexer, "EXACT") )
 934     {
 935       specs->exact = true;
 936       specs->timer = 0.0;
 937       if (lex_match_id (lexer, "TIMER"))
 938         {
 939           specs->timer = 5.0;
 940
 941           if ( lex_match (lexer, '('))
 942             {
 943               if ( lex_force_num (lexer) )
 944                 {
 945                   specs->timer = lex_number (lexer);
 946                   lex_get (lexer);
 947                 }
 948               lex_force_match (lexer, ')');
 949             }
 950         }
 951     }
 952
 953   return 1;
 954 }