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