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