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