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

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