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