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