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