c2f34c2df213d6a19866edbf87a8e8cf387fe7e4
[pspp] / src / language / stats / crosstabs.q
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2009, 2010, 2011, 2012, 2013, 2014, 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 /* FIXME:
18
19    - How to calculate significance of some symmetric and directional measures?
20    - How to calculate ASE for symmetric Somers ' d?
21    - How to calculate ASE for Goodman and Kruskal's tau?
22    - How to calculate approx. T of symmetric uncertainty coefficient?
23
24 */
25
26 #include <config.h>
27
28 #include <ctype.h>
29 #include <float.h>
30 #include <gsl/gsl_cdf.h>
31 #include <stdlib.h>
32 #include <stdio.h>
33
34 #include "data/case.h"
35 #include "data/casegrouper.h"
36 #include "data/casereader.h"
37 #include "data/data-out.h"
38 #include "data/dataset.h"
39 #include "data/dictionary.h"
40 #include "data/format.h"
41 #include "data/value-labels.h"
42 #include "data/variable.h"
43 #include "language/command.h"
44 #include "language/stats/freq.h"
45 #include "language/dictionary/split-file.h"
46 #include "language/lexer/lexer.h"
47 #include "language/lexer/variable-parser.h"
48 #include "libpspp/array.h"
49 #include "libpspp/assertion.h"
50 #include "libpspp/compiler.h"
51 #include "libpspp/hash-functions.h"
52 #include "libpspp/hmap.h"
53 #include "libpspp/hmapx.h"
54 #include "libpspp/message.h"
55 #include "libpspp/misc.h"
56 #include "libpspp/pool.h"
57 #include "libpspp/str.h"
58 #include "output/tab.h"
59 #include "output/chart-item.h"
60 #include "output/charts/barchart.h"
61
62 #include "gl/minmax.h"
63 #include "gl/xalloc.h"
64 #include "gl/xsize.h"
65
66 #include "gettext.h"
67 #define _(msgid) gettext (msgid)
68 #define N_(msgid) msgid
69
70 /* (headers) */
71
72 /* (specification)
73    crosstabs (crs_):
74      *^tables=custom;
75      +variables=custom;
76      missing=miss:!table/include/report;
77      count=roundwhat:asis/case/!cell,
78            roundhow:!round/truncate;
79      +write[wr_]=none,cells,all;
80      +format=val:!avalue/dvalue,
81              indx:!noindex/index,
82              tabl:!tables/notables,
83              box:!box/nobox,
84              pivot:!pivot/nopivot;
85      +barchart=;
86      +cells[cl_]=count,expected,row,column,total,residual,sresidual,
87                  asresidual,all,none;
88      +statistics[st_]=chisq,phi,cc,lambda,uc,none,btau,ctau,risk,gamma,d,
89                       kappa,eta,corr,all.
90 */
91 /* (declarations) */
92 /* (functions) */
93
94 /* Number of chi-square statistics. */
95 #define N_CHISQ 5
96
97 /* Number of symmetric statistics. */
98 #define N_SYMMETRIC 9
99
100 /* Number of directional statistics. */
101 #define N_DIRECTIONAL 13
102
103
104 /* Indexes into the 'vars' member of struct pivot_table and
105    struct crosstab member. */
106 enum
107   {
108     ROW_VAR = 0,                /* Row variable. */
109     COL_VAR = 1                 /* Column variable. */
110     /* Higher indexes cause multiple tables to be output. */
111   };
112
113 /* A crosstabulation of 2 or more variables. */
114 struct pivot_table
115   {
116     struct crosstabs_proc *proc;
117     struct fmt_spec weight_format; /* Format for weight variable. */
118     double missing;             /* Weight of missing cases. */
119
120     /* Variables (2 or more). */
121     int n_vars;
122     const struct variable **vars;
123
124     /* Constants (0 or more). */
125     int n_consts;
126     const struct variable **const_vars;
127     union value *const_values;
128
129     /* Data. */
130     struct hmap data;
131     struct freq **entries;
132     size_t n_entries;
133
134     /* Column values, number of columns. */
135     union value *cols;
136     int n_cols;
137
138     /* Row values, number of rows. */
139     union value *rows;
140     int n_rows;
141
142     /* Number of statistically interesting columns/rows
143        (columns/rows with data in them). */
144     int ns_cols, ns_rows;
145
146     /* Matrix contents. */
147     double *mat;                /* Matrix proper. */
148     double *row_tot;            /* Row totals. */
149     double *col_tot;            /* Column totals. */
150     double total;               /* Grand total. */
151   };
152
153 /* Integer mode variable info. */
154 struct var_range
155   {
156     struct hmap_node hmap_node; /* In struct crosstabs_proc var_ranges map. */
157     const struct variable *var; /* The variable. */
158     int min;                    /* Minimum value. */
159     int max;                    /* Maximum value + 1. */
160     int count;                  /* max - min. */
161   };
162
163 struct crosstabs_proc
164   {
165     const struct dictionary *dict;
166     enum { INTEGER, GENERAL } mode;
167     enum mv_class exclude;
168     bool pivot;
169     bool barchart;
170     bool bad_warn;
171     struct fmt_spec weight_format;
172
173     /* Variables specifies on VARIABLES. */
174     const struct variable **variables;
175     size_t n_variables;
176     struct hmap var_ranges;
177
178     /* TABLES. */
179     struct pivot_table *pivots;
180     int n_pivots;
181
182     /* CELLS. */
183     int n_cells;                /* Number of cells requested. */
184     unsigned int cells;         /* Bit k is 1 if cell k is requested. */
185     int a_cells[CRS_CL_count];  /* 0...n_cells-1 are the requested cells. */
186
187     /* Rounding of cells. */
188     bool round_case_weights;    /* Round case weights? */
189     bool round_cells;           /* If !round_case_weights, round cells? */
190     bool round_down;            /* Round down? (otherwise to nearest) */
191
192     /* STATISTICS. */
193     unsigned int statistics;    /* Bit k is 1 if statistic k is requested. */
194
195     bool descending;            /* True if descending sort order is requested. */
196   };
197
198 const struct var_range *get_var_range (const struct crosstabs_proc *,
199                                        const struct variable *);
200
201 static bool should_tabulate_case (const struct pivot_table *,
202                                   const struct ccase *, enum mv_class exclude);
203 static void tabulate_general_case (struct pivot_table *, const struct ccase *,
204                                    double weight);
205 static void tabulate_integer_case (struct pivot_table *, const struct ccase *,
206                                    double weight);
207 static void postcalc (struct crosstabs_proc *);
208 static void submit (struct pivot_table *, struct tab_table *);
209
210 static double
211 round_weight (const struct crosstabs_proc *proc, double weight)
212 {
213   return proc->round_down ? floor (weight) : floor (weight + 0.5);
214 }
215
216 /* Parses and executes the CROSSTABS procedure. */
217 int
218 cmd_crosstabs (struct lexer *lexer, struct dataset *ds)
219 {
220   const struct variable *wv = dict_get_weight (dataset_dict (ds));
221   struct var_range *range, *next_range;
222   struct crosstabs_proc proc;
223   struct casegrouper *grouper;
224   struct casereader *input, *group;
225   struct cmd_crosstabs cmd;
226   struct pivot_table *pt;
227   int result;
228   bool ok;
229   int i;
230
231   proc.dict = dataset_dict (ds);
232   proc.bad_warn = true;
233   proc.variables = NULL;
234   proc.n_variables = 0;
235   hmap_init (&proc.var_ranges);
236   proc.pivots = NULL;
237   proc.n_pivots = 0;
238   proc.descending = false;
239   proc.weight_format = wv ? *var_get_print_format (wv) : F_8_0;
240
241   if (!parse_crosstabs (lexer, ds, &cmd, &proc))
242     {
243       result = CMD_FAILURE;
244       goto exit;
245     }
246
247   proc.mode = proc.n_variables ? INTEGER : GENERAL;
248   proc.barchart = cmd.sbc_barchart > 0;
249
250   proc.descending = cmd.val == CRS_DVALUE;
251
252   proc.round_case_weights = cmd.sbc_count && cmd.roundwhat == CRS_CASE;
253   proc.round_cells = cmd.sbc_count && cmd.roundwhat == CRS_CELL;
254   proc.round_down = cmd.roundhow == CRS_TRUNCATE;
255
256   /* CELLS. */
257   if (!cmd.sbc_cells)
258     proc.cells = 1u << CRS_CL_COUNT;
259   else if (cmd.a_cells[CRS_CL_ALL])
260     proc.cells = UINT_MAX;
261   else
262     {
263       proc.cells = 0;
264       for (i = 0; i < CRS_CL_count; i++)
265         if (cmd.a_cells[i])
266           proc.cells |= 1u << i;
267       if (proc.cells == 0)
268         proc.cells = ((1u << CRS_CL_COUNT)
269                        | (1u << CRS_CL_ROW)
270                        | (1u << CRS_CL_COLUMN)
271                        | (1u << CRS_CL_TOTAL));
272     }
273   proc.cells &= ((1u << CRS_CL_count) - 1);
274   proc.cells &= ~((1u << CRS_CL_NONE) | (1u << CRS_CL_ALL));
275   proc.n_cells = 0;
276   for (i = 0; i < CRS_CL_count; i++)
277     if (proc.cells & (1u << i))
278       proc.a_cells[proc.n_cells++] = i;
279
280   /* STATISTICS. */
281   if (cmd.a_statistics[CRS_ST_ALL])
282     proc.statistics = UINT_MAX;
283   else if (cmd.sbc_statistics)
284     {
285       int i;
286
287       proc.statistics = 0;
288       for (i = 0; i < CRS_ST_count; i++)
289         if (cmd.a_statistics[i])
290           proc.statistics |= 1u << i;
291       if (proc.statistics == 0)
292         proc.statistics |= 1u << CRS_ST_CHISQ;
293     }
294   else
295     proc.statistics = 0;
296
297   /* MISSING. */
298   proc.exclude = (cmd.miss == CRS_TABLE ? MV_ANY
299                    : cmd.miss == CRS_INCLUDE ? MV_SYSTEM
300                    : MV_NEVER);
301   if (proc.mode == GENERAL && proc.exclude == MV_NEVER)
302     {
303       msg (SE, _("Missing mode %s not allowed in general mode.  "
304                  "Assuming %s."), "REPORT", "MISSING=TABLE");
305       proc.exclude = MV_ANY;
306     }
307
308   /* PIVOT. */
309   proc.pivot = cmd.pivot == CRS_PIVOT;
310
311   input = casereader_create_filter_weight (proc_open (ds), dataset_dict (ds),
312                                            NULL, NULL);
313   grouper = casegrouper_create_splits (input, dataset_dict (ds));
314   while (casegrouper_get_next_group (grouper, &group))
315     {
316       struct ccase *c;
317
318       /* Output SPLIT FILE variables. */
319       c = casereader_peek (group, 0);
320       if (c != NULL)
321         {
322           output_split_file_values (ds, c);
323           case_unref (c);
324         }
325
326       /* Initialize hash tables. */
327       for (pt = &proc.pivots[0]; pt < &proc.pivots[proc.n_pivots]; pt++)
328         hmap_init (&pt->data);
329
330       /* Tabulate. */
331       for (; (c = casereader_read (group)) != NULL; case_unref (c))
332         for (pt = &proc.pivots[0]; pt < &proc.pivots[proc.n_pivots]; pt++)
333           {
334             double weight = dict_get_case_weight (dataset_dict (ds), c,
335                                                   &proc.bad_warn);
336             if (cmd.roundwhat == CRS_CASE)
337               {
338                 weight = round_weight (&proc, weight);
339                 if (weight == 0.)
340                   continue;
341               }
342             if (should_tabulate_case (pt, c, proc.exclude))
343               {
344                 if (proc.mode == GENERAL)
345                   tabulate_general_case (pt, c, weight);
346                 else
347                   tabulate_integer_case (pt, c, weight);
348               }
349             else
350               pt->missing += weight;
351           }
352       casereader_destroy (group);
353
354       /* Output. */
355       postcalc (&proc);
356     }
357   ok = casegrouper_destroy (grouper);
358   ok = proc_commit (ds) && ok;
359
360   result = ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
361
362 exit:
363   free (proc.variables);
364   HMAP_FOR_EACH_SAFE (range, next_range, struct var_range, hmap_node,
365                       &proc.var_ranges)
366     {
367       hmap_delete (&proc.var_ranges, &range->hmap_node);
368       free (range);
369     }
370   for (pt = &proc.pivots[0]; pt < &proc.pivots[proc.n_pivots]; pt++)
371     {
372       free (pt->vars);
373       free (pt->const_vars);
374       /* We must not call value_destroy on const_values because
375          it is a wild pointer; it never pointed to anything owned
376          by the pivot_table.
377
378          The rest of the data was allocated and destroyed at a
379          lower level already. */
380     }
381   free (proc.pivots);
382
383   return result;
384 }
385
386 /* Parses the TABLES subcommand. */
387 static int
388 crs_custom_tables (struct lexer *lexer, struct dataset *ds,
389                    struct cmd_crosstabs *cmd UNUSED, void *proc_)
390 {
391   struct crosstabs_proc *proc = proc_;
392   struct const_var_set *var_set;
393   int n_by;
394   const struct variable ***by = NULL;
395   int *by_iter;
396   size_t *by_nvar = NULL;
397   size_t nx = 1;
398   bool ok = false;
399   int i;
400
401   /* Ensure that this is a TABLES subcommand. */
402   if (!lex_match_id (lexer, "TABLES")
403       && (lex_token (lexer) != T_ID ||
404           dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) == NULL)
405       && lex_token (lexer) != T_ALL)
406     return 2;
407   lex_match (lexer, T_EQUALS);
408
409   if (proc->variables != NULL)
410     var_set = const_var_set_create_from_array (proc->variables,
411                                                proc->n_variables);
412   else
413     var_set = const_var_set_create_from_dict (dataset_dict (ds));
414   assert (var_set != NULL);
415
416   for (n_by = 0; ;)
417     {
418       by = xnrealloc (by, n_by + 1, sizeof *by);
419       by_nvar = xnrealloc (by_nvar, n_by + 1, sizeof *by_nvar);
420       if (!parse_const_var_set_vars (lexer, var_set, &by[n_by], &by_nvar[n_by],
421                                      PV_NO_DUPLICATE | PV_NO_SCRATCH))
422         goto done;
423       if (xalloc_oversized (nx, by_nvar[n_by]))
424         {
425           msg (SE, _("Too many cross-tabulation variables or dimensions."));
426           goto done;
427         }
428       nx *= by_nvar[n_by];
429       n_by++;
430
431       if (!lex_match (lexer, T_BY))
432         {
433           if (n_by < 2)
434             goto done;
435           else
436             break;
437         }
438     }
439
440   by_iter = xcalloc (n_by, sizeof *by_iter);
441   proc->pivots = xnrealloc (proc->pivots,
442                             proc->n_pivots + nx, sizeof *proc->pivots);
443   for (i = 0; i < nx; i++)
444     {
445       struct pivot_table *pt = &proc->pivots[proc->n_pivots++];
446       int j;
447
448       pt->proc = proc;
449       pt->weight_format = proc->weight_format;
450       pt->missing = 0.;
451       pt->n_vars = n_by;
452       pt->vars = xmalloc (n_by * sizeof *pt->vars);
453       pt->n_consts = 0;
454       pt->const_vars = NULL;
455       pt->const_values = NULL;
456
457       for (j = 0; j < n_by; j++)
458         pt->vars[j] = by[j][by_iter[j]];
459
460       for (j = n_by - 1; j >= 0; j--)
461         {
462           if (++by_iter[j] < by_nvar[j])
463             break;
464           by_iter[j] = 0;
465         }
466     }
467   free (by_iter);
468   ok = true;
469
470 done:
471   /* All return paths lead here. */
472   for (i = 0; i < n_by; i++)
473     free (by[i]);
474   free (by);
475   free (by_nvar);
476
477   const_var_set_destroy (var_set);
478
479   return ok;
480 }
481
482 /* Parses the VARIABLES subcommand. */
483 static int
484 crs_custom_variables (struct lexer *lexer, struct dataset *ds,
485                       struct cmd_crosstabs *cmd UNUSED, void *proc_)
486 {
487   struct crosstabs_proc *proc = proc_;
488   if (proc->n_pivots)
489     {
490       msg (SE, _("%s must be specified before %s."), "VARIABLES", "TABLES");
491       return 0;
492     }
493
494   lex_match (lexer, T_EQUALS);
495
496   for (;;)
497     {
498       size_t orig_nv = proc->n_variables;
499       size_t i;
500
501       long min, max;
502
503       if (!parse_variables_const (lexer, dataset_dict (ds),
504                                   &proc->variables, &proc->n_variables,
505                                   (PV_APPEND | PV_NUMERIC
506                                    | PV_NO_DUPLICATE | PV_NO_SCRATCH)))
507         return 0;
508
509       if (!lex_force_match (lexer, T_LPAREN))
510           goto lossage;
511
512       if (!lex_force_int (lexer))
513         goto lossage;
514       min = lex_integer (lexer);
515       lex_get (lexer);
516
517       lex_match (lexer, T_COMMA);
518
519       if (!lex_force_int (lexer))
520         goto lossage;
521       max = lex_integer (lexer);
522       if (max < min)
523         {
524           msg (SE, _("Maximum value (%ld) less than minimum value (%ld)."),
525                max, min);
526           goto lossage;
527         }
528       lex_get (lexer);
529
530       if (!lex_force_match (lexer, T_RPAREN))
531         goto lossage;
532
533       for (i = orig_nv; i < proc->n_variables; i++)
534         {
535           const struct variable *var = proc->variables[i];
536           struct var_range *vr = xmalloc (sizeof *vr);
537
538           vr->var = var;
539           vr->min = min;
540           vr->max = max;
541           vr->count = max - min + 1;
542           hmap_insert (&proc->var_ranges, &vr->hmap_node,
543                        hash_pointer (var, 0));
544         }
545
546       if (lex_token (lexer) == T_SLASH)
547         break;
548     }
549
550   return 1;
551
552  lossage:
553   free (proc->variables);
554   proc->variables = NULL;
555   proc->n_variables = 0;
556   return 0;
557 }
558 \f
559 /* Data file processing. */
560
561 const struct var_range *
562 get_var_range (const struct crosstabs_proc *proc, const struct variable *var)
563 {
564   if (!hmap_is_empty (&proc->var_ranges))
565     {
566       const struct var_range *range;
567
568       HMAP_FOR_EACH_IN_BUCKET (range, struct var_range, hmap_node,
569                                hash_pointer (var, 0), &proc->var_ranges)
570         if (range->var == var)
571           return range;
572     }
573
574   return NULL;
575 }
576
577 static bool
578 should_tabulate_case (const struct pivot_table *pt, const struct ccase *c,
579                       enum mv_class exclude)
580 {
581   int j;
582   for (j = 0; j < pt->n_vars; j++)
583     {
584       const struct variable *var = pt->vars[j];
585       const struct var_range *range = get_var_range (pt->proc, var);
586
587       if (var_is_value_missing (var, case_data (c, var), exclude))
588         return false;
589
590       if (range != NULL)
591         {
592           double num = case_num (c, var);
593           if (num < range->min || num >= range->max + 1.)
594             return false;
595         }
596     }
597   return true;
598 }
599
600 static void
601 tabulate_integer_case (struct pivot_table *pt, const struct ccase *c,
602                        double weight)
603 {
604   struct freq *te;
605   size_t hash;
606   int j;
607
608   hash = 0;
609   for (j = 0; j < pt->n_vars; j++)
610     {
611       /* Throw away fractional parts of values. */
612       hash = hash_int (case_num (c, pt->vars[j]), hash);
613     }
614
615   HMAP_FOR_EACH_WITH_HASH (te, struct freq, node, hash, &pt->data)
616     {
617       for (j = 0; j < pt->n_vars; j++)
618         if ((int) case_num (c, pt->vars[j]) != (int) te->values[j].f)
619           goto no_match;
620
621       /* Found an existing entry. */
622       te->count += weight;
623       return;
624
625     no_match: ;
626     }
627
628   /* No existing entry.  Create a new one. */
629   te = xmalloc (table_entry_size (pt->n_vars));
630   te->count = weight;
631   for (j = 0; j < pt->n_vars; j++)
632     te->values[j].f = (int) case_num (c, pt->vars[j]);
633   hmap_insert (&pt->data, &te->node, hash);
634 }
635
636 static void
637 tabulate_general_case (struct pivot_table *pt, const struct ccase *c,
638                        double weight)
639 {
640   struct freq *te;
641   size_t hash;
642   int j;
643
644   hash = 0;
645   for (j = 0; j < pt->n_vars; j++)
646     {
647       const struct variable *var = pt->vars[j];
648       hash = value_hash (case_data (c, var), var_get_width (var), hash);
649     }
650
651   HMAP_FOR_EACH_WITH_HASH (te, struct freq, node, hash, &pt->data)
652     {
653       for (j = 0; j < pt->n_vars; j++)
654         {
655           const struct variable *var = pt->vars[j];
656           if (!value_equal (case_data (c, var), &te->values[j],
657                             var_get_width (var)))
658             goto no_match;
659         }
660
661       /* Found an existing entry. */
662       te->count += weight;
663       return;
664
665     no_match: ;
666     }
667
668   /* No existing entry.  Create a new one. */
669   te = xmalloc (table_entry_size (pt->n_vars));
670   te->count = weight;
671   for (j = 0; j < pt->n_vars; j++)
672     {
673       const struct variable *var = pt->vars[j];
674       value_clone (&te->values[j], case_data (c, var), var_get_width (var));
675     }
676   hmap_insert (&pt->data, &te->node, hash);
677 }
678 \f
679 /* Post-data reading calculations. */
680
681 static int compare_table_entry_vars_3way (const struct freq *a,
682                                           const struct freq *b,
683                                           const struct pivot_table *pt,
684                                           int idx0, int idx1);
685 static int compare_table_entry_3way (const void *ap_, const void *bp_,
686                                      const void *pt_);
687 static int compare_table_entry_3way_inv (const void *ap_, const void *bp_,
688                                      const void *pt_);
689
690 static void enum_var_values (const struct pivot_table *, int var_idx,
691                              union value **valuesp, int *n_values, bool descending);
692 static void output_pivot_table (struct crosstabs_proc *,
693                                 struct pivot_table *);
694 static void make_pivot_table_subset (struct pivot_table *pt,
695                                      size_t row0, size_t row1,
696                                      struct pivot_table *subset);
697 static void make_summary_table (struct crosstabs_proc *);
698 static bool find_crosstab (struct pivot_table *, size_t *row0p, size_t *row1p);
699
700 static void
701 postcalc (struct crosstabs_proc *proc)
702 {
703
704   /* Round hash table entries, if requested
705
706      If this causes any of the cell counts to fall to zero, delete those
707      cells. */
708   if (proc->round_cells)
709     for (struct pivot_table *pt = proc->pivots;
710          pt < &proc->pivots[proc->n_pivots]; pt++)
711       {
712         struct freq *e, *next;
713         HMAP_FOR_EACH_SAFE (e, next, struct freq, node, &pt->data)
714           {
715             e->count = round_weight (proc, e->count);
716             if (e->count == 0.0)
717               {
718                 hmap_delete (&pt->data, &e->node);
719                 free (e);
720               }
721           }
722       }
723
724   /* Convert hash tables into sorted arrays of entries. */
725   for (struct pivot_table *pt = proc->pivots;
726        pt < &proc->pivots[proc->n_pivots]; pt++)
727     {
728       struct freq *e;
729
730       pt->n_entries = hmap_count (&pt->data);
731       pt->entries = xnmalloc (pt->n_entries, sizeof *pt->entries);
732       size_t i = 0;
733       HMAP_FOR_EACH (e, struct freq, node, &pt->data)
734         pt->entries[i++] = e;
735       hmap_destroy (&pt->data);
736
737       sort (pt->entries, pt->n_entries, sizeof *pt->entries,
738             proc->descending ? compare_table_entry_3way_inv : compare_table_entry_3way,
739             pt);
740
741     }
742
743   make_summary_table (proc);
744
745   /* Output each pivot table. */
746   for (struct pivot_table *pt = proc->pivots;
747        pt < &proc->pivots[proc->n_pivots]; pt++)
748     {
749       if (proc->pivot || pt->n_vars == 2)
750         output_pivot_table (proc, pt);
751       else
752         {
753           size_t row0 = 0, row1 = 0;
754           while (find_crosstab (pt, &row0, &row1))
755             {
756               struct pivot_table subset;
757               make_pivot_table_subset (pt, row0, row1, &subset);
758               output_pivot_table (proc, &subset);
759             }
760         }
761       if (proc->barchart)
762         chart_item_submit
763           (barchart_create (pt->vars, pt->n_vars, _("Count"), false, pt->entries, pt->n_entries));
764     }
765
766   /* Free output and prepare for next split file. */
767   for (struct pivot_table *pt = proc->pivots;
768        pt < &proc->pivots[proc->n_pivots]; pt++)
769     {
770       pt->missing = 0.0;
771
772       /* Free the members that were allocated in this function(and the values
773          owned by the entries.
774
775          The other pointer members are either both allocated and destroyed at a
776          lower level (in output_pivot_table), or both allocated and destroyed
777          at a higher level (in crs_custom_tables and free_proc,
778          respectively). */
779       for (size_t i = 0; i < pt->n_vars; i++)
780         {
781           int width = var_get_width (pt->vars[i]);
782           if (value_needs_init (width))
783             {
784               size_t j;
785
786               for (j = 0; j < pt->n_entries; j++)
787                 value_destroy (&pt->entries[j]->values[i], width);
788             }
789         }
790
791       for (size_t i = 0; i < pt->n_entries; i++)
792         free (pt->entries[i]);
793       free (pt->entries);
794     }
795 }
796
797 static void
798 make_pivot_table_subset (struct pivot_table *pt, size_t row0, size_t row1,
799                          struct pivot_table *subset)
800 {
801   *subset = *pt;
802   if (pt->n_vars > 2)
803     {
804       assert (pt->n_consts == 0);
805       subset->missing = pt->missing;
806       subset->n_vars = 2;
807       subset->vars = pt->vars;
808       subset->n_consts = pt->n_vars - 2;
809       subset->const_vars = pt->vars + 2;
810       subset->const_values = &pt->entries[row0]->values[2];
811     }
812   subset->entries = &pt->entries[row0];
813   subset->n_entries = row1 - row0;
814 }
815
816 static int
817 compare_table_entry_var_3way (const struct freq *a,
818                               const struct freq *b,
819                               const struct pivot_table *pt,
820                               int idx)
821 {
822   return value_compare_3way (&a->values[idx], &b->values[idx],
823                              var_get_width (pt->vars[idx]));
824 }
825
826 static int
827 compare_table_entry_vars_3way (const struct freq *a,
828                                const struct freq *b,
829                                const struct pivot_table *pt,
830                                int idx0, int idx1)
831 {
832   int i;
833
834   for (i = idx1 - 1; i >= idx0; i--)
835     {
836       int cmp = compare_table_entry_var_3way (a, b, pt, i);
837       if (cmp != 0)
838         return cmp;
839     }
840   return 0;
841 }
842
843 /* Compare the struct freq at *AP to the one at *BP and
844    return a strcmp()-type result. */
845 static int
846 compare_table_entry_3way (const void *ap_, const void *bp_, const void *pt_)
847 {
848   const struct freq *const *ap = ap_;
849   const struct freq *const *bp = bp_;
850   const struct freq *a = *ap;
851   const struct freq *b = *bp;
852   const struct pivot_table *pt = pt_;
853   int cmp;
854
855   cmp = compare_table_entry_vars_3way (a, b, pt, 2, pt->n_vars);
856   if (cmp != 0)
857     return cmp;
858
859   cmp = compare_table_entry_var_3way (a, b, pt, ROW_VAR);
860   if (cmp != 0)
861     return cmp;
862
863   return compare_table_entry_var_3way (a, b, pt, COL_VAR);
864 }
865
866 /* Inverted version of compare_table_entry_3way */
867 static int
868 compare_table_entry_3way_inv (const void *ap_, const void *bp_, const void *pt_)
869 {
870   return -compare_table_entry_3way (ap_, bp_, pt_);
871 }
872
873 static int
874 find_first_difference (const struct pivot_table *pt, size_t row)
875 {
876   if (row == 0)
877     return pt->n_vars - 1;
878   else
879     {
880       const struct freq *a = pt->entries[row];
881       const struct freq *b = pt->entries[row - 1];
882       int col;
883
884       for (col = pt->n_vars - 1; col >= 0; col--)
885         if (compare_table_entry_var_3way (a, b, pt, col))
886           return col;
887       NOT_REACHED ();
888     }
889 }
890
891 /* Output a table summarizing the cases processed. */
892 static void
893 make_summary_table (struct crosstabs_proc *proc)
894 {
895   struct tab_table *summary;
896   struct pivot_table *pt;
897   struct string name;
898   int i;
899
900   summary = tab_create (7, 3 + proc->n_pivots);
901   tab_set_format (summary, RC_WEIGHT, &proc->weight_format);
902   tab_title (summary, _("Summary."));
903   tab_headers (summary, 1, 0, 3, 0);
904   tab_joint_text (summary, 1, 0, 6, 0, TAB_CENTER, _("Cases"));
905   tab_joint_text (summary, 1, 1, 2, 1, TAB_CENTER, _("Valid"));
906   tab_joint_text (summary, 3, 1, 4, 1, TAB_CENTER, _("Missing"));
907   tab_joint_text (summary, 5, 1, 6, 1, TAB_CENTER, _("Total"));
908   tab_hline (summary, TAL_1, 1, 6, 1);
909   tab_hline (summary, TAL_1, 1, 6, 2);
910   tab_vline (summary, TAL_1, 3, 1, 1);
911   tab_vline (summary, TAL_1, 5, 1, 1);
912   for (i = 0; i < 3; i++)
913     {
914       tab_text (summary, 1 + i * 2, 2, TAB_RIGHT, _("N"));
915       tab_text (summary, 2 + i * 2, 2, TAB_RIGHT, _("Percent"));
916     }
917   tab_offset (summary, 0, 3);
918
919   ds_init_empty (&name);
920   for (pt = &proc->pivots[0]; pt < &proc->pivots[proc->n_pivots]; pt++)
921     {
922       double valid;
923       double n[3];
924       size_t i;
925
926       tab_hline (summary, TAL_1, 0, 6, 0);
927
928       ds_clear (&name);
929       for (i = 0; i < pt->n_vars; i++)
930         {
931           if (i > 0)
932             ds_put_cstr (&name, " * ");
933           ds_put_cstr (&name, var_to_string (pt->vars[i]));
934         }
935       tab_text (summary, 0, 0, TAB_LEFT, ds_cstr (&name));
936
937       valid = 0.;
938       for (i = 0; i < pt->n_entries; i++)
939         valid += pt->entries[i]->count;
940
941       n[0] = valid;
942       n[1] = pt->missing;
943       n[2] = n[0] + n[1];
944       for (i = 0; i < 3; i++)
945         {
946           tab_double (summary, i * 2 + 1, 0, TAB_RIGHT, n[i], NULL, RC_WEIGHT);
947           tab_text_format (summary, i * 2 + 2, 0, TAB_RIGHT, "%.1f%%",
948                            n[i] / n[2] * 100.);
949         }
950
951       tab_next_row (summary);
952     }
953   ds_destroy (&name);
954
955   submit (NULL, summary);
956 }
957 \f
958 /* Output. */
959
960 static struct tab_table *create_crosstab_table (struct crosstabs_proc *,
961                                                 struct pivot_table *);
962 static struct tab_table *create_chisq_table (struct crosstabs_proc *proc, struct pivot_table *);
963 static struct tab_table *create_sym_table (struct crosstabs_proc *proc, struct pivot_table *);
964 static struct tab_table *create_risk_table (struct crosstabs_proc *proc, struct pivot_table *);
965 static struct tab_table *create_direct_table (struct crosstabs_proc *proc, struct pivot_table *);
966 static void display_dimensions (struct crosstabs_proc *, struct pivot_table *,
967                                 struct tab_table *, int first_difference);
968 static void display_crosstabulation (struct crosstabs_proc *,
969                                      struct pivot_table *,
970                                      struct tab_table *);
971 static void display_chisq (struct pivot_table *, struct tab_table *,
972                            bool *showed_fisher);
973 static void display_symmetric (struct crosstabs_proc *, struct pivot_table *,
974                                struct tab_table *);
975 static void display_risk (struct pivot_table *, struct tab_table *);
976 static void display_directional (struct crosstabs_proc *, struct pivot_table *,
977                                  struct tab_table *);
978 static void table_value_missing (struct crosstabs_proc *proc,
979                                  struct tab_table *table, int c, int r,
980                                  unsigned char opt, const union value *v,
981                                  const struct variable *var);
982 static void delete_missing (struct pivot_table *);
983 static void build_matrix (struct pivot_table *);
984
985 /* Output pivot table PT in the context of PROC. */
986 static void
987 output_pivot_table (struct crosstabs_proc *proc, struct pivot_table *pt)
988 {
989   struct tab_table *table = NULL; /* Crosstabulation table. */
990   struct tab_table *chisq = NULL; /* Chi-square table. */
991   bool showed_fisher = false;
992   struct tab_table *sym = NULL;   /* Symmetric measures table. */
993   struct tab_table *risk = NULL;  /* Risk estimate table. */
994   struct tab_table *direct = NULL; /* Directional measures table. */
995   size_t row0, row1;
996
997   enum_var_values (pt, COL_VAR, &pt->cols, &pt->n_cols, proc->descending);
998
999   if (pt->n_cols == 0)
1000     {
1001       struct string vars;
1002       int i;
1003
1004       ds_init_cstr (&vars, var_to_string (pt->vars[0]));
1005       for (i = 1; i < pt->n_vars; i++)
1006         ds_put_format (&vars, " * %s", var_to_string (pt->vars[i]));
1007
1008       /* TRANSLATORS: The %s here describes a crosstabulation.  It takes the
1009          form "var1 * var2 * var3 * ...".  */
1010       msg (SW, _("Crosstabulation %s contained no non-missing cases."),
1011            ds_cstr (&vars));
1012
1013       ds_destroy (&vars);
1014       free (pt->cols);
1015       return;
1016     }
1017
1018   if (proc->cells)
1019     table = create_crosstab_table (proc, pt);
1020   if (proc->statistics & (1u << CRS_ST_CHISQ))
1021     chisq = create_chisq_table (proc, pt);
1022   if (proc->statistics & ((1u << CRS_ST_PHI) | (1u << CRS_ST_CC)
1023                           | (1u << CRS_ST_BTAU) | (1u << CRS_ST_CTAU)
1024                           | (1u << CRS_ST_GAMMA) | (1u << CRS_ST_CORR)
1025                           | (1u << CRS_ST_KAPPA)))
1026     sym = create_sym_table (proc, pt);
1027   if (proc->statistics & (1u << CRS_ST_RISK))
1028     risk = create_risk_table (proc, pt);
1029   if (proc->statistics & ((1u << CRS_ST_LAMBDA) | (1u << CRS_ST_UC)
1030                           | (1u << CRS_ST_D) | (1u << CRS_ST_ETA)))
1031     direct = create_direct_table (proc, pt);
1032
1033   row0 = row1 = 0;
1034   while (find_crosstab (pt, &row0, &row1))
1035     {
1036       struct pivot_table x;
1037       int first_difference;
1038
1039       make_pivot_table_subset (pt, row0, row1, &x);
1040
1041       /* Find all the row variable values. */
1042       enum_var_values (&x, ROW_VAR, &x.rows, &x.n_rows, proc->descending);
1043
1044       if (size_overflow_p (xtimes (xtimes (x.n_rows, x.n_cols),
1045                                    sizeof (double))))
1046         xalloc_die ();
1047       x.row_tot = xmalloc (x.n_rows * sizeof *x.row_tot);
1048       x.col_tot = xmalloc (x.n_cols * sizeof *x.col_tot);
1049       x.mat = xmalloc (x.n_rows * x.n_cols * sizeof *x.mat);
1050
1051       /* Allocate table space for the matrix. */
1052       if (table
1053           && tab_row (table) + (x.n_rows + 1) * proc->n_cells > tab_nr (table))
1054         tab_realloc (table, -1,
1055                      MAX (tab_nr (table) + (x.n_rows + 1) * proc->n_cells,
1056                           tab_nr (table) * pt->n_entries / x.n_entries));
1057
1058       build_matrix (&x);
1059
1060       /* Find the first variable that differs from the last subtable. */
1061       first_difference = find_first_difference (pt, row0);
1062       if (table)
1063         {
1064           display_dimensions (proc, &x, table, first_difference);
1065           display_crosstabulation (proc, &x, table);
1066         }
1067
1068       if (proc->exclude == MV_NEVER)
1069         delete_missing (&x);
1070
1071       if (chisq)
1072         {
1073           display_dimensions (proc, &x, chisq, first_difference);
1074           display_chisq (&x, chisq, &showed_fisher);
1075         }
1076       if (sym)
1077         {
1078           display_dimensions (proc, &x, sym, first_difference);
1079           display_symmetric (proc, &x, sym);
1080         }
1081       if (risk)
1082         {
1083           display_dimensions (proc, &x, risk, first_difference);
1084           display_risk (&x, risk);
1085         }
1086       if (direct)
1087         {
1088           display_dimensions (proc, &x, direct, first_difference);
1089           display_directional (proc, &x, direct);
1090         }
1091
1092       /* Free the parts of x that are not owned by pt.  In
1093          particular we must not free x.cols, which is the same as
1094          pt->cols, which is freed at the end of this function. */
1095       free (x.rows);
1096
1097       free (x.mat);
1098       free (x.row_tot);
1099       free (x.col_tot);
1100     }
1101
1102   submit (NULL, table);
1103
1104   if (chisq)
1105     {
1106       if (!showed_fisher)
1107         tab_resize (chisq, 4 + (pt->n_vars - 2), -1);
1108       submit (pt, chisq);
1109     }
1110
1111   submit (pt, sym);
1112   submit (pt, risk);
1113   submit (pt, direct);
1114
1115   free (pt->cols);
1116 }
1117
1118 static void
1119 build_matrix (struct pivot_table *x)
1120 {
1121   const int col_var_width = var_get_width (x->vars[COL_VAR]);
1122   const int row_var_width = var_get_width (x->vars[ROW_VAR]);
1123   int col, row;
1124   double *mp;
1125   struct freq **p;
1126
1127   mp = x->mat;
1128   col = row = 0;
1129   for (p = x->entries; p < &x->entries[x->n_entries]; p++)
1130     {
1131       const struct freq *te = *p;
1132
1133       while (!value_equal (&x->rows[row], &te->values[ROW_VAR], row_var_width))
1134         {
1135           for (; col < x->n_cols; col++)
1136             *mp++ = 0.0;
1137           col = 0;
1138           row++;
1139         }
1140
1141       while (!value_equal (&x->cols[col], &te->values[COL_VAR], col_var_width))
1142         {
1143           *mp++ = 0.0;
1144           col++;
1145         }
1146
1147       *mp++ = te->count;
1148       if (++col >= x->n_cols)
1149         {
1150           col = 0;
1151           row++;
1152         }
1153     }
1154   while (mp < &x->mat[x->n_cols * x->n_rows])
1155     *mp++ = 0.0;
1156   assert (mp == &x->mat[x->n_cols * x->n_rows]);
1157
1158   /* Column totals, row totals, ns_rows. */
1159   mp = x->mat;
1160   for (col = 0; col < x->n_cols; col++)
1161     x->col_tot[col] = 0.0;
1162   for (row = 0; row < x->n_rows; row++)
1163     x->row_tot[row] = 0.0;
1164   x->ns_rows = 0;
1165   for (row = 0; row < x->n_rows; row++)
1166     {
1167       bool row_is_empty = true;
1168       for (col = 0; col < x->n_cols; col++)
1169         {
1170           if (*mp != 0.0)
1171             {
1172               row_is_empty = false;
1173               x->col_tot[col] += *mp;
1174               x->row_tot[row] += *mp;
1175             }
1176           mp++;
1177         }
1178       if (!row_is_empty)
1179         x->ns_rows++;
1180     }
1181   assert (mp == &x->mat[x->n_cols * x->n_rows]);
1182
1183   /* ns_cols. */
1184   x->ns_cols = 0;
1185   for (col = 0; col < x->n_cols; col++)
1186     for (row = 0; row < x->n_rows; row++)
1187       if (x->mat[col + row * x->n_cols] != 0.0)
1188         {
1189           x->ns_cols++;
1190           break;
1191         }
1192
1193   /* Grand total. */
1194   x->total = 0.0;
1195   for (col = 0; col < x->n_cols; col++)
1196     x->total += x->col_tot[col];
1197 }
1198
1199 static struct tab_table *
1200 create_crosstab_table (struct crosstabs_proc *proc, struct pivot_table *pt)
1201 {
1202   struct tuple
1203     {
1204       int value;
1205       const char *name;
1206     };
1207   static const struct tuple names[] =
1208     {
1209       {CRS_CL_COUNT, N_("count")},
1210       {CRS_CL_ROW, N_("row %")},
1211       {CRS_CL_COLUMN, N_("column %")},
1212       {CRS_CL_TOTAL, N_("total %")},
1213       {CRS_CL_EXPECTED, N_("expected")},
1214       {CRS_CL_RESIDUAL, N_("residual")},
1215       {CRS_CL_SRESIDUAL, N_("std. resid.")},
1216       {CRS_CL_ASRESIDUAL, N_("adj. resid.")},
1217     };
1218   const int n_names = sizeof names / sizeof *names;
1219   const struct tuple *t;
1220
1221   struct tab_table *table;
1222   struct string title;
1223   struct pivot_table x;
1224
1225   int i;
1226
1227   make_pivot_table_subset (pt, 0, 0, &x);
1228
1229   table = tab_create (x.n_consts + 1 + x.n_cols + 1,
1230                       (x.n_entries / x.n_cols) * 3 / 2 * proc->n_cells + 10);
1231   tab_headers (table, x.n_consts + 1, 0, 2, 0);
1232   tab_set_format (table, RC_WEIGHT, &proc->weight_format);
1233
1234   /* First header line. */
1235   tab_joint_text (table, x.n_consts + 1, 0,
1236                   (x.n_consts + 1) + (x.n_cols - 1), 0,
1237                   TAB_CENTER | TAT_TITLE, var_to_string (x.vars[COL_VAR]));
1238
1239   tab_hline (table, TAL_1, x.n_consts + 1,
1240              x.n_consts + 2 + x.n_cols - 2, 1);
1241
1242   /* Second header line. */
1243   for (i = 2; i < x.n_consts + 2; i++)
1244     tab_joint_text (table, x.n_consts + 2 - i - 1, 0,
1245                     x.n_consts + 2 - i - 1, 1,
1246                     TAB_RIGHT | TAT_TITLE, var_to_string (x.vars[i]));
1247   tab_text (table, x.n_consts + 2 - 2, 1, TAB_RIGHT | TAT_TITLE,
1248             var_to_string (x.vars[ROW_VAR]));
1249   for (i = 0; i < x.n_cols; i++)
1250     table_value_missing (proc, table, x.n_consts + 2 + i - 1, 1, TAB_RIGHT,
1251                          &x.cols[i], x.vars[COL_VAR]);
1252   tab_text (table, x.n_consts + 2 + x.n_cols - 1, 1, TAB_CENTER, _("Total"));
1253
1254   tab_hline (table, TAL_1, 0, x.n_consts + 2 + x.n_cols - 1, 2);
1255   tab_vline (table, TAL_1, x.n_consts + 2 + x.n_cols - 1, 0, 1);
1256
1257   /* Title. */
1258   ds_init_empty (&title);
1259   for (i = 0; i < x.n_consts + 2; i++)
1260     {
1261       if (i)
1262         ds_put_cstr (&title, " * ");
1263       ds_put_cstr (&title, var_to_string (x.vars[i]));
1264     }
1265   for (i = 0; i < pt->n_consts; i++)
1266     {
1267       const struct variable *var = pt->const_vars[i];
1268       char *s;
1269
1270       ds_put_format (&title, ", %s=", var_to_string (var));
1271
1272       /* Insert the formatted value of VAR without any leading spaces. */
1273       s = data_out (&pt->const_values[i], var_get_encoding (var),
1274                     var_get_print_format (var));
1275       ds_put_cstr (&title, s + strspn (s, " "));
1276       free (s);
1277     }
1278
1279   ds_put_cstr (&title, " [");
1280   i = 0;
1281   for (t = names; t < &names[n_names]; t++)
1282     if (proc->cells & (1u << t->value))
1283       {
1284         if (i++)
1285           ds_put_cstr (&title, ", ");
1286         ds_put_cstr (&title, gettext (t->name));
1287       }
1288   ds_put_cstr (&title, "].");
1289
1290   tab_title (table, "%s", ds_cstr (&title));
1291   ds_destroy (&title);
1292
1293   tab_offset (table, 0, 2);
1294   return table;
1295 }
1296
1297 static struct tab_table *
1298 create_chisq_table (struct crosstabs_proc *proc, struct pivot_table *pt)
1299 {
1300   struct tab_table *chisq;
1301
1302   chisq = tab_create (6 + (pt->n_vars - 2),
1303                       pt->n_entries / pt->n_cols * 3 / 2 * N_CHISQ + 10);
1304   tab_headers (chisq, 1 + (pt->n_vars - 2), 0, 1, 0);
1305   tab_set_format (chisq, RC_WEIGHT, &proc->weight_format);
1306
1307   tab_title (chisq, _("Chi-square tests."));
1308
1309   tab_offset (chisq, pt->n_vars - 2, 0);
1310   tab_text (chisq, 0, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
1311   tab_text (chisq, 1, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
1312   tab_text (chisq, 2, 0, TAB_RIGHT | TAT_TITLE, _("df"));
1313   tab_text (chisq, 3, 0, TAB_RIGHT | TAT_TITLE,
1314             _("Asymp. Sig. (2-tailed)"));
1315   tab_text_format (chisq, 4, 0, TAB_RIGHT | TAT_TITLE,
1316             _("Exact Sig. (%d-tailed)"), 2);
1317   tab_text_format (chisq, 5, 0, TAB_RIGHT | TAT_TITLE,
1318             _("Exact Sig. (%d-tailed)"), 1);
1319   tab_offset (chisq, 0, 1);
1320
1321   return chisq;
1322 }
1323
1324 /* Symmetric measures. */
1325 static struct tab_table *
1326 create_sym_table (struct crosstabs_proc *proc, struct pivot_table *pt)
1327 {
1328   struct tab_table *sym;
1329
1330   sym = tab_create (6 + (pt->n_vars - 2),
1331                     pt->n_entries / pt->n_cols * 7 + 10);
1332
1333   tab_set_format (sym, RC_WEIGHT, &proc->weight_format);
1334
1335   tab_headers (sym, 2 + (pt->n_vars - 2), 0, 1, 0);
1336   tab_title (sym, _("Symmetric measures."));
1337
1338   tab_offset (sym, pt->n_vars - 2, 0);
1339   tab_text (sym, 0, 0, TAB_LEFT | TAT_TITLE, _("Category"));
1340   tab_text (sym, 1, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
1341   tab_text (sym, 2, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
1342   tab_text (sym, 3, 0, TAB_RIGHT | TAT_TITLE, _("Asymp. Std. Error"));
1343   tab_text (sym, 4, 0, TAB_RIGHT | TAT_TITLE, _("Approx. T"));
1344   tab_text (sym, 5, 0, TAB_RIGHT | TAT_TITLE, _("Approx. Sig."));
1345   tab_offset (sym, 0, 1);
1346
1347   return sym;
1348 }
1349
1350 /* Risk estimate. */
1351 static struct tab_table *
1352 create_risk_table (struct crosstabs_proc *proc, struct pivot_table *pt)
1353 {
1354   struct tab_table *risk;
1355
1356   risk = tab_create (4 + (pt->n_vars - 2), pt->n_entries / pt->n_cols * 4 + 10);
1357   tab_headers (risk, 1 + pt->n_vars - 2, 0, 2, 0);
1358   tab_title (risk, _("Risk estimate."));
1359   tab_set_format (risk, RC_WEIGHT, &proc->weight_format);
1360
1361   tab_offset (risk, pt->n_vars - 2, 0);
1362   tab_joint_text_format (risk, 2, 0, 3, 0, TAB_CENTER | TAT_TITLE,
1363                          _("95%% Confidence Interval"));
1364   tab_text (risk, 0, 1, TAB_LEFT | TAT_TITLE, _("Statistic"));
1365   tab_text (risk, 1, 1, TAB_RIGHT | TAT_TITLE, _("Value"));
1366   tab_text (risk, 2, 1, TAB_RIGHT | TAT_TITLE, _("Lower"));
1367   tab_text (risk, 3, 1, TAB_RIGHT | TAT_TITLE, _("Upper"));
1368   tab_hline (risk, TAL_1, 2, 3, 1);
1369   tab_vline (risk, TAL_1, 2, 0, 1);
1370   tab_offset (risk, 0, 2);
1371
1372   return risk;
1373 }
1374
1375 /* Directional measures. */
1376 static struct tab_table *
1377 create_direct_table (struct crosstabs_proc *proc, struct pivot_table *pt)
1378 {
1379   struct tab_table *direct;
1380
1381   direct = tab_create (7 + (pt->n_vars - 2),
1382                        pt->n_entries / pt->n_cols * 7 + 10);
1383   tab_headers (direct, 3 + (pt->n_vars - 2), 0, 1, 0);
1384   tab_title (direct, _("Directional measures."));
1385   tab_set_format (direct, RC_WEIGHT, &proc->weight_format);
1386
1387   tab_offset (direct, pt->n_vars - 2, 0);
1388   tab_text (direct, 0, 0, TAB_LEFT | TAT_TITLE, _("Category"));
1389   tab_text (direct, 1, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
1390   tab_text (direct, 2, 0, TAB_LEFT | TAT_TITLE, _("Type"));
1391   tab_text (direct, 3, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
1392   tab_text (direct, 4, 0, TAB_RIGHT | TAT_TITLE, _("Asymp. Std. Error"));
1393   tab_text (direct, 5, 0, TAB_RIGHT | TAT_TITLE, _("Approx. T"));
1394   tab_text (direct, 6, 0, TAB_RIGHT | TAT_TITLE, _("Approx. Sig."));
1395   tab_offset (direct, 0, 1);
1396
1397   return direct;
1398 }
1399
1400
1401 /* Delete missing rows and columns for statistical analysis when
1402    /MISSING=REPORT. */
1403 static void
1404 delete_missing (struct pivot_table *pt)
1405 {
1406   int r, c;
1407
1408   for (r = 0; r < pt->n_rows; r++)
1409     if (var_is_num_missing (pt->vars[ROW_VAR], pt->rows[r].f, MV_USER))
1410       {
1411         for (c = 0; c < pt->n_cols; c++)
1412           pt->mat[c + r * pt->n_cols] = 0.;
1413         pt->ns_rows--;
1414       }
1415
1416
1417   for (c = 0; c < pt->n_cols; c++)
1418     if (var_is_num_missing (pt->vars[COL_VAR], pt->cols[c].f, MV_USER))
1419       {
1420         for (r = 0; r < pt->n_rows; r++)
1421           pt->mat[c + r * pt->n_cols] = 0.;
1422         pt->ns_cols--;
1423       }
1424 }
1425
1426 /* Prepare table T for submission, and submit it. */
1427 static void
1428 submit (struct pivot_table *pt, struct tab_table *t)
1429 {
1430   int i;
1431
1432   if (t == NULL)
1433     return;
1434
1435   tab_resize (t, -1, 0);
1436   if (tab_nr (t) == tab_t (t))
1437     {
1438       table_unref (&t->table);
1439       return;
1440     }
1441   tab_offset (t, 0, 0);
1442   if (pt != NULL)
1443     for (i = 2; i < pt->n_vars; i++)
1444       tab_text (t, pt->n_vars - i - 1, 0, TAB_RIGHT | TAT_TITLE,
1445                 var_to_string (pt->vars[i]));
1446   tab_box (t, TAL_2, TAL_2, -1, -1, 0, 0, tab_nc (t) - 1, tab_nr (t) - 1);
1447   tab_box (t, -1, -1, -1, TAL_1, tab_l (t), tab_t (t) - 1, tab_nc (t) - 1,
1448            tab_nr (t) - 1);
1449   tab_vline (t, TAL_2, tab_l (t), 0, tab_nr (t) - 1);
1450
1451   tab_submit (t);
1452 }
1453
1454 static bool
1455 find_crosstab (struct pivot_table *pt, size_t *row0p, size_t *row1p)
1456 {
1457   size_t row0 = *row1p;
1458   size_t row1;
1459
1460   if (row0 >= pt->n_entries)
1461     return false;
1462
1463   for (row1 = row0 + 1; row1 < pt->n_entries; row1++)
1464     {
1465       struct freq *a = pt->entries[row0];
1466       struct freq *b = pt->entries[row1];
1467       if (compare_table_entry_vars_3way (a, b, pt, 2, pt->n_vars) != 0)
1468         break;
1469     }
1470   *row0p = row0;
1471   *row1p = row1;
1472   return true;
1473 }
1474
1475 /* Compares `union value's A_ and B_ and returns a strcmp()-like
1476    result.  WIDTH_ points to an int which is either 0 for a
1477    numeric value or a string width for a string value. */
1478 static int
1479 compare_value_3way (const void *a_, const void *b_, const void *width_)
1480 {
1481   const union value *a = a_;
1482   const union value *b = b_;
1483   const int *width = width_;
1484
1485   return value_compare_3way (a, b, *width);
1486 }
1487
1488 /* Inverted version of the above */
1489 static int
1490 compare_value_3way_inv (const void *a_, const void *b_, const void *width_)
1491 {
1492   return -compare_value_3way (a_, b_, width_);
1493 }
1494
1495
1496 /* Given an array of ENTRY_CNT table_entry structures starting at
1497    ENTRIES, creates a sorted list of the values that the variable
1498    with index VAR_IDX takes on.  The values are returned as a
1499    malloc()'d array stored in *VALUES, with the number of values
1500    stored in *VALUE_CNT.
1501
1502    The caller must eventually free *VALUES, but each pointer in *VALUES points
1503    to existing data not owned by *VALUES itself. */
1504 static void
1505 enum_var_values (const struct pivot_table *pt, int var_idx,
1506                  union value **valuesp, int *n_values, bool descending)
1507 {
1508   const struct variable *var = pt->vars[var_idx];
1509   const struct var_range *range = get_var_range (pt->proc, var);
1510   union value *values;
1511   size_t i;
1512
1513   if (range)
1514     {
1515       values = *valuesp = xnmalloc (range->count, sizeof *values);
1516       *n_values = range->count;
1517       for (i = 0; i < range->count; i++)
1518         values[i].f = range->min + i;
1519     }
1520   else
1521     {
1522       int width = var_get_width (var);
1523       struct hmapx_node *node;
1524       const union value *iter;
1525       struct hmapx set;
1526
1527       hmapx_init (&set);
1528       for (i = 0; i < pt->n_entries; i++)
1529         {
1530           const struct freq *te = pt->entries[i];
1531           const union value *value = &te->values[var_idx];
1532           size_t hash = value_hash (value, width, 0);
1533
1534           HMAPX_FOR_EACH_WITH_HASH (iter, node, hash, &set)
1535             if (value_equal (iter, value, width))
1536               goto next_entry;
1537
1538           hmapx_insert (&set, (union value *) value, hash);
1539
1540         next_entry: ;
1541         }
1542
1543       *n_values = hmapx_count (&set);
1544       values = *valuesp = xnmalloc (*n_values, sizeof *values);
1545       i = 0;
1546       HMAPX_FOR_EACH (iter, node, &set)
1547         values[i++] = *iter;
1548       hmapx_destroy (&set);
1549
1550       sort (values, *n_values, sizeof *values,
1551             descending ? compare_value_3way_inv : compare_value_3way,
1552             &width);
1553     }
1554 }
1555
1556 /* Sets cell (C,R) in TABLE, with options OPT, to have a value taken
1557    from V, displayed with print format spec from variable VAR.  When
1558    in REPORT missing-value mode, missing values have an M appended. */
1559 static void
1560 table_value_missing (struct crosstabs_proc *proc,
1561                      struct tab_table *table, int c, int r, unsigned char opt,
1562                      const union value *v, const struct variable *var)
1563 {
1564   const char *label = var_lookup_value_label (var, v);
1565   if (label != NULL)
1566     tab_text (table, c, r, TAB_LEFT, label);
1567   else
1568     {
1569       const struct fmt_spec *print = var_get_print_format (var);
1570       if (proc->exclude == MV_NEVER && var_is_value_missing (var, v, MV_USER))
1571         {
1572           char *s = data_out (v, dict_get_encoding (proc->dict), print);
1573           tab_text_format (table, c, r, opt, "%sM", s + strspn (s, " "));
1574           free (s);
1575         }
1576       else
1577         tab_value (table, c, r, opt, v, var, print);
1578     }
1579 }
1580
1581 /* Draws a line across TABLE at the current row to indicate the most
1582    major dimension variable with index FIRST_DIFFERENCE out of N_VARS
1583    that changed, and puts the values that changed into the table.  TB
1584    and PT must be the corresponding table_entry and crosstab,
1585    respectively. */
1586 static void
1587 display_dimensions (struct crosstabs_proc *proc, struct pivot_table *pt,
1588                     struct tab_table *table, int first_difference)
1589 {
1590   tab_hline (table, TAL_1, pt->n_consts + pt->n_vars - first_difference - 1, tab_nc (table) - 1, 0);
1591
1592   for (; first_difference >= 2; first_difference--)
1593     table_value_missing (proc, table, pt->n_consts + pt->n_vars - first_difference - 1, 0,
1594                          TAB_RIGHT, &pt->entries[0]->values[first_difference],
1595                          pt->vars[first_difference]);
1596 }
1597
1598 /* Put VALUE into cell (C,R) of TABLE, suffixed with character
1599    SUFFIX if nonzero.  If MARK_MISSING is true the entry is
1600    additionally suffixed with a letter `M'. */
1601 static void
1602 format_cell_entry (struct tab_table *table, int c, int r, double value,
1603                    char suffix, bool mark_missing, const struct dictionary *dict)
1604 {
1605   union value v;
1606   char suffixes[3];
1607   int suffix_len;
1608   char *s;
1609
1610   v.f = value;
1611   s = data_out (&v, dict_get_encoding (dict), settings_get_format ());
1612
1613   suffix_len = 0;
1614   if (suffix != 0)
1615     suffixes[suffix_len++] = suffix;
1616   if (mark_missing)
1617     suffixes[suffix_len++] = 'M';
1618   suffixes[suffix_len] = '\0';
1619
1620   tab_text_format (table, c, r, TAB_RIGHT, "%s%s",
1621                    s + strspn (s, " "), suffixes);
1622
1623   free (s);
1624 }
1625
1626 /* Displays the crosstabulation table. */
1627 static void
1628 display_crosstabulation (struct crosstabs_proc *proc, struct pivot_table *pt,
1629                          struct tab_table *table)
1630 {
1631   int last_row;
1632   int r, c, i;
1633   double *mp;
1634
1635   for (r = 0; r < pt->n_rows; r++)
1636     table_value_missing (proc, table, pt->n_consts + pt->n_vars - 2,
1637                          r * proc->n_cells, TAB_RIGHT, &pt->rows[r],
1638                          pt->vars[ROW_VAR]);
1639
1640   tab_text (table, pt->n_vars - 2, pt->n_rows * proc->n_cells,
1641             TAB_LEFT, _("Total"));
1642
1643   /* Put in the actual cells. */
1644   mp = pt->mat;
1645   tab_offset (table, pt->n_consts + pt->n_vars - 1, -1);
1646   for (r = 0; r < pt->n_rows; r++)
1647     {
1648       if (proc->n_cells > 1)
1649         tab_hline (table, TAL_1, -1, pt->n_cols, 0);
1650       for (c = 0; c < pt->n_cols; c++)
1651         {
1652           bool mark_missing = false;
1653           double expected_value = pt->row_tot[r] * pt->col_tot[c] / pt->total;
1654           if (proc->exclude == MV_NEVER
1655               && (var_is_num_missing (pt->vars[COL_VAR], pt->cols[c].f, MV_USER)
1656                   || var_is_num_missing (pt->vars[ROW_VAR], pt->rows[r].f,
1657                                          MV_USER)))
1658             mark_missing = true;
1659           for (i = 0; i < proc->n_cells; i++)
1660             {
1661               double v;
1662               int suffix = 0;
1663
1664               switch (proc->a_cells[i])
1665                 {
1666                 case CRS_CL_COUNT:
1667                   v = *mp;
1668                   break;
1669                 case CRS_CL_ROW:
1670                   v = *mp / pt->row_tot[r] * 100.;
1671                   suffix = '%';
1672                   break;
1673                 case CRS_CL_COLUMN:
1674                   v = *mp / pt->col_tot[c] * 100.;
1675                   suffix = '%';
1676                   break;
1677                 case CRS_CL_TOTAL:
1678                   v = *mp / pt->total * 100.;
1679                   suffix = '%';
1680                   break;
1681                 case CRS_CL_EXPECTED:
1682                   v = expected_value;
1683                   break;
1684                 case CRS_CL_RESIDUAL:
1685                   v = *mp - expected_value;
1686                   break;
1687                 case CRS_CL_SRESIDUAL:
1688                   v = (*mp - expected_value) / sqrt (expected_value);
1689                   break;
1690                 case CRS_CL_ASRESIDUAL:
1691                   v = ((*mp - expected_value)
1692                        / sqrt (expected_value
1693                                * (1. - pt->row_tot[r] / pt->total)
1694                                * (1. - pt->col_tot[c] / pt->total)));
1695                   break;
1696                 default:
1697                   NOT_REACHED ();
1698                 }
1699               format_cell_entry (table, c, i, v, suffix, mark_missing, proc->dict);
1700             }
1701
1702           mp++;
1703         }
1704
1705       tab_offset (table, -1, tab_row (table) + proc->n_cells);
1706     }
1707
1708   /* Row totals. */
1709   tab_offset (table, -1, tab_row (table) - proc->n_cells * pt->n_rows);
1710   for (r = 0; r < pt->n_rows; r++)
1711     {
1712       bool mark_missing = false;
1713
1714       if (proc->exclude == MV_NEVER
1715           && var_is_num_missing (pt->vars[ROW_VAR], pt->rows[r].f, MV_USER))
1716         mark_missing = true;
1717
1718       for (i = 0; i < proc->n_cells; i++)
1719         {
1720           char suffix = 0;
1721           double v;
1722
1723           switch (proc->a_cells[i])
1724             {
1725             case CRS_CL_COUNT:
1726               v = pt->row_tot[r];
1727               break;
1728             case CRS_CL_ROW:
1729               v = 100.0;
1730               suffix = '%';
1731               break;
1732             case CRS_CL_COLUMN:
1733               v = pt->row_tot[r] / pt->total * 100.;
1734               suffix = '%';
1735               break;
1736             case CRS_CL_TOTAL:
1737               v = pt->row_tot[r] / pt->total * 100.;
1738               suffix = '%';
1739               break;
1740             case CRS_CL_EXPECTED:
1741             case CRS_CL_RESIDUAL:
1742             case CRS_CL_SRESIDUAL:
1743             case CRS_CL_ASRESIDUAL:
1744               v = 0.;
1745               break;
1746             default:
1747               NOT_REACHED ();
1748             }
1749
1750           format_cell_entry (table, pt->n_cols, 0, v, suffix, mark_missing, proc->dict);
1751           tab_next_row (table);
1752         }
1753     }
1754
1755   /* Column totals, grand total. */
1756   last_row = 0;
1757   if (proc->n_cells > 1)
1758     tab_hline (table, TAL_1, -1, pt->n_cols, 0);
1759   for (c = 0; c <= pt->n_cols; c++)
1760     {
1761       double ct = c < pt->n_cols ? pt->col_tot[c] : pt->total;
1762       bool mark_missing = false;
1763       int i;
1764
1765       if (proc->exclude == MV_NEVER && c < pt->n_cols
1766           && var_is_num_missing (pt->vars[COL_VAR], pt->cols[c].f, MV_USER))
1767         mark_missing = true;
1768
1769       for (i = 0; i < proc->n_cells; i++)
1770         {
1771           char suffix = 0;
1772           double v;
1773
1774           switch (proc->a_cells[i])
1775             {
1776             case CRS_CL_COUNT:
1777               v = ct;
1778               break;
1779             case CRS_CL_ROW:
1780               v = ct / pt->total * 100.;
1781               suffix = '%';
1782               break;
1783             case CRS_CL_COLUMN:
1784               v = 100.;
1785               suffix = '%';
1786               break;
1787             case CRS_CL_TOTAL:
1788               v = ct / pt->total * 100.;
1789               suffix = '%';
1790               break;
1791             case CRS_CL_EXPECTED:
1792             case CRS_CL_RESIDUAL:
1793             case CRS_CL_SRESIDUAL:
1794             case CRS_CL_ASRESIDUAL:
1795               continue;
1796             default:
1797               NOT_REACHED ();
1798             }
1799
1800           format_cell_entry (table, c, i, v, suffix, mark_missing, proc->dict);
1801         }
1802       last_row = i;
1803     }
1804
1805   tab_offset (table, -1, tab_row (table) + last_row);
1806   tab_offset (table, 0, -1);
1807 }
1808
1809 static void calc_r (struct pivot_table *,
1810                     double *PT, double *Y, double *, double *, double *);
1811 static void calc_chisq (struct pivot_table *,
1812                         double[N_CHISQ], int[N_CHISQ], double *, double *);
1813
1814 /* Display chi-square statistics. */
1815 static void
1816 display_chisq (struct pivot_table *pt, struct tab_table *chisq,
1817                bool *showed_fisher)
1818 {
1819   static const char *chisq_stats[N_CHISQ] =
1820     {
1821       N_("Pearson Chi-Square"),
1822       N_("Likelihood Ratio"),
1823       N_("Fisher's Exact Test"),
1824       N_("Continuity Correction"),
1825       N_("Linear-by-Linear Association"),
1826     };
1827   double chisq_v[N_CHISQ];
1828   double fisher1, fisher2;
1829   int df[N_CHISQ];
1830
1831   int i;
1832
1833   calc_chisq (pt, chisq_v, df, &fisher1, &fisher2);
1834
1835   tab_offset (chisq, pt->n_consts + pt->n_vars - 2, -1);
1836
1837   for (i = 0; i < N_CHISQ; i++)
1838     {
1839       if ((i != 2 && chisq_v[i] == SYSMIS)
1840           || (i == 2 && fisher1 == SYSMIS))
1841         continue;
1842
1843       tab_text (chisq, 0, 0, TAB_LEFT, gettext (chisq_stats[i]));
1844       if (i != 2)
1845         {
1846           tab_double (chisq, 1, 0, TAB_RIGHT, chisq_v[i], NULL, RC_OTHER);
1847           tab_double (chisq, 2, 0, TAB_RIGHT, df[i], NULL, RC_WEIGHT);
1848           tab_double (chisq, 3, 0, TAB_RIGHT,
1849                       gsl_cdf_chisq_Q (chisq_v[i], df[i]), NULL, RC_PVALUE);
1850         }
1851       else
1852         {
1853           *showed_fisher = true;
1854           tab_double (chisq, 4, 0, TAB_RIGHT, fisher2, NULL, RC_PVALUE);
1855           tab_double (chisq, 5, 0, TAB_RIGHT, fisher1, NULL, RC_PVALUE);
1856         }
1857       tab_next_row (chisq);
1858     }
1859
1860   tab_text (chisq, 0, 0, TAB_LEFT, _("N of Valid Cases"));
1861   tab_double (chisq, 1, 0, TAB_RIGHT, pt->total, NULL, RC_WEIGHT);
1862   tab_next_row (chisq);
1863
1864   tab_offset (chisq, 0, -1);
1865 }
1866
1867 static int calc_symmetric (struct crosstabs_proc *, struct pivot_table *,
1868                            double[N_SYMMETRIC], double[N_SYMMETRIC],
1869                            double[N_SYMMETRIC],
1870                            double[3], double[3], double[3]);
1871
1872 /* Display symmetric measures. */
1873 static void
1874 display_symmetric (struct crosstabs_proc *proc, struct pivot_table *pt,
1875                    struct tab_table *sym)
1876 {
1877   static const char *categories[] =
1878     {
1879       N_("Nominal by Nominal"),
1880       N_("Ordinal by Ordinal"),
1881       N_("Interval by Interval"),
1882       N_("Measure of Agreement"),
1883     };
1884
1885   static const char *stats[N_SYMMETRIC] =
1886     {
1887       N_("Phi"),
1888       N_("Cramer's V"),
1889       N_("Contingency Coefficient"),
1890       N_("Kendall's tau-b"),
1891       N_("Kendall's tau-c"),
1892       N_("Gamma"),
1893       N_("Spearman Correlation"),
1894       N_("Pearson's R"),
1895       N_("Kappa"),
1896     };
1897
1898   static const int stats_categories[N_SYMMETRIC] =
1899     {
1900       0, 0, 0, 1, 1, 1, 1, 2, 3,
1901     };
1902
1903   int last_cat = -1;
1904   double sym_v[N_SYMMETRIC], sym_ase[N_SYMMETRIC], sym_t[N_SYMMETRIC];
1905   double somers_d_v[3], somers_d_ase[3], somers_d_t[3];
1906   int i;
1907
1908   if (!calc_symmetric (proc, pt, sym_v, sym_ase, sym_t,
1909                        somers_d_v, somers_d_ase, somers_d_t))
1910     return;
1911
1912   tab_offset (sym, pt->n_consts + pt->n_vars - 2, -1);
1913
1914   for (i = 0; i < N_SYMMETRIC; i++)
1915     {
1916       if (sym_v[i] == SYSMIS)
1917         continue;
1918
1919       if (stats_categories[i] != last_cat)
1920         {
1921           last_cat = stats_categories[i];
1922           tab_text (sym, 0, 0, TAB_LEFT, gettext (categories[last_cat]));
1923         }
1924
1925       tab_text (sym, 1, 0, TAB_LEFT, gettext (stats[i]));
1926       tab_double (sym, 2, 0, TAB_RIGHT, sym_v[i], NULL, RC_OTHER);
1927       if (sym_ase[i] != SYSMIS)
1928         tab_double (sym, 3, 0, TAB_RIGHT, sym_ase[i], NULL, RC_OTHER);
1929       if (sym_t[i] != SYSMIS)
1930         tab_double (sym, 4, 0, TAB_RIGHT, sym_t[i], NULL, RC_OTHER);
1931       /*tab_double (sym, 5, 0, TAB_RIGHT, normal_sig (sym_v[i]), NULL, RC_PVALUE);*/
1932       tab_next_row (sym);
1933     }
1934
1935   tab_text (sym, 0, 0, TAB_LEFT, _("N of Valid Cases"));
1936   tab_double (sym, 2, 0, TAB_RIGHT, pt->total, NULL, RC_WEIGHT);
1937   tab_next_row (sym);
1938
1939   tab_offset (sym, 0, -1);
1940 }
1941
1942 static int calc_risk (struct pivot_table *,
1943                       double[], double[], double[], union value *);
1944
1945 /* Display risk estimate. */
1946 static void
1947 display_risk (struct pivot_table *pt, struct tab_table *risk)
1948 {
1949   char buf[256];
1950   double risk_v[3], lower[3], upper[3];
1951   union value c[2];
1952   int i;
1953
1954   if (!calc_risk (pt, risk_v, upper, lower, c))
1955     return;
1956
1957   tab_offset (risk, pt->n_consts + pt->n_vars - 2, -1);
1958
1959   for (i = 0; i < 3; i++)
1960     {
1961       const struct variable *cv = pt->vars[COL_VAR];
1962       const struct variable *rv = pt->vars[ROW_VAR];
1963       int cvw = var_get_width (cv);
1964       int rvw = var_get_width (rv);
1965
1966       if (risk_v[i] == SYSMIS)
1967         continue;
1968
1969       switch (i)
1970         {
1971         case 0:
1972           if (var_is_numeric (cv))
1973             sprintf (buf, _("Odds Ratio for %s (%g / %g)"),
1974                      var_to_string (cv), c[0].f, c[1].f);
1975           else
1976             sprintf (buf, _("Odds Ratio for %s (%.*s / %.*s)"),
1977                      var_to_string (cv),
1978                      cvw, value_str (&c[0], cvw),
1979                      cvw, value_str (&c[1], cvw));
1980           break;
1981         case 1:
1982         case 2:
1983           if (var_is_numeric (rv))
1984             sprintf (buf, _("For cohort %s = %.*g"),
1985                      var_to_string (rv), DBL_DIG + 1, pt->rows[i - 1].f);
1986           else
1987             sprintf (buf, _("For cohort %s = %.*s"),
1988                      var_to_string (rv),
1989                      rvw, value_str (&pt->rows[i - 1], rvw));
1990           break;
1991         }
1992
1993       tab_text (risk, 0, 0, TAB_LEFT, buf);
1994       tab_double (risk, 1, 0, TAB_RIGHT, risk_v[i], NULL, RC_OTHER);
1995       tab_double (risk, 2, 0, TAB_RIGHT, lower[i], NULL, RC_OTHER);
1996       tab_double (risk, 3, 0, TAB_RIGHT, upper[i], NULL, RC_OTHER);
1997       tab_next_row (risk);
1998     }
1999
2000   tab_text (risk, 0, 0, TAB_LEFT, _("N of Valid Cases"));
2001   tab_double (risk, 1, 0, TAB_RIGHT, pt->total, NULL, RC_WEIGHT);
2002   tab_next_row (risk);
2003
2004   tab_offset (risk, 0, -1);
2005 }
2006
2007 static int calc_directional (struct crosstabs_proc *, struct pivot_table *,
2008                              double[N_DIRECTIONAL], double[N_DIRECTIONAL],
2009                              double[N_DIRECTIONAL], double[N_DIRECTIONAL]);
2010
2011 /* Display directional measures. */
2012 static void
2013 display_directional (struct crosstabs_proc *proc, struct pivot_table *pt,
2014                      struct tab_table *direct)
2015 {
2016   static const char *categories[] =
2017     {
2018       N_("Nominal by Nominal"),
2019       N_("Ordinal by Ordinal"),
2020       N_("Nominal by Interval"),
2021     };
2022
2023   static const char *stats[] =
2024     {
2025       N_("Lambda"),
2026       N_("Goodman and Kruskal tau"),
2027       N_("Uncertainty Coefficient"),
2028       N_("Somers' d"),
2029       N_("Eta"),
2030     };
2031
2032   static const char *types[] =
2033     {
2034       N_("Symmetric"),
2035       N_("%s Dependent"),
2036       N_("%s Dependent"),
2037     };
2038
2039   static const int stats_categories[N_DIRECTIONAL] =
2040     {
2041       0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2,
2042     };
2043
2044   static const int stats_stats[N_DIRECTIONAL] =
2045     {
2046       0, 0, 0, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4,
2047     };
2048
2049   static const int stats_types[N_DIRECTIONAL] =
2050     {
2051       0, 1, 2, 1, 2, 0, 1, 2, 0, 1, 2, 1, 2,
2052     };
2053
2054   static const int *stats_lookup[] =
2055     {
2056       stats_categories,
2057       stats_stats,
2058       stats_types,
2059     };
2060
2061   static const char **stats_names[] =
2062     {
2063       categories,
2064       stats,
2065       types,
2066     };
2067
2068   int last[3] =
2069     {
2070       -1, -1, -1,
2071     };
2072
2073   double direct_v[N_DIRECTIONAL];
2074   double direct_ase[N_DIRECTIONAL];
2075   double direct_t[N_DIRECTIONAL];
2076   double sig[N_DIRECTIONAL];
2077
2078   int i;
2079
2080   if (!calc_directional (proc, pt, direct_v, direct_ase, direct_t, sig))
2081     return;
2082
2083   tab_offset (direct, pt->n_consts + pt->n_vars - 2, -1);
2084
2085   for (i = 0; i < N_DIRECTIONAL; i++)
2086     {
2087       if (direct_v[i] == SYSMIS)
2088         continue;
2089
2090       {
2091         int j;
2092
2093         for (j = 0; j < 3; j++)
2094           if (last[j] != stats_lookup[j][i])
2095             {
2096               if (j < 2)
2097                 tab_hline (direct, TAL_1, j, 6, 0);
2098
2099               for (; j < 3; j++)
2100                 {
2101                   const char *string;
2102                   int k = last[j] = stats_lookup[j][i];
2103
2104                   if (k == 0)
2105                     string = NULL;
2106                   else if (k == 1)
2107                     string = var_to_string (pt->vars[0]);
2108                   else
2109                     string = var_to_string (pt->vars[1]);
2110
2111                   tab_text_format (direct, j, 0, TAB_LEFT,
2112                                    gettext (stats_names[j][k]), string);
2113                 }
2114             }
2115       }
2116
2117       tab_double (direct, 3, 0, TAB_RIGHT, direct_v[i], NULL, RC_OTHER);
2118       if (direct_ase[i] != SYSMIS)
2119         tab_double (direct, 4, 0, TAB_RIGHT, direct_ase[i], NULL, RC_OTHER);
2120       if (direct_t[i] != SYSMIS)
2121         tab_double (direct, 5, 0, TAB_RIGHT, direct_t[i], NULL, RC_OTHER);
2122       tab_double (direct, 6, 0, TAB_RIGHT, sig[i], NULL, RC_PVALUE);
2123       tab_next_row (direct);
2124     }
2125
2126   tab_offset (direct, 0, -1);
2127 }
2128 \f
2129 /* Statistical calculations. */
2130
2131 /* Returns the value of the logarithm of gamma (factorial) function for an integer
2132    argument PT. */
2133 static double
2134 log_gamma_int (double pt)
2135 {
2136   double r = 0;
2137   int i;
2138
2139   for (i = 2; i < pt; i++)
2140     r += log(i);
2141
2142   return r;
2143 }
2144
2145 /* Calculate P_r as specified in _SPSS Statistical Algorithms_,
2146    Appendix 5. */
2147 static inline double
2148 Pr (int a, int b, int c, int d)
2149 {
2150   return exp (log_gamma_int (a + b + 1.) -  log_gamma_int (a + 1.)
2151             + log_gamma_int (c + d + 1.) - log_gamma_int (b + 1.)
2152             + log_gamma_int (a + c + 1.) - log_gamma_int (c + 1.)
2153             + log_gamma_int (b + d + 1.) - log_gamma_int (d + 1.)
2154             - log_gamma_int (a + b + c + d + 1.));
2155 }
2156
2157 /* Swap the contents of A and B. */
2158 static inline void
2159 swap (int *a, int *b)
2160 {
2161   int t = *a;
2162   *a = *b;
2163   *b = t;
2164 }
2165
2166 /* Calculate significance for Fisher's exact test as specified in
2167    _SPSS Statistical Algorithms_, Appendix 5. */
2168 static void
2169 calc_fisher (int a, int b, int c, int d, double *fisher1, double *fisher2)
2170 {
2171   int pt;
2172   double pn1;
2173
2174   if (MIN (c, d) < MIN (a, b))
2175     swap (&a, &c), swap (&b, &d);
2176   if (MIN (b, d) < MIN (a, c))
2177     swap (&a, &b), swap (&c, &d);
2178   if (b * c < a * d)
2179     {
2180       if (b < c)
2181         swap (&a, &b), swap (&c, &d);
2182       else
2183         swap (&a, &c), swap (&b, &d);
2184     }
2185
2186   pn1 = Pr (a, b, c, d);
2187   *fisher1 = pn1;
2188   for (pt = 1; pt <= a; pt++)
2189     {
2190       *fisher1 += Pr (a - pt, b + pt, c + pt, d - pt);
2191     }
2192
2193   *fisher2 = *fisher1;
2194
2195   for (pt = 1; pt <= b; pt++)
2196     {
2197       double p = Pr (a + pt, b - pt, c - pt, d + pt);
2198       if (p < pn1)
2199         *fisher2 += p;
2200     }
2201 }
2202
2203 /* Calculates chi-squares into CHISQ.  MAT is a matrix with N_COLS
2204    columns with values COLS and N_ROWS rows with values ROWS.  Values
2205    in the matrix sum to pt->total. */
2206 static void
2207 calc_chisq (struct pivot_table *pt,
2208             double chisq[N_CHISQ], int df[N_CHISQ],
2209             double *fisher1, double *fisher2)
2210 {
2211   int r, c;
2212
2213   chisq[0] = chisq[1] = 0.;
2214   chisq[2] = chisq[3] = chisq[4] = SYSMIS;
2215   *fisher1 = *fisher2 = SYSMIS;
2216
2217   df[0] = df[1] = (pt->ns_cols - 1) * (pt->ns_rows - 1);
2218
2219   if (pt->ns_rows <= 1 || pt->ns_cols <= 1)
2220     {
2221       chisq[0] = chisq[1] = SYSMIS;
2222       return;
2223     }
2224
2225   for (r = 0; r < pt->n_rows; r++)
2226     for (c = 0; c < pt->n_cols; c++)
2227       {
2228         const double expected = pt->row_tot[r] * pt->col_tot[c] / pt->total;
2229         const double freq = pt->mat[pt->n_cols * r + c];
2230         const double residual = freq - expected;
2231
2232         chisq[0] += residual * residual / expected;
2233         if (freq)
2234           chisq[1] += freq * log (expected / freq);
2235       }
2236
2237   if (chisq[0] == 0.)
2238     chisq[0] = SYSMIS;
2239
2240   if (chisq[1] != 0.)
2241     chisq[1] *= -2.;
2242   else
2243     chisq[1] = SYSMIS;
2244
2245   /* Calculate Yates and Fisher exact test. */
2246   if (pt->ns_cols == 2 && pt->ns_rows == 2)
2247     {
2248       double f11, f12, f21, f22;
2249
2250       {
2251         int nz_cols[2];
2252         int i, j;
2253
2254         for (i = j = 0; i < pt->n_cols; i++)
2255           if (pt->col_tot[i] != 0.)
2256             {
2257               nz_cols[j++] = i;
2258               if (j == 2)
2259                 break;
2260             }
2261
2262         assert (j == 2);
2263
2264         f11 = pt->mat[nz_cols[0]];
2265         f12 = pt->mat[nz_cols[1]];
2266         f21 = pt->mat[nz_cols[0] + pt->n_cols];
2267         f22 = pt->mat[nz_cols[1] + pt->n_cols];
2268       }
2269
2270       /* Yates. */
2271       {
2272         const double pt_ = fabs (f11 * f22 - f12 * f21) - 0.5 * pt->total;
2273
2274         if (pt_ > 0.)
2275           chisq[3] = (pt->total * pow2 (pt_)
2276                       / (f11 + f12) / (f21 + f22)
2277                       / (f11 + f21) / (f12 + f22));
2278         else
2279           chisq[3] = 0.;
2280
2281         df[3] = 1.;
2282       }
2283
2284       /* Fisher. */
2285       calc_fisher (f11 + .5, f12 + .5, f21 + .5, f22 + .5, fisher1, fisher2);
2286     }
2287
2288   /* Calculate Mantel-Haenszel. */
2289   if (var_is_numeric (pt->vars[ROW_VAR]) && var_is_numeric (pt->vars[COL_VAR]))
2290     {
2291       double r, ase_0, ase_1;
2292       calc_r (pt, (double *) pt->rows, (double *) pt->cols, &r, &ase_0, &ase_1);
2293
2294       chisq[4] = (pt->total - 1.) * r * r;
2295       df[4] = 1;
2296     }
2297 }
2298
2299 /* Calculate the value of Pearson's r.  r is stored into R, its T value into
2300    T, and standard error into ERROR.  The row and column values must be
2301    passed in PT and Y. */
2302 static void
2303 calc_r (struct pivot_table *pt,
2304         double *PT, double *Y, double *r, double *t, double *error)
2305 {
2306   double SX, SY, S, T;
2307   double Xbar, Ybar;
2308   double sum_XYf, sum_X2Y2f;
2309   double sum_Xr, sum_X2r;
2310   double sum_Yc, sum_Y2c;
2311   int i, j;
2312
2313   for (sum_X2Y2f = sum_XYf = 0., i = 0; i < pt->n_rows; i++)
2314     for (j = 0; j < pt->n_cols; j++)
2315       {
2316         double fij = pt->mat[j + i * pt->n_cols];
2317         double product = PT[i] * Y[j];
2318         double temp = fij * product;
2319         sum_XYf += temp;
2320         sum_X2Y2f += temp * product;
2321       }
2322
2323   for (sum_Xr = sum_X2r = 0., i = 0; i < pt->n_rows; i++)
2324     {
2325       sum_Xr += PT[i] * pt->row_tot[i];
2326       sum_X2r += pow2 (PT[i]) * pt->row_tot[i];
2327     }
2328   Xbar = sum_Xr / pt->total;
2329
2330   for (sum_Yc = sum_Y2c = 0., i = 0; i < pt->n_cols; i++)
2331     {
2332       sum_Yc += Y[i] * pt->col_tot[i];
2333       sum_Y2c += Y[i] * Y[i] * pt->col_tot[i];
2334     }
2335   Ybar = sum_Yc / pt->total;
2336
2337   S = sum_XYf - sum_Xr * sum_Yc / pt->total;
2338   SX = sum_X2r - pow2 (sum_Xr) / pt->total;
2339   SY = sum_Y2c - pow2 (sum_Yc) / pt->total;
2340   T = sqrt (SX * SY);
2341   *r = S / T;
2342   *t = *r / sqrt (1 - pow2 (*r)) * sqrt (pt->total - 2);
2343
2344   {
2345     double s, c, y, t;
2346
2347     for (s = c = 0., i = 0; i < pt->n_rows; i++)
2348       for (j = 0; j < pt->n_cols; j++)
2349         {
2350           double Xresid, Yresid;
2351           double temp;
2352
2353           Xresid = PT[i] - Xbar;
2354           Yresid = Y[j] - Ybar;
2355           temp = (T * Xresid * Yresid
2356                   - ((S / (2. * T))
2357                      * (Xresid * Xresid * SY + Yresid * Yresid * SX)));
2358           y = pt->mat[j + i * pt->n_cols] * temp * temp - c;
2359           t = s + y;
2360           c = (t - s) - y;
2361           s = t;
2362         }
2363     *error = sqrt (s) / (T * T);
2364   }
2365 }
2366
2367 /* Calculate symmetric statistics and their asymptotic standard
2368    errors.  Returns 0 if none could be calculated. */
2369 static int
2370 calc_symmetric (struct crosstabs_proc *proc, struct pivot_table *pt,
2371                 double v[N_SYMMETRIC], double ase[N_SYMMETRIC],
2372                 double t[N_SYMMETRIC],
2373                 double somers_d_v[3], double somers_d_ase[3],
2374                 double somers_d_t[3])
2375 {
2376   int q, i;
2377
2378   q = MIN (pt->ns_rows, pt->ns_cols);
2379   if (q <= 1)
2380     return 0;
2381
2382   for (i = 0; i < N_SYMMETRIC; i++)
2383     v[i] = ase[i] = t[i] = SYSMIS;
2384
2385   /* Phi, Cramer's V, contingency coefficient. */
2386   if (proc->statistics & ((1u << CRS_ST_PHI) | (1u << CRS_ST_CC)))
2387     {
2388       double Xp = 0.;   /* Pearson chi-square. */
2389       int r, c;
2390
2391       for (r = 0; r < pt->n_rows; r++)
2392         for (c = 0; c < pt->n_cols; c++)
2393           {
2394             const double expected = pt->row_tot[r] * pt->col_tot[c] / pt->total;
2395             const double freq = pt->mat[pt->n_cols * r + c];
2396             const double residual = freq - expected;
2397
2398             Xp += residual * residual / expected;
2399           }
2400
2401       if (proc->statistics & (1u << CRS_ST_PHI))
2402         {
2403           v[0] = sqrt (Xp / pt->total);
2404           v[1] = sqrt (Xp / (pt->total * (q - 1)));
2405         }
2406       if (proc->statistics & (1u << CRS_ST_CC))
2407         v[2] = sqrt (Xp / (Xp + pt->total));
2408     }
2409
2410   if (proc->statistics & ((1u << CRS_ST_BTAU) | (1u << CRS_ST_CTAU)
2411                           | (1u << CRS_ST_GAMMA) | (1u << CRS_ST_D)))
2412     {
2413       double *cum;
2414       double Dr, Dc;
2415       double P, Q;
2416       double btau_cum, ctau_cum, gamma_cum, d_yx_cum, d_xy_cum;
2417       double btau_var;
2418       int r, c;
2419
2420       Dr = Dc = pow2 (pt->total);
2421       for (r = 0; r < pt->n_rows; r++)
2422         Dr -= pow2 (pt->row_tot[r]);
2423       for (c = 0; c < pt->n_cols; c++)
2424         Dc -= pow2 (pt->col_tot[c]);
2425
2426       cum = xnmalloc (pt->n_cols * pt->n_rows, sizeof *cum);
2427       for (c = 0; c < pt->n_cols; c++)
2428         {
2429           double ct = 0.;
2430
2431           for (r = 0; r < pt->n_rows; r++)
2432             cum[c + r * pt->n_cols] = ct += pt->mat[c + r * pt->n_cols];
2433         }
2434
2435       /* P and Q. */
2436       {
2437         int i, j;
2438         double Cij, Dij;
2439
2440         P = Q = 0.;
2441         for (i = 0; i < pt->n_rows; i++)
2442           {
2443             Cij = Dij = 0.;
2444
2445             for (j = 1; j < pt->n_cols; j++)
2446               Cij += pt->col_tot[j] - cum[j + i * pt->n_cols];
2447
2448             if (i > 0)
2449               for (j = 1; j < pt->n_cols; j++)
2450                 Dij += cum[j + (i - 1) * pt->n_cols];
2451
2452             for (j = 0;;)
2453               {
2454                 double fij = pt->mat[j + i * pt->n_cols];
2455                 P += fij * Cij;
2456                 Q += fij * Dij;
2457
2458                 if (++j == pt->n_cols)
2459                   break;
2460                 assert (j < pt->n_cols);
2461
2462                 Cij -= pt->col_tot[j] - cum[j + i * pt->n_cols];
2463                 Dij += pt->col_tot[j - 1] - cum[j - 1 + i * pt->n_cols];
2464
2465                 if (i > 0)
2466                   {
2467                     Cij += cum[j - 1 + (i - 1) * pt->n_cols];
2468                     Dij -= cum[j + (i - 1) * pt->n_cols];
2469                   }
2470               }
2471           }
2472       }
2473
2474       if (proc->statistics & (1u << CRS_ST_BTAU))
2475         v[3] = (P - Q) / sqrt (Dr * Dc);
2476       if (proc->statistics & (1u << CRS_ST_CTAU))
2477         v[4] = (q * (P - Q)) / (pow2 (pt->total) * (q - 1));
2478       if (proc->statistics & (1u << CRS_ST_GAMMA))
2479         v[5] = (P - Q) / (P + Q);
2480
2481       /* ASE for tau-b, tau-c, gamma.  Calculations could be
2482          eliminated here, at expense of memory.  */
2483       {
2484         int i, j;
2485         double Cij, Dij;
2486
2487         btau_cum = ctau_cum = gamma_cum = d_yx_cum = d_xy_cum = 0.;
2488         for (i = 0; i < pt->n_rows; i++)
2489           {
2490             Cij = Dij = 0.;
2491
2492             for (j = 1; j < pt->n_cols; j++)
2493               Cij += pt->col_tot[j] - cum[j + i * pt->n_cols];
2494
2495             if (i > 0)
2496               for (j = 1; j < pt->n_cols; j++)
2497                 Dij += cum[j + (i - 1) * pt->n_cols];
2498
2499             for (j = 0;;)
2500               {
2501                 double fij = pt->mat[j + i * pt->n_cols];
2502
2503                 if (proc->statistics & (1u << CRS_ST_BTAU))
2504                   {
2505                     const double temp = (2. * sqrt (Dr * Dc) * (Cij - Dij)
2506                                          + v[3] * (pt->row_tot[i] * Dc
2507                                                    + pt->col_tot[j] * Dr));
2508                     btau_cum += fij * temp * temp;
2509                   }
2510
2511                 {
2512                   const double temp = Cij - Dij;
2513                   ctau_cum += fij * temp * temp;
2514                 }
2515
2516                 if (proc->statistics & (1u << CRS_ST_GAMMA))
2517                   {
2518                     const double temp = Q * Cij - P * Dij;
2519                     gamma_cum += fij * temp * temp;
2520                   }
2521
2522                 if (proc->statistics & (1u << CRS_ST_D))
2523                   {
2524                     d_yx_cum += fij * pow2 (Dr * (Cij - Dij)
2525                                             - (P - Q) * (pt->total - pt->row_tot[i]));
2526                     d_xy_cum += fij * pow2 (Dc * (Dij - Cij)
2527                                             - (Q - P) * (pt->total - pt->col_tot[j]));
2528                   }
2529
2530                 if (++j == pt->n_cols)
2531                   break;
2532                 assert (j < pt->n_cols);
2533
2534                 Cij -= pt->col_tot[j] - cum[j + i * pt->n_cols];
2535                 Dij += pt->col_tot[j - 1] - cum[j - 1 + i * pt->n_cols];
2536
2537                 if (i > 0)
2538                   {
2539                     Cij += cum[j - 1 + (i - 1) * pt->n_cols];
2540                     Dij -= cum[j + (i - 1) * pt->n_cols];
2541                   }
2542               }
2543           }
2544       }
2545
2546       btau_var = ((btau_cum
2547                    - (pt->total * pow2 (pt->total * (P - Q) / sqrt (Dr * Dc) * (Dr + Dc))))
2548                   / pow2 (Dr * Dc));
2549       if (proc->statistics & (1u << CRS_ST_BTAU))
2550         {
2551           ase[3] = sqrt (btau_var);
2552           t[3] = v[3] / (2 * sqrt ((ctau_cum - (P - Q) * (P - Q) / pt->total)
2553                                    / (Dr * Dc)));
2554         }
2555       if (proc->statistics & (1u << CRS_ST_CTAU))
2556         {
2557           ase[4] = ((2 * q / ((q - 1) * pow2 (pt->total)))
2558                     * sqrt (ctau_cum - (P - Q) * (P - Q) / pt->total));
2559           t[4] = v[4] / ase[4];
2560         }
2561       if (proc->statistics & (1u << CRS_ST_GAMMA))
2562         {
2563           ase[5] = ((4. / ((P + Q) * (P + Q))) * sqrt (gamma_cum));
2564           t[5] = v[5] / (2. / (P + Q)
2565                          * sqrt (ctau_cum - (P - Q) * (P - Q) / pt->total));
2566         }
2567       if (proc->statistics & (1u << CRS_ST_D))
2568         {
2569           somers_d_v[0] = (P - Q) / (.5 * (Dc + Dr));
2570           somers_d_ase[0] = SYSMIS;
2571           somers_d_t[0] = (somers_d_v[0]
2572                            / (4 / (Dc + Dr)
2573                               * sqrt (ctau_cum - pow2 (P - Q) / pt->total)));
2574           somers_d_v[1] = (P - Q) / Dc;
2575           somers_d_ase[1] = 2. / pow2 (Dc) * sqrt (d_xy_cum);
2576           somers_d_t[1] = (somers_d_v[1]
2577                            / (2. / Dc
2578                               * sqrt (ctau_cum - pow2 (P - Q) / pt->total)));
2579           somers_d_v[2] = (P - Q) / Dr;
2580           somers_d_ase[2] = 2. / pow2 (Dr) * sqrt (d_yx_cum);
2581           somers_d_t[2] = (somers_d_v[2]
2582                            / (2. / Dr
2583                               * sqrt (ctau_cum - pow2 (P - Q) / pt->total)));
2584         }
2585
2586       free (cum);
2587     }
2588
2589   /* Spearman correlation, Pearson's r. */
2590   if (proc->statistics & (1u << CRS_ST_CORR))
2591     {
2592       double *R = xmalloc (sizeof *R * pt->n_rows);
2593       double *C = xmalloc (sizeof *C * pt->n_cols);
2594
2595       {
2596         double y, t, c = 0., s = 0.;
2597         int i = 0;
2598
2599         for (;;)
2600           {
2601             R[i] = s + (pt->row_tot[i] + 1.) / 2.;
2602             y = pt->row_tot[i] - c;
2603             t = s + y;
2604             c = (t - s) - y;
2605             s = t;
2606             if (++i == pt->n_rows)
2607               break;
2608             assert (i < pt->n_rows);
2609           }
2610       }
2611
2612       {
2613         double y, t, c = 0., s = 0.;
2614         int j = 0;
2615
2616         for (;;)
2617           {
2618             C[j] = s + (pt->col_tot[j] + 1.) / 2;
2619             y = pt->col_tot[j] - c;
2620             t = s + y;
2621             c = (t - s) - y;
2622             s = t;
2623             if (++j == pt->n_cols)
2624               break;
2625             assert (j < pt->n_cols);
2626           }
2627       }
2628
2629       calc_r (pt, R, C, &v[6], &t[6], &ase[6]);
2630
2631       free (R);
2632       free (C);
2633
2634       calc_r (pt, (double *) pt->rows, (double *) pt->cols, &v[7], &t[7], &ase[7]);
2635     }
2636
2637   /* Cohen's kappa. */
2638   if (proc->statistics & (1u << CRS_ST_KAPPA) && pt->ns_rows == pt->ns_cols)
2639     {
2640       double ase_under_h0;
2641       double sum_fii, sum_rici, sum_fiiri_ci, sum_fijri_ci2, sum_riciri_ci;
2642       int i, j;
2643
2644       for (sum_fii = sum_rici = sum_fiiri_ci = sum_riciri_ci = 0., i = j = 0;
2645            i < pt->ns_rows; i++, j++)
2646         {
2647           double prod, sum;
2648
2649           while (pt->col_tot[j] == 0.)
2650             j++;
2651
2652           prod = pt->row_tot[i] * pt->col_tot[j];
2653           sum = pt->row_tot[i] + pt->col_tot[j];
2654
2655           sum_fii += pt->mat[j + i * pt->n_cols];
2656           sum_rici += prod;
2657           sum_fiiri_ci += pt->mat[j + i * pt->n_cols] * sum;
2658           sum_riciri_ci += prod * sum;
2659         }
2660       for (sum_fijri_ci2 = 0., i = 0; i < pt->ns_rows; i++)
2661         for (j = 0; j < pt->ns_cols; j++)
2662           {
2663             double sum = pt->row_tot[i] + pt->col_tot[j];
2664             sum_fijri_ci2 += pt->mat[j + i * pt->n_cols] * sum * sum;
2665           }
2666
2667       v[8] = (pt->total * sum_fii - sum_rici) / (pow2 (pt->total) - sum_rici);
2668
2669       ase_under_h0 = sqrt ((pow2 (pt->total) * sum_rici
2670                             + sum_rici * sum_rici
2671                             - pt->total * sum_riciri_ci)
2672                            / (pt->total * (pow2 (pt->total) - sum_rici) * (pow2 (pt->total) - sum_rici)));
2673
2674       ase[8] = sqrt (pt->total * (((sum_fii * (pt->total - sum_fii))
2675                                 / pow2 (pow2 (pt->total) - sum_rici))
2676                                + ((2. * (pt->total - sum_fii)
2677                                    * (2. * sum_fii * sum_rici
2678                                       - pt->total * sum_fiiri_ci))
2679                                   / pow3 (pow2 (pt->total) - sum_rici))
2680                                + (pow2 (pt->total - sum_fii)
2681                                   * (pt->total * sum_fijri_ci2 - 4.
2682                                      * sum_rici * sum_rici)
2683                                   / pow4 (pow2 (pt->total) - sum_rici))));
2684
2685       t[8] = v[8] / ase_under_h0;
2686     }
2687
2688   return 1;
2689 }
2690
2691 /* Calculate risk estimate. */
2692 static int
2693 calc_risk (struct pivot_table *pt,
2694            double *value, double *upper, double *lower, union value *c)
2695 {
2696   double f11, f12, f21, f22;
2697   double v;
2698
2699   {
2700     int i;
2701
2702     for (i = 0; i < 3; i++)
2703       value[i] = upper[i] = lower[i] = SYSMIS;
2704   }
2705
2706   if (pt->ns_rows != 2 || pt->ns_cols != 2)
2707     return 0;
2708
2709   {
2710     int nz_cols[2];
2711     int i, j;
2712
2713     for (i = j = 0; i < pt->n_cols; i++)
2714       if (pt->col_tot[i] != 0.)
2715         {
2716           nz_cols[j++] = i;
2717           if (j == 2)
2718             break;
2719         }
2720
2721     assert (j == 2);
2722
2723     f11 = pt->mat[nz_cols[0]];
2724     f12 = pt->mat[nz_cols[1]];
2725     f21 = pt->mat[nz_cols[0] + pt->n_cols];
2726     f22 = pt->mat[nz_cols[1] + pt->n_cols];
2727
2728     c[0] = pt->cols[nz_cols[0]];
2729     c[1] = pt->cols[nz_cols[1]];
2730   }
2731
2732   value[0] = (f11 * f22) / (f12 * f21);
2733   v = sqrt (1. / f11 + 1. / f12 + 1. / f21 + 1. / f22);
2734   lower[0] = value[0] * exp (-1.960 * v);
2735   upper[0] = value[0] * exp (1.960 * v);
2736
2737   value[1] = (f11 * (f21 + f22)) / (f21 * (f11 + f12));
2738   v = sqrt ((f12 / (f11 * (f11 + f12)))
2739             + (f22 / (f21 * (f21 + f22))));
2740   lower[1] = value[1] * exp (-1.960 * v);
2741   upper[1] = value[1] * exp (1.960 * v);
2742
2743   value[2] = (f12 * (f21 + f22)) / (f22 * (f11 + f12));
2744   v = sqrt ((f11 / (f12 * (f11 + f12)))
2745             + (f21 / (f22 * (f21 + f22))));
2746   lower[2] = value[2] * exp (-1.960 * v);
2747   upper[2] = value[2] * exp (1.960 * v);
2748
2749   return 1;
2750 }
2751
2752 /* Calculate directional measures. */
2753 static int
2754 calc_directional (struct crosstabs_proc *proc, struct pivot_table *pt,
2755                   double v[N_DIRECTIONAL], double ase[N_DIRECTIONAL],
2756                   double t[N_DIRECTIONAL], double sig[N_DIRECTIONAL])
2757 {
2758   {
2759     int i;
2760
2761     for (i = 0; i < N_DIRECTIONAL; i++)
2762       v[i] = ase[i] = t[i] = sig[i] = SYSMIS;
2763   }
2764
2765   /* Lambda. */
2766   if (proc->statistics & (1u << CRS_ST_LAMBDA))
2767     {
2768       double *fim = xnmalloc (pt->n_rows, sizeof *fim);
2769       int *fim_index = xnmalloc (pt->n_rows, sizeof *fim_index);
2770       double *fmj = xnmalloc (pt->n_cols, sizeof *fmj);
2771       int *fmj_index = xnmalloc (pt->n_cols, sizeof *fmj_index);
2772       double sum_fim, sum_fmj;
2773       double rm, cm;
2774       int rm_index, cm_index;
2775       int i, j;
2776
2777       /* Find maximum for each row and their sum. */
2778       for (sum_fim = 0., i = 0; i < pt->n_rows; i++)
2779         {
2780           double max = pt->mat[i * pt->n_cols];
2781           int index = 0;
2782
2783           for (j = 1; j < pt->n_cols; j++)
2784             if (pt->mat[j + i * pt->n_cols] > max)
2785               {
2786                 max = pt->mat[j + i * pt->n_cols];
2787                 index = j;
2788               }
2789
2790           sum_fim += fim[i] = max;
2791           fim_index[i] = index;
2792         }
2793
2794       /* Find maximum for each column. */
2795       for (sum_fmj = 0., j = 0; j < pt->n_cols; j++)
2796         {
2797           double max = pt->mat[j];
2798           int index = 0;
2799
2800           for (i = 1; i < pt->n_rows; i++)
2801             if (pt->mat[j + i * pt->n_cols] > max)
2802               {
2803                 max = pt->mat[j + i * pt->n_cols];
2804                 index = i;
2805               }
2806
2807           sum_fmj += fmj[j] = max;
2808           fmj_index[j] = index;
2809         }
2810
2811       /* Find maximum row total. */
2812       rm = pt->row_tot[0];
2813       rm_index = 0;
2814       for (i = 1; i < pt->n_rows; i++)
2815         if (pt->row_tot[i] > rm)
2816           {
2817             rm = pt->row_tot[i];
2818             rm_index = i;
2819           }
2820
2821       /* Find maximum column total. */
2822       cm = pt->col_tot[0];
2823       cm_index = 0;
2824       for (j = 1; j < pt->n_cols; j++)
2825         if (pt->col_tot[j] > cm)
2826           {
2827             cm = pt->col_tot[j];
2828             cm_index = j;
2829           }
2830
2831       v[0] = (sum_fim + sum_fmj - cm - rm) / (2. * pt->total - rm - cm);
2832       v[1] = (sum_fmj - rm) / (pt->total - rm);
2833       v[2] = (sum_fim - cm) / (pt->total - cm);
2834
2835       /* ASE1 for Y given PT. */
2836       {
2837         double accum;
2838
2839         accum = 0.;
2840         for (i = 0; i < pt->n_rows; i++)
2841           if (cm_index == fim_index[i])
2842             accum += fim[i];
2843         ase[2] = sqrt ((pt->total - sum_fim) * (sum_fim + cm - 2. * accum)
2844                        / pow3 (pt->total - cm));
2845       }
2846
2847       /* ASE0 for Y given PT. */
2848       {
2849         double accum;
2850
2851         for (accum = 0., i = 0; i < pt->n_rows; i++)
2852           if (cm_index != fim_index[i])
2853             accum += (pt->mat[i * pt->n_cols + fim_index[i]]
2854                       + pt->mat[i * pt->n_cols + cm_index]);
2855         t[2] = v[2] / (sqrt (accum - pow2 (sum_fim - cm) / pt->total) / (pt->total - cm));
2856       }
2857
2858       /* ASE1 for PT given Y. */
2859       {
2860         double accum;
2861
2862         accum = 0.;
2863         for (j = 0; j < pt->n_cols; j++)
2864           if (rm_index == fmj_index[j])
2865             accum += fmj[j];
2866         ase[1] = sqrt ((pt->total - sum_fmj) * (sum_fmj + rm - 2. * accum)
2867                        / pow3 (pt->total - rm));
2868       }
2869
2870       /* ASE0 for PT given Y. */
2871       {
2872         double accum;
2873
2874         for (accum = 0., j = 0; j < pt->n_cols; j++)
2875           if (rm_index != fmj_index[j])
2876             accum += (pt->mat[j + pt->n_cols * fmj_index[j]]
2877                       + pt->mat[j + pt->n_cols * rm_index]);
2878         t[1] = v[1] / (sqrt (accum - pow2 (sum_fmj - rm) / pt->total) / (pt->total - rm));
2879       }
2880
2881       /* Symmetric ASE0 and ASE1. */
2882       {
2883         double accum0;
2884         double accum1;
2885
2886         for (accum0 = accum1 = 0., i = 0; i < pt->n_rows; i++)
2887           for (j = 0; j < pt->n_cols; j++)
2888             {
2889               int temp0 = (fmj_index[j] == i) + (fim_index[i] == j);
2890               int temp1 = (i == rm_index) + (j == cm_index);
2891               accum0 += pt->mat[j + i * pt->n_cols] * pow2 (temp0 - temp1);
2892               accum1 += (pt->mat[j + i * pt->n_cols]
2893                          * pow2 (temp0 + (v[0] - 1.) * temp1));
2894             }
2895         ase[0] = sqrt (accum1 - 4. * pt->total * v[0] * v[0]) / (2. * pt->total - rm - cm);
2896         t[0] = v[0] / (sqrt (accum0 - pow2 (sum_fim + sum_fmj - cm - rm) / pt->total)
2897                        / (2. * pt->total - rm - cm));
2898       }
2899
2900       for (i = 0; i < 3; i++)
2901         sig[i] = 2 * gsl_cdf_ugaussian_Q (t[i]);
2902
2903       free (fim);
2904       free (fim_index);
2905       free (fmj);
2906       free (fmj_index);
2907
2908       /* Tau. */
2909       {
2910         double sum_fij2_ri, sum_fij2_ci;
2911         double sum_ri2, sum_cj2;
2912
2913         for (sum_fij2_ri = sum_fij2_ci = 0., i = 0; i < pt->n_rows; i++)
2914           for (j = 0; j < pt->n_cols; j++)
2915             {
2916               double temp = pow2 (pt->mat[j + i * pt->n_cols]);
2917               sum_fij2_ri += temp / pt->row_tot[i];
2918               sum_fij2_ci += temp / pt->col_tot[j];
2919             }
2920
2921         for (sum_ri2 = 0., i = 0; i < pt->n_rows; i++)
2922           sum_ri2 += pow2 (pt->row_tot[i]);
2923
2924         for (sum_cj2 = 0., j = 0; j < pt->n_cols; j++)
2925           sum_cj2 += pow2 (pt->col_tot[j]);
2926
2927         v[3] = (pt->total * sum_fij2_ci - sum_ri2) / (pow2 (pt->total) - sum_ri2);
2928         v[4] = (pt->total * sum_fij2_ri - sum_cj2) / (pow2 (pt->total) - sum_cj2);
2929       }
2930     }
2931
2932   if (proc->statistics & (1u << CRS_ST_UC))
2933     {
2934       double UX, UY, UXY, P;
2935       double ase1_yx, ase1_xy, ase1_sym;
2936       int i, j;
2937
2938       for (UX = 0., i = 0; i < pt->n_rows; i++)
2939         if (pt->row_tot[i] > 0.)
2940           UX -= pt->row_tot[i] / pt->total * log (pt->row_tot[i] / pt->total);
2941
2942       for (UY = 0., j = 0; j < pt->n_cols; j++)
2943         if (pt->col_tot[j] > 0.)
2944           UY -= pt->col_tot[j] / pt->total * log (pt->col_tot[j] / pt->total);
2945
2946       for (UXY = P = 0., i = 0; i < pt->n_rows; i++)
2947         for (j = 0; j < pt->n_cols; j++)
2948           {
2949             double entry = pt->mat[j + i * pt->n_cols];
2950
2951             if (entry <= 0.)
2952               continue;
2953
2954             P += entry * pow2 (log (pt->col_tot[j] * pt->row_tot[i] / (pt->total * entry)));
2955             UXY -= entry / pt->total * log (entry / pt->total);
2956           }
2957
2958       for (ase1_yx = ase1_xy = ase1_sym = 0., i = 0; i < pt->n_rows; i++)
2959         for (j = 0; j < pt->n_cols; j++)
2960           {
2961             double entry = pt->mat[j + i * pt->n_cols];
2962
2963             if (entry <= 0.)
2964               continue;
2965
2966             ase1_yx += entry * pow2 (UY * log (entry / pt->row_tot[i])
2967                                     + (UX - UXY) * log (pt->col_tot[j] / pt->total));
2968             ase1_xy += entry * pow2 (UX * log (entry / pt->col_tot[j])
2969                                     + (UY - UXY) * log (pt->row_tot[i] / pt->total));
2970             ase1_sym += entry * pow2 ((UXY
2971                                       * log (pt->row_tot[i] * pt->col_tot[j] / pow2 (pt->total)))
2972                                      - (UX + UY) * log (entry / pt->total));
2973           }
2974
2975       v[5] = 2. * ((UX + UY - UXY) / (UX + UY));
2976       ase[5] = (2. / (pt->total * pow2 (UX + UY))) * sqrt (ase1_sym);
2977       t[5] = SYSMIS;
2978
2979       v[6] = (UX + UY - UXY) / UX;
2980       ase[6] = sqrt (ase1_xy) / (pt->total * UX * UX);
2981       t[6] = v[6] / (sqrt (P - pt->total * pow2 (UX + UY - UXY)) / (pt->total * UX));
2982
2983       v[7] = (UX + UY - UXY) / UY;
2984       ase[7] = sqrt (ase1_yx) / (pt->total * UY * UY);
2985       t[7] = v[7] / (sqrt (P - pt->total * pow2 (UX + UY - UXY)) / (pt->total * UY));
2986     }
2987
2988   /* Somers' D. */
2989   if (proc->statistics & (1u << CRS_ST_D))
2990     {
2991       double v_dummy[N_SYMMETRIC];
2992       double ase_dummy[N_SYMMETRIC];
2993       double t_dummy[N_SYMMETRIC];
2994       double somers_d_v[3];
2995       double somers_d_ase[3];
2996       double somers_d_t[3];
2997
2998       if (calc_symmetric (proc, pt, v_dummy, ase_dummy, t_dummy,
2999                           somers_d_v, somers_d_ase, somers_d_t))
3000         {
3001           int i;
3002           for (i = 0; i < 3; i++)
3003             {
3004               v[8 + i] = somers_d_v[i];
3005               ase[8 + i] = somers_d_ase[i];
3006               t[8 + i] = somers_d_t[i];
3007               sig[8 + i] = 2 * gsl_cdf_ugaussian_Q (fabs (somers_d_t[i]));
3008             }
3009         }
3010     }
3011
3012   /* Eta. */
3013   if (proc->statistics & (1u << CRS_ST_ETA))
3014     {
3015       {
3016         double sum_Xr, sum_X2r;
3017         double SX, SXW;
3018         int i, j;
3019
3020         for (sum_Xr = sum_X2r = 0., i = 0; i < pt->n_rows; i++)
3021           {
3022             sum_Xr += pt->rows[i].f * pt->row_tot[i];
3023             sum_X2r += pow2 (pt->rows[i].f) * pt->row_tot[i];
3024           }
3025         SX = sum_X2r - pow2 (sum_Xr) / pt->total;
3026
3027         for (SXW = 0., j = 0; j < pt->n_cols; j++)
3028           {
3029             double cum;
3030
3031             for (cum = 0., i = 0; i < pt->n_rows; i++)
3032               {
3033                 SXW += pow2 (pt->rows[i].f) * pt->mat[j + i * pt->n_cols];
3034                 cum += pt->rows[i].f * pt->mat[j + i * pt->n_cols];
3035               }
3036
3037             SXW -= cum * cum / pt->col_tot[j];
3038           }
3039         v[11] = sqrt (1. - SXW / SX);
3040       }
3041
3042       {
3043         double sum_Yc, sum_Y2c;
3044         double SY, SYW;
3045         int i, j;
3046
3047         for (sum_Yc = sum_Y2c = 0., i = 0; i < pt->n_cols; i++)
3048           {
3049             sum_Yc += pt->cols[i].f * pt->col_tot[i];
3050             sum_Y2c += pow2 (pt->cols[i].f) * pt->col_tot[i];
3051           }
3052         SY = sum_Y2c - sum_Yc * sum_Yc / pt->total;
3053
3054         for (SYW = 0., i = 0; i < pt->n_rows; i++)
3055           {
3056             double cum;
3057
3058             for (cum = 0., j = 0; j < pt->n_cols; j++)
3059               {
3060                 SYW += pow2 (pt->cols[j].f) * pt->mat[j + i * pt->n_cols];
3061                 cum += pt->cols[j].f * pt->mat[j + i * pt->n_cols];
3062               }
3063
3064             SYW -= cum * cum / pt->row_tot[i];
3065           }
3066         v[12] = sqrt (1. - SYW / SY);
3067       }
3068     }
3069
3070   return 1;
3071 }
3072
3073 /*
3074    Local Variables:
3075    mode: c
3076    End:
3077 */