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_phrase (lexer, ")="))
 427     return false;
 428
 429   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 430                                    &tp->vars, &tp->n_vars,
 431                                    PV_NO_SCRATCH | PV_NO_DUPLICATE | PV_NUMERIC))
 432     return false;
 433
 434   add_test (specs, nt);
 435   return true;
 436 }
 437
 438 static bool
 439 npar_friedman (struct lexer *lexer, struct dataset *ds,
 440                struct npar_specs *specs)
 441 {
 442   struct friedman_test *ft = pool_alloc (specs->pool, sizeof (*ft));
 443   struct one_sample_test *ost = &ft->parent;
 444   struct npar_test *nt = &ost->parent;
 445
 446   ft->kendalls_w = false;
 447   nt->execute = friedman_execute;
 448   nt->insert_variables = one_sample_insert_variables;
 449
 450   lex_match (lexer, T_EQUALS);
 451
 452   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 453                                    &ost->vars, &ost->n_vars,
 454                                    PV_NO_SCRATCH | PV_NO_DUPLICATE | PV_NUMERIC))
 455     return false;
 456
 457   add_test (specs, nt);
 458   return true;
 459 }
 460
 461 static bool
 462 npar_kendall (struct lexer *lexer, struct dataset *ds,
 463                struct npar_specs *specs)
 464 {
 465   struct friedman_test *kt = pool_alloc (specs->pool, sizeof (*kt));
 466   struct one_sample_test *ost = &kt->parent;
 467   struct npar_test *nt = &ost->parent;
 468
 469   kt->kendalls_w = true;
 470   nt->execute = friedman_execute;
 471   nt->insert_variables = one_sample_insert_variables;
 472
 473   lex_match (lexer, T_EQUALS);
 474
 475   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 476                                    &ost->vars, &ost->n_vars,
 477                                    PV_NO_SCRATCH | PV_NO_DUPLICATE | PV_NUMERIC))
 478     return false;
 479
 480   add_test (specs, nt);
 481   return true;
 482 }
 483
 484
 485 static bool
 486 npar_cochran (struct lexer *lexer, struct dataset *ds,
 487                struct npar_specs *specs)
 488 {
 489   struct one_sample_test *ft = pool_alloc (specs->pool, sizeof (*ft));
 490   struct npar_test *nt = &ft->parent;
 491
 492   nt->execute = cochran_execute;
 493   nt->insert_variables = one_sample_insert_variables;
 494
 495   lex_match (lexer, T_EQUALS);
 496
 497   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 498                                    &ft->vars, &ft->n_vars,
 499                                    PV_NO_SCRATCH | PV_NO_DUPLICATE | PV_NUMERIC))
 500     return false;
 501
 502   add_test (specs, nt);
 503   return true;
 504 }
 505
 506 static bool
 507 npar_chisquare (struct lexer *lexer, struct dataset *ds,
 508                 struct npar_specs *specs)
 509 {
 510   struct chisquare_test *cstp = pool_alloc (specs->pool, sizeof (*cstp));
 511   struct one_sample_test *tp = &cstp->parent;
 512   struct npar_test *nt = &tp->parent;
 513
 514   nt->execute = chisquare_execute;
 515   nt->insert_variables = one_sample_insert_variables;
 516
 517   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 518                                    &tp->vars, &tp->n_vars,
 519                                    PV_NO_SCRATCH | PV_NO_DUPLICATE))
 520     return false;
 521
 522   cstp->ranged = false;
 523
 524   if (lex_match (lexer, T_LPAREN))
 525     {
 526       cstp->ranged = true;
 527       if (!lex_force_num (lexer))
 528         return false;
 529       cstp->lo = lex_number (lexer);
 530       lex_get (lexer);
 531
 532       if (!lex_force_match (lexer, T_COMMA))
 533         return false;
 534       if (!lex_force_num_range_open (lexer, "HI", cstp->lo, DBL_MAX))
 535         return false;
 536       cstp->hi = lex_number (lexer);
 537       lex_get (lexer);
 538       if (!lex_force_match (lexer, T_RPAREN))
 539         return false;
 540     }
 541
 542   cstp->n_expected = 0;
 543   cstp->expected = NULL;
 544   int expected_start = 0;
 545   int expected_end = 0;
 546   if (lex_match_phrase (lexer, "/EXPECTED"))
 547     {
 548       if (!lex_force_match (lexer, T_EQUALS))
 549         return false;
 550
 551       if (!lex_match_id (lexer, "EQUAL"))
 552         {
 553           expected_start = lex_ofs (lexer);
 554           while (lex_is_number (lexer))
 555             {
 556               int n = 1;
 557               double f = lex_number (lexer);
 558               lex_get (lexer);
 559               if (lex_match (lexer, T_ASTERISK))
 560                 {
 561                   n = f;
 562                   if (!lex_force_num (lexer))
 563                     return false;
 564                   f = lex_number (lexer);
 565                   lex_get (lexer);
 566                 }
 567               lex_match (lexer, T_COMMA);
 568
 569               cstp->n_expected += n;
 570               cstp->expected = pool_realloc (specs->pool,
 571                                              cstp->expected,
 572                                              sizeof (double) * cstp->n_expected);
 573               for (int i = cstp->n_expected - n; i < cstp->n_expected; ++i)
 574                 cstp->expected[i] = f;
 575             }
 576           expected_end = lex_ofs (lexer) - 1;
 577         }
 578     }
 579
 580   if (cstp->ranged && cstp->n_expected > 0 &&
 581        cstp->n_expected != cstp->hi - cstp->lo + 1)
 582     {
 583       lex_ofs_error (lexer, expected_start, expected_end,
 584                      _("%d expected values were given, but the specified "
 585                        "range (%d-%d) requires exactly %d values."),
 586                      cstp->n_expected, cstp->lo, cstp->hi,
 587                      cstp->hi - cstp->lo +1);
 588       return false;
 589     }
 590
 591   add_test (specs, nt);
 592   return true;
 593 }
 594
 595 static bool
 596 npar_binomial (struct lexer *lexer, struct dataset *ds,
 597                struct npar_specs *specs)
 598 {
 599   struct binomial_test *btp = pool_alloc (specs->pool, sizeof (*btp));
 600   struct one_sample_test *tp = &btp->parent;
 601   struct npar_test *nt = &tp->parent;
 602
 603   nt->execute = binomial_execute;
 604   nt->insert_variables = one_sample_insert_variables;
 605
 606   btp->category1 = btp->category2 = btp->cutpoint = SYSMIS;
 607
 608   btp->p = 0.5;
 609
 610   if (lex_match (lexer, T_LPAREN))
 611     {
 612       if (!lex_force_num (lexer))
 613         return false;
 614       btp->p = lex_number (lexer);
 615       lex_get (lexer);
 616       if (!lex_force_match (lexer, T_RPAREN))
 617         return false;
 618       if (!lex_force_match (lexer, T_EQUALS))
 619         return false;
 620     }
 621
 622   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 623                                    &tp->vars, &tp->n_vars,
 624                                    PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE))
 625     return false;
 626   if (lex_match (lexer, T_LPAREN))
 627     {
 628       if (!lex_force_num (lexer))
 629         return false;
 630       btp->category1 = lex_number (lexer);
 631       lex_get (lexer);
 632       if (lex_match (lexer, T_COMMA))
 633         {
 634           if (!lex_force_num (lexer))
 635             return false;
 636           btp->category2 = lex_number (lexer);
 637           lex_get (lexer);
 638         }
 639       else
 640         btp->cutpoint = btp->category1;
 641
 642       if (!lex_force_match (lexer, T_RPAREN))
 643         return false;
 644     }
 645
 646   add_test (specs, nt);
 647   return true;
 648 }
 649
 650 static void
 651 ks_one_sample_parse_params (struct lexer *lexer, struct ks_one_sample_test *kst, int params)
 652 {
 653   assert (params == 1 || params == 2);
 654
 655   if (lex_is_number (lexer))
 656     {
 657       kst->p[0] = lex_number (lexer);
 658
 659       lex_get (lexer);
 660       if (params == 2)
 661         {
 662           lex_match (lexer, T_COMMA);
 663           if (lex_force_num (lexer))
 664             {
 665               kst->p[1] = lex_number (lexer);
 666               lex_get (lexer);
 667             }
 668         }
 669     }
 670 }
 671
 672 static bool
 673 npar_ks_one_sample (struct lexer *lexer, struct dataset *ds, struct npar_specs *specs)
 674 {
 675   struct ks_one_sample_test *kst = pool_alloc (specs->pool, sizeof (*kst));
 676   struct one_sample_test *tp = &kst->parent;
 677   struct npar_test *nt = &tp->parent;
 678
 679   nt->execute = ks_one_sample_execute;
 680   nt->insert_variables = one_sample_insert_variables;
 681
 682   kst->p[0] = kst->p[1] = SYSMIS;
 683
 684   if (!lex_force_match (lexer, T_LPAREN))
 685     return false;
 686
 687   if (lex_match_id (lexer, "NORMAL"))
 688     {
 689       kst->dist = KS_NORMAL;
 690       ks_one_sample_parse_params (lexer, kst, 2);
 691     }
 692   else if (lex_match_id (lexer, "POISSON"))
 693     {
 694       kst->dist = KS_POISSON;
 695       ks_one_sample_parse_params (lexer, kst, 1);
 696     }
 697   else if (lex_match_id (lexer, "UNIFORM"))
 698     {
 699       kst->dist = KS_UNIFORM;
 700       ks_one_sample_parse_params (lexer, kst, 2);
 701     }
 702   else if (lex_match_id (lexer, "EXPONENTIAL"))
 703     {
 704       kst->dist = KS_EXPONENTIAL;
 705       ks_one_sample_parse_params (lexer, kst, 1);
 706     }
 707   else
 708     {
 709       lex_error_expecting (lexer, "NORMAL", "POISSON", "UNIFORM",
 710                            "EXPONENTIAL");
 711       return false;
 712     }
 713
 714   if (!lex_force_match (lexer, T_RPAREN))
 715     return false;
 716
 717   lex_match (lexer, T_EQUALS);
 718
 719   if (!parse_variables_const_pool (lexer, specs->pool, dataset_dict (ds),
 720                                    &tp->vars, &tp->n_vars,
 721                                    PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE))
 722     return false;
 723
 724   add_test (specs, nt);
 725
 726   return true;
 727 }
 728
 729 static bool
 730 parse_two_sample_related_test (struct lexer *lexer,
 731                                const struct dictionary *dict,
 732                                struct two_sample_test *tp,
 733                                struct pool *pool)
 734 {
 735   tp->parent.insert_variables = two_sample_insert_variables;
 736
 737   const struct variable **v1;
 738   size_t n1;
 739   int vars_start = lex_ofs (lexer);
 740   if (!parse_variables_const_pool (lexer, pool, dict, &v1, &n1,
 741                                    PV_NUMERIC | PV_NO_SCRATCH | PV_DUPLICATE))
 742     return false;
 743
 744   bool with = false;
 745   bool paired = false;
 746   const struct variable **v2 = NULL;
 747   size_t n2 = 0;
 748   if (lex_match (lexer, T_WITH))
 749     {
 750       with = true;
 751       if (!parse_variables_const_pool (lexer, pool, dict, &v2, &n2,
 752                                        PV_NUMERIC | PV_NO_SCRATCH | PV_DUPLICATE))
 753         return false;
 754       int vars_end = lex_ofs (lexer) - 1;
 755
 756       if (lex_match (lexer, T_LPAREN))
 757         {
 758           if (!lex_force_match_phrase (lexer, "PAIRED)"))
 759             return false;
 760           paired = true;
 761
 762           if (n1 != n2)
 763             {
 764               lex_ofs_error (lexer, vars_start, vars_end,
 765                              _("PAIRED was specified, but the number of "
 766                                "variables preceding WITH (%zu) does not match "
 767                                "the number following (%zu)."),
 768                              n1, n2);
 769               return false;
 770             }
 771         }
 772     }
 773
 774   tp->n_pairs = (paired ? n1
 775                  : with ? n1 * n2
 776                  : (n1 * (n1 - 1)) / 2);
 777   tp->pairs = pool_alloc (pool, sizeof (variable_pair) * tp->n_pairs);
 778
 779   size_t n = 0;
 780   if (!with)
 781     for (size_t i = 0; i < n1 - 1; ++i)
 782       for (size_t j = i + 1; j < n1; ++j)
 783         {
 784           assert (n < tp->n_pairs);
 785           tp->pairs[n][0] = v1[i];
 786           tp->pairs[n][1] = v1[j];
 787           n++;
 788         }
 789   else if (paired)
 790     {
 791       assert (n1 == n2);
 792       for (size_t i = 0; i < n1; ++i)
 793         {
 794           tp->pairs[n][0] = v1[i];
 795           tp->pairs[n][1] = v2[i];
 796           n++;
 797         }
 798     }
 799   else
 800     {
 801       for (size_t i = 0; i < n1; ++i)
 802         for (size_t j = 0; j < n2; ++j)
 803           {
 804             tp->pairs[n][0] = v1[i];
 805             tp->pairs[n][1] = v2[j];
 806             n++;
 807           }
 808     }
 809   assert (n == tp->n_pairs);
 810
 811   return true;
 812 }
 813
 814 static bool
 815 parse_n_sample_related_test (struct lexer *lexer, const struct dictionary *dict,
 816                              struct n_sample_test *nst, struct pool *pool)
 817 {
 818   if (!parse_variables_const_pool (lexer, pool, dict, &nst->vars, &nst->n_vars,
 819                                    PV_NUMERIC | PV_NO_SCRATCH | PV_NO_DUPLICATE))
 820     return false;
 821
 822   if (!lex_force_match (lexer, T_BY))
 823     return false;
 824
 825   nst->indep_var = parse_variable_const (lexer, dict);
 826   if (!nst->indep_var)
 827     return false;
 828
 829   if (!lex_force_match (lexer, T_LPAREN))
 830     return false;
 831
 832   value_init (&nst->val1, var_get_width (nst->indep_var));
 833   if (!parse_value (lexer, &nst->val1, nst->indep_var))
 834     {
 835       value_destroy (&nst->val1, var_get_width (nst->indep_var));
 836       return false;
 837     }
 838
 839   lex_match (lexer, T_COMMA);
 840
 841   value_init (&nst->val2, var_get_width (nst->indep_var));
 842   if (!parse_value (lexer, &nst->val2, nst->indep_var))
 843     {
 844       value_destroy (&nst->val2, var_get_width (nst->indep_var));
 845       return false;
 846     }
 847
 848   if (!lex_force_match (lexer, T_RPAREN))
 849     return false;
 850
 851   return true;
 852 }
 853
 854 static bool
 855 npar_wilcoxon (struct lexer *lexer,
 856                struct dataset *ds,
 857                struct npar_specs *specs)
 858 {
 859   struct two_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 860   struct npar_test *nt = &tp->parent;
 861   nt->execute = wilcoxon_execute;
 862
 863   if (!parse_two_sample_related_test (lexer, dataset_dict (ds),
 864                                       tp, specs->pool))
 865     return false;
 866
 867   add_test (specs, nt);
 868   return true;
 869 }
 870
 871 static bool
 872 npar_mann_whitney (struct lexer *lexer,
 873                    struct dataset *ds,
 874                    struct npar_specs *specs)
 875 {
 876   struct n_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 877   struct npar_test *nt = &tp->parent;
 878
 879   nt->insert_variables = n_sample_insert_variables;
 880   nt->execute = mann_whitney_execute;
 881
 882   if (!parse_n_sample_related_test (lexer, dataset_dict (ds), tp, specs->pool))
 883     return false;
 884
 885   add_test (specs, nt);
 886   return true;
 887 }
 888
 889 static bool
 890 npar_median (struct lexer *lexer,
 891              struct dataset *ds,
 892              struct npar_specs *specs)
 893 {
 894   struct median_test *mt = pool_alloc (specs->pool, sizeof (*mt));
 895   struct n_sample_test *tp = &mt->parent;
 896   struct npar_test *nt = &tp->parent;
 897
 898   mt->median = SYSMIS;
 899
 900   if (lex_match (lexer, T_LPAREN))
 901     {
 902       if (!lex_force_num (lexer))
 903         return false;
 904       mt->median = lex_number (lexer);
 905       lex_get (lexer);
 906
 907       if (!lex_force_match (lexer, T_RPAREN))
 908         return false;
 909     }
 910
 911   lex_match (lexer, T_EQUALS);
 912
 913   nt->insert_variables = n_sample_insert_variables;
 914   nt->execute = median_execute;
 915
 916   if (!parse_n_sample_related_test (lexer, dataset_dict (ds), tp, specs->pool))
 917     return false;
 918
 919   add_test (specs, nt);
 920   return true;
 921 }
 922
 923 static bool
 924 npar_sign (struct lexer *lexer, struct dataset *ds,
 925            struct npar_specs *specs)
 926 {
 927   struct two_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 928   struct npar_test *nt = &tp->parent;
 929
 930   nt->execute = sign_execute;
 931
 932   if (!parse_two_sample_related_test (lexer, dataset_dict (ds),
 933                                       tp, specs->pool))
 934     return false;
 935
 936   add_test (specs, nt);
 937   return true;
 938 }
 939
 940 static bool
 941 npar_mcnemar (struct lexer *lexer, struct dataset *ds,
 942            struct npar_specs *specs)
 943 {
 944   struct two_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 945   struct npar_test *nt = &tp->parent;
 946
 947   nt->execute = mcnemar_execute;
 948
 949   if (!parse_two_sample_related_test (lexer, dataset_dict (ds),
 950                                       tp, specs->pool))
 951     return false;
 952
 953   add_test (specs, nt);
 954   return true;
 955 }
 956
 957
 958 static bool
 959 npar_jonckheere_terpstra (struct lexer *lexer, struct dataset *ds,
 960                       struct npar_specs *specs)
 961 {
 962   struct n_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 963   struct npar_test *nt = &tp->parent;
 964
 965   nt->insert_variables = n_sample_insert_variables;
 966   nt->execute = jonckheere_terpstra_execute;
 967
 968   if (!parse_n_sample_related_test (lexer, dataset_dict (ds), tp, specs->pool))
 969     return false;
 970
 971   add_test (specs, nt);
 972   return true;
 973 }
 974
 975 static bool
 976 npar_kruskal_wallis (struct lexer *lexer, struct dataset *ds,
 977                       struct npar_specs *specs)
 978 {
 979   struct n_sample_test *tp = pool_alloc (specs->pool, sizeof (*tp));
 980   struct npar_test *nt = &tp->parent;
 981
 982   nt->insert_variables = n_sample_insert_variables;
 983
 984   nt->execute = kruskal_wallis_execute;
 985
 986   if (!parse_n_sample_related_test (lexer, dataset_dict (ds), tp, specs->pool))
 987     return false;
 988
 989   add_test (specs, nt);
 990   return true;
 991 }
 992
 993 static void
 994 insert_variable_into_map (struct hmapx *var_map, const struct variable *var)
 995 {
 996   size_t hash = hash_pointer (var, 0);
 997   struct hmapx_node *node;
 998   const struct variable *v = NULL;
 999
1000   HMAPX_FOR_EACH_WITH_HASH (v, node, hash, var_map)
1001     if (v == var)
1002       return;
1003
1004   hmapx_insert (var_map, CONST_CAST (struct variable *, var), hash);
1005 }
1006
1007 /* Insert the variables for TEST into VAR_MAP */
1008 static void
1009 one_sample_insert_variables (const struct npar_test *test,
1010                              struct hmapx *var_map)
1011 {
1012   const struct one_sample_test *ost = UP_CAST (test, const struct one_sample_test, parent);
1013
1014   for (size_t i = 0; i < ost->n_vars; ++i)
1015     insert_variable_into_map (var_map, ost->vars[i]);
1016 }
1017
1018
1019 static void
1020 two_sample_insert_variables (const struct npar_test *test,
1021                              struct hmapx *var_map)
1022 {
1023   const struct two_sample_test *tst = UP_CAST (test, const struct two_sample_test, parent);
1024
1025   for (size_t i = 0; i < tst->n_pairs; ++i)
1026     {
1027       variable_pair *pair = &tst->pairs[i];
1028
1029       insert_variable_into_map (var_map, (*pair)[0]);
1030       insert_variable_into_map (var_map, (*pair)[1]);
1031     }
1032 }
1033
1034 static void
1035 n_sample_insert_variables (const struct npar_test *test,
1036                            struct hmapx *var_map)
1037 {
1038   const struct n_sample_test *tst = UP_CAST (test, const struct n_sample_test, parent);
1039
1040   for (size_t i = 0; i < tst->n_vars; ++i)
1041     insert_variable_into_map (var_map, tst->vars[i]);
1042
1043   insert_variable_into_map (var_map, tst->indep_var);
1044 }
1045
1046 static bool
1047 npar_method (struct lexer *lexer,  struct npar_specs *specs)
1048 {
1049   if (lex_match_id (lexer, "EXACT"))
1050     {
1051       specs->exact = true;
1052       specs->timer = 0.0;
1053       if (lex_match_id (lexer, "TIMER"))
1054         {
1055           specs->timer = 5.0;
1056
1057           if (lex_match (lexer, T_LPAREN))
1058             {
1059               if (!lex_force_num (lexer))
1060                 return false;
1061               specs->timer = lex_number (lexer);
1062               lex_get (lexer);
1063               if (!lex_force_match (lexer, T_RPAREN))
1064                 return false;
1065             }
1066         }
1067     }
1068
1069   return true;
1070 }