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