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