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