9bb6e1c84fc8a6d6c931138615bf8881fa4d3180
[pspp] / src / language / commands / ctables.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 2021 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 #include <config.h>
18
19 #include <math.h>
20 #include <errno.h>
21
22 #include "data/casegrouper.h"
23 #include "data/casereader.h"
24 #include "data/casewriter.h"
25 #include "data/data-in.h"
26 #include "data/data-out.h"
27 #include "data/dataset.h"
28 #include "data/dictionary.h"
29 #include "data/mrset.h"
30 #include "data/subcase.h"
31 #include "data/value-labels.h"
32 #include "language/command.h"
33 #include "language/commands/split-file.h"
34 #include "language/lexer/format-parser.h"
35 #include "language/lexer/lexer.h"
36 #include "language/lexer/token.h"
37 #include "language/lexer/variable-parser.h"
38 #include "libpspp/array.h"
39 #include "libpspp/assertion.h"
40 #include "libpspp/hash-functions.h"
41 #include "libpspp/hmap.h"
42 #include "libpspp/i18n.h"
43 #include "libpspp/message.h"
44 #include "libpspp/string-array.h"
45 #include "math/mode.h"
46 #include "math/moments.h"
47 #include "math/percentiles.h"
48 #include "math/sort.h"
49 #include "output/pivot-table.h"
50
51 #include "gl/minmax.h"
52 #include "gl/xalloc.h"
53
54 #include "gettext.h"
55 #define _(msgid) gettext (msgid)
56 #define N_(msgid) (msgid)
57
58 struct ctables;
59
60 /* The three forms of weighting supported by CTABLES. */
61 enum ctables_weighting
62   {
63     CTW_EFFECTIVE,             /* Effective base weight (WEIGHT subcommand). */
64     CTW_DICTIONARY,            /* Dictionary weight. */
65     CTW_UNWEIGHTED             /* No weight. */
66 #define N_CTWS 3
67   };
68 \f
69 /* CTABLES table areas. */
70
71 enum ctables_area_type
72   {
73     /* Within a section, where stacked variables divide one section from
74        another.
75
76        Keep CTAT_LAYER after CTAT_LAYERROW and CTAT_LAYERCOL so that
77        parse_ctables_summary_function() parses correctly. */
78     CTAT_TABLE,                  /* All layers of a whole section. */
79     CTAT_LAYERROW,               /* Row in one layer within a section. */
80     CTAT_LAYERCOL,               /* Column in one layer within a section. */
81     CTAT_LAYER,                  /* One layer within a section. */
82
83     /* Within a subtable, where a subtable pairs an innermost row variable with
84        an innermost column variable within a single layer.  */
85     CTAT_SUBTABLE,               /* Whole subtable. */
86     CTAT_ROW,                    /* Row within a subtable. */
87     CTAT_COL,                    /* Column within a subtable. */
88 #define N_CTATS 7
89   };
90
91 static const char *ctables_area_type_name[N_CTATS] = {
92   [CTAT_TABLE] = "TABLE",
93   [CTAT_LAYER] = "LAYER",
94   [CTAT_LAYERROW] = "LAYERROW",
95   [CTAT_LAYERCOL] = "LAYERCOL",
96   [CTAT_SUBTABLE] = "SUBTABLE",
97   [CTAT_ROW] = "ROW",
98   [CTAT_COL] = "COL",
99 };
100
101 /* Summary statistics for an area. */
102 struct ctables_area
103   {
104     struct hmap_node node;
105     const struct ctables_cell *example;
106
107     /* Sequence number used for CTSF_ID. */
108     size_t sequence;
109
110     /* Weights for CTSF_areaPCT_COUNT, CTSF_areaPCT_VALIDN, and
111        CTSF_areaPCT_TOTALN. */
112     double count[N_CTWS];
113     double valid[N_CTWS];
114     double total[N_CTWS];
115
116     /* Sums for CTSF_areaPCT_SUM. */
117     struct ctables_sum *sums;
118   };
119
120 struct ctables_sum
121   {
122     double sum[N_CTWS];
123   };
124 \f
125 /* CTABLES summary functions. */
126
127 enum ctables_function_type
128   {
129     /* A function that operates on data in a single cell.  It operates on
130        effective weights.  It does not have an unweighted version. */
131     CTFT_CELL,
132
133     /* A function that operates on data in a single cell.  The function
134        operates on effective weights and has a U-prefixed unweighted
135        version. */
136     CTFT_UCELL,
137
138     /* A function that operates on data in a single cell.  It operates on
139        dictionary weights, and has U-prefixed unweighted version and an
140        E-prefixed effective weight version. */
141     CTFT_UECELL,
142
143     /* A function that operates on an area of cells.  It operates on effective
144        weights and has a U-prefixed unweighted version. */
145     CTFT_AREA,
146   };
147
148 enum ctables_format
149   {
150     CTF_COUNT,                  /* F40.0. */
151     CTF_PERCENT,                /* PCT40.1. */
152     CTF_GENERAL                 /* Variable's print format. */
153   };
154
155 enum ctables_function_availability
156   {
157     CTFA_ALL,                /* Any variables. */
158     CTFA_SCALE,              /* Only scale variables, totals, and subtotals. */
159     //CTFA_MRSETS,             /* Only multiple-response sets */
160   };
161
162 enum ctables_summary_function
163   {
164 #define S(ENUM, NAME, TYPE, FORMAT, AVAILABILITY) ENUM,
165 #include "ctables.inc"
166 #undef S
167   };
168
169 enum {
170 #define S(ENUM, NAME, TYPE, FORMAT, AVAILABILITY) +1
171   N_CTSF_FUNCTIONS =
172 #include "ctables.inc"
173 #undef S
174 };
175
176 struct ctables_function_info
177   {
178     struct substring basename;
179     enum ctables_function_type type;
180     enum ctables_format format;
181     enum ctables_function_availability availability;
182
183     bool u_prefix;              /* Accepts a 'U' prefix (for unweighted)? */
184     bool e_prefix;              /* Accepts an 'E' prefix (for effective)? */
185     bool is_area;               /* Needs an area prefix. */
186   };
187 static const struct ctables_function_info ctables_function_info[N_CTSF_FUNCTIONS] = {
188 #define S(ENUM, NAME, TYPE, FORMAT, AVAILABILITY)                       \
189   [ENUM] = {                                                            \
190     .basename = SS_LITERAL_INITIALIZER (NAME),                          \
191     .type = TYPE,                                                       \
192     .format = FORMAT,                                                   \
193     .availability = AVAILABILITY,                                       \
194     .u_prefix = (TYPE) == CTFT_UCELL || (TYPE) == CTFT_UECELL || (TYPE) == CTFT_AREA, \
195     .e_prefix = (TYPE) == CTFT_UECELL,                                  \
196     .is_area = (TYPE) == CTFT_AREA                                      \
197   },
198 #include "ctables.inc"
199 #undef S
200 };
201
202 static struct fmt_spec
203 ctables_summary_default_format (enum ctables_summary_function function,
204                                 const struct variable *var)
205 {
206   static const enum ctables_format default_formats[] = {
207 #define S(ENUM, NAME, TYPE, FORMAT, AVAILABILITY) [ENUM] = FORMAT,
208 #include "ctables.inc"
209 #undef S
210   };
211   switch (default_formats[function])
212     {
213     case CTF_COUNT:
214       return (struct fmt_spec) { .type = FMT_F, .w = 40 };
215
216     case CTF_PERCENT:
217       return (struct fmt_spec) { .type = FMT_PCT, .w = 40, .d = 1 };
218
219     case CTF_GENERAL:
220       return *var_get_print_format (var);
221
222     default:
223       NOT_REACHED ();
224     }
225 }
226
227 static enum ctables_function_availability
228 ctables_function_availability (enum ctables_summary_function f)
229 {
230   static enum ctables_function_availability availability[] = {
231 #define S(ENUM, NAME, TYPE, FORMAT, AVAILABILITY) [ENUM] = AVAILABILITY,
232 #include "ctables.inc"
233 #undef S
234   };
235
236   return availability[f];
237 }
238
239 static bool
240 parse_ctables_summary_function (struct lexer *lexer,
241                                 enum ctables_summary_function *function,
242                                 enum ctables_weighting *weighting,
243                                 enum ctables_area_type *area)
244 {
245   if (!lex_force_id (lexer))
246     return false;
247
248   struct substring name = lex_tokss (lexer);
249   if (ss_ends_with_case (name, ss_cstr (".LCL"))
250       || ss_ends_with_case (name, ss_cstr (".UCL"))
251       || ss_ends_with_case (name, ss_cstr (".SE")))
252     {
253       lex_error (lexer, _("Support for LCL, UCL, and SE summary functions "
254                           "is not yet implemented."));
255       return false;
256     }
257
258   bool u = ss_match_byte (&name, 'U') || ss_match_byte (&name, 'u');
259   bool e = !u && (ss_match_byte (&name, 'E') || ss_match_byte (&name, 'e'));
260
261   bool has_area = false;
262   *area = 0;
263   for (enum ctables_area_type at = 0; at < N_CTATS; at++)
264     if (ss_match_string_case (&name, ss_cstr (ctables_area_type_name[at])))
265       {
266         has_area = true;
267         *area = at;
268
269         if (ss_equals_case (name, ss_cstr ("PCT")))
270           {
271             /* Special case where .COUNT suffix is omitted. */
272             *function = CTSF_areaPCT_COUNT;
273             *weighting = CTW_EFFECTIVE;
274             lex_get (lexer);
275             return true;
276           }
277         break;
278       }
279
280   for (int f = 0; f < N_CTSF_FUNCTIONS; f++)
281     {
282       const struct ctables_function_info *cfi = &ctables_function_info[f];
283       if (ss_equals_case (cfi->basename, name))
284         {
285           *function = f;
286           if ((u && !cfi->u_prefix) || (e && !cfi->e_prefix) || (has_area != cfi->is_area))
287             break;
288
289           *weighting = (e ? CTW_EFFECTIVE
290                         : u ? CTW_UNWEIGHTED
291                         : cfi->e_prefix ? CTW_DICTIONARY
292                         : CTW_EFFECTIVE);
293           lex_get (lexer);
294           return true;
295         }
296     }
297
298   lex_error (lexer, _("Syntax error expecting summary function name."));
299   return false;
300 }
301
302 static const char *
303 ctables_summary_function_name (enum ctables_summary_function function,
304                                enum ctables_weighting weighting,
305                                enum ctables_area_type area,
306                                char *buffer, size_t bufsize)
307 {
308   const struct ctables_function_info *cfi = &ctables_function_info[function];
309   snprintf (buffer, bufsize, "%s%s%s",
310             (weighting == CTW_UNWEIGHTED ? "U"
311              : weighting == CTW_DICTIONARY ? ""
312              : cfi->e_prefix ? "E"
313              : ""),
314             cfi->is_area ? ctables_area_type_name[area] : "",
315             cfi->basename.string);
316   return buffer;
317 }
318
319 static const char *
320 ctables_summary_function_label__ (enum ctables_summary_function function,
321                                   enum ctables_weighting weighting,
322                                   enum ctables_area_type area)
323 {
324   bool w = weighting != CTW_UNWEIGHTED;
325   bool d = weighting == CTW_DICTIONARY;
326   enum ctables_area_type a = area;
327   switch (function)
328     {
329     case CTSF_COUNT:
330       return d ? N_("Count") : w ? N_("Adjusted Count") : N_("Unweighted Count");
331
332     case CTSF_areaPCT_COUNT:
333       switch (a)
334         {
335         case CTAT_TABLE: return w ? N_("Table %") : N_("Unweighted Table %");
336         case CTAT_LAYER: return w ? N_("Layer %") : N_("Unweighted Layer %");
337         case CTAT_LAYERROW: return w ? N_("Layer Row %") : N_("Unweighted Layer Row %");
338         case CTAT_LAYERCOL: return w ? N_("Layer Column %") : N_("Unweighted Layer Column %");
339         case CTAT_SUBTABLE: return w ? N_("Subtable %") : N_("Unweighted Subtable %");
340         case CTAT_ROW: return w ? N_("Row %") : N_("Unweighted Row %");
341         case CTAT_COL: return w ? N_("Column %") : N_("Unweighted Column %");
342         }
343       NOT_REACHED ();
344
345     case CTSF_areaPCT_VALIDN:
346       switch (a)
347         {
348         case CTAT_TABLE: return w ? N_("Table Valid N %") : N_("Unweighted Table Valid N %");
349         case CTAT_LAYER: return w ? N_("Layer Valid N %") : N_("Unweighted Layer Valid N %");
350         case CTAT_LAYERROW: return w ? N_("Layer Row Valid N %") : N_("Unweighted Layer Row Valid N %");
351         case CTAT_LAYERCOL: return w ? N_("Layer Column Valid N %") : N_("Unweighted Layer Column Valid N %");
352         case CTAT_SUBTABLE: return w ? N_("Subtable Valid N %") : N_("Unweighted Subtable Valid N %");
353         case CTAT_ROW: return w ? N_("Row Valid N %") : N_("Unweighted Row Valid N %");
354         case CTAT_COL: return w ? N_("Column Valid N %") : N_("Unweighted Column Valid N %");
355         }
356       NOT_REACHED ();
357
358     case CTSF_areaPCT_TOTALN:
359       switch (a)
360         {
361         case CTAT_TABLE: return w ? N_("Table Total N %") : N_("Unweighted Table Total N %");
362         case CTAT_LAYER: return w ? N_("Layer Total N %") : N_("Unweighted Layer Total N %");
363         case CTAT_LAYERROW: return w ? N_("Layer Row Total N %") : N_("Unweighted Layer Row Total N %");
364         case CTAT_LAYERCOL: return w ? N_("Layer Column Total N %") : N_("Unweighted Layer Column Total N %");
365         case CTAT_SUBTABLE: return w ? N_("Subtable Total N %") : N_("Unweighted Subtable Total N %");
366         case CTAT_ROW: return w ? N_("Row Total N %") : N_("Unweighted Row Total N %");
367         case CTAT_COL: return w ? N_("Column Total N %") : N_("Unweighted Column Total N %");
368         }
369       NOT_REACHED ();
370
371     case CTSF_MAXIMUM: return N_("Maximum");
372     case CTSF_MEAN: return w ? N_("Mean") : N_("Unweighted Mean");
373     case CTSF_MEDIAN: return w ? N_("Median") : N_("Unweighted Median");
374     case CTSF_MINIMUM: return N_("Minimum");
375     case CTSF_MISSING: return w ? N_("Missing") : N_("Unweighted Missing");
376     case CTSF_MODE: return w ? N_("Mode") : N_("Unweighted Mode");
377     case CTSF_PTILE: NOT_REACHED ();
378     case CTSF_RANGE: return N_("Range");
379     case CTSF_SEMEAN: return w ? N_("Std Error of Mean") : N_("Unweighted Std Error of Mean");
380     case CTSF_STDDEV: return w ? N_("Std Deviation") : N_("Unweighted Std Deviation");
381     case CTSF_SUM: return w ? N_("Sum") : N_("Unweighted Sum");
382     case CTSF_TOTALN: return (d ? N_("Total N")
383                               : w ? N_("Adjusted Total N")
384                               : N_("Unweighted Total N"));
385     case CTSF_VALIDN: return (d ? N_("Valid N")
386                               : w ? N_("Adjusted Valid N")
387                               : N_("Unweighted Valid N"));
388     case CTSF_VARIANCE: return w ? N_("Variance") : N_("Unweighted Variance");
389     case CTSF_areaPCT_SUM:
390       switch (a)
391         {
392         case CTAT_TABLE: return w ? N_("Table Sum %") : N_("Unweighted Table Sum %");
393         case CTAT_LAYER: return w ? N_("Layer Sum %") : N_("Unweighted Layer Sum %");
394         case CTAT_LAYERROW: return w ? N_("Layer Row Sum %") : N_("Unweighted Layer Row Sum %");
395         case CTAT_LAYERCOL: return w ? N_("Layer Column Sum %") : N_("Unweighted Layer Column Sum %");
396         case CTAT_SUBTABLE: return w ? N_("Subtable Sum %") : N_("Unweighted Subtable Sum %");
397         case CTAT_ROW: return w ? N_("Row Sum %") : N_("Unweighted Row Sum %");
398         case CTAT_COL: return w ? N_("Column Sum %") : N_("Unweighted Column Sum %");
399         }
400       NOT_REACHED ();
401
402     case CTSF_areaID:
403       switch (a)
404         {
405         /* Don't bother translating these: they are for developers only. */
406         case CTAT_TABLE: return "Table ID";
407         case CTAT_LAYER: return "Layer ID";
408         case CTAT_LAYERROW: return "Layer Row ID";
409         case CTAT_LAYERCOL: return "Layer Column ID";
410         case CTAT_SUBTABLE: return "Subtable ID";
411         case CTAT_ROW: return "Row ID";
412         case CTAT_COL: return "Column ID";
413         }
414       NOT_REACHED ();
415     }
416
417   NOT_REACHED ();
418 }
419
420 static struct pivot_value *
421 ctables_summary_function_label (enum ctables_summary_function function,
422                                 enum ctables_weighting weighting,
423                                 enum ctables_area_type area,
424                                 double percentile)
425 {
426   if (function == CTSF_PTILE)
427     {
428       char *s = (weighting != CTW_UNWEIGHTED
429                  ? xasprintf (_("Percentile %.2f"), percentile)
430                  : xasprintf (_("Unweighted Percentile %.2f"), percentile));
431       return pivot_value_new_user_text_nocopy (s);
432     }
433   else
434     return pivot_value_new_text (ctables_summary_function_label__ (
435                                    function, weighting, area));
436 }
437 \f
438 /* CTABLES summaries. */
439
440 struct ctables_summary_spec
441   {
442     /* The calculation to be performed.
443
444        'function' is the function to calculate.  'weighted' specifies whether
445        to use weighted or unweighted data (for functions that do not support a
446        choice, it must be true).  'calc_area' is the area over which the
447        calculation takes place (for functions that target only an individual
448        cell, it must be 0).  For CTSF_PTILE only, 'percentile' is the
449        percentile between 0 and 100 (for other functions it must be 0). */
450     enum ctables_summary_function function;
451     enum ctables_weighting weighting;
452     enum ctables_area_type calc_area;
453     double percentile;          /* CTSF_PTILE only. */
454
455     /* How to display the result of the calculation.
456
457        'label' is a user-specified label, NULL if the user didn't specify
458        one.
459
460        'user_area' is usually the same as 'calc_area', but when category labels
461        are rotated from one axis to another it swaps rows and columns.
462
463        'format' is the format for displaying the output.  If
464        'is_ctables_format' is true, then 'format.type' is one of the special
465        CTEF_* formats instead of the standard ones. */
466     char *label;
467     enum ctables_area_type user_area;
468     struct fmt_spec format;
469     bool is_ctables_format;       /* Is 'format' one of CTEF_*? */
470
471     size_t axis_idx;            /* Leaf index if summary dimension in use. */
472     size_t sum_var_idx;         /* Offset into 'sums' in ctables_area. */
473   };
474
475 static void
476 ctables_summary_spec_clone (struct ctables_summary_spec *dst,
477                             const struct ctables_summary_spec *src)
478 {
479   *dst = *src;
480   dst->label = xstrdup_if_nonnull (src->label);
481 }
482
483 static void
484 ctables_summary_spec_uninit (struct ctables_summary_spec *s)
485 {
486   if (s)
487     free (s->label);
488 }
489 \f
490 /* Collections of summary functions. */
491
492 struct ctables_summary_spec_set
493   {
494     struct ctables_summary_spec *specs;
495     size_t n;
496     size_t allocated;
497
498     /* The variable to which the summary specs are applied. */
499     struct variable *var;
500
501     /* Whether the variable to which the summary specs are applied is a scale
502        variable for the purpose of summarization.
503
504        (VALIDN and TOTALN act differently for summarizing scale and categorical
505        variables.) */
506     bool is_scale;
507
508     /* If any of these optional additional scale variables are missing, then
509        treat 'var' as if it's missing too.  This is for implementing
510        SMISSING=LISTWISE. */
511     struct variable **listwise_vars;
512     size_t n_listwise_vars;
513   };
514
515 static void
516 ctables_summary_spec_set_clone (struct ctables_summary_spec_set *dst,
517                                 const struct ctables_summary_spec_set *src)
518 {
519   struct ctables_summary_spec *specs
520     = (src->n ? xnmalloc (src->n, sizeof *specs) : NULL);
521   for (size_t i = 0; i < src->n; i++)
522     ctables_summary_spec_clone (&specs[i], &src->specs[i]);
523
524   *dst = (struct ctables_summary_spec_set) {
525     .specs = specs,
526     .n = src->n,
527     .allocated = src->n,
528     .var = src->var,
529     .is_scale = src->is_scale,
530   };
531 }
532
533 static void
534 ctables_summary_spec_set_uninit (struct ctables_summary_spec_set *set)
535 {
536   for (size_t i = 0; i < set->n; i++)
537     ctables_summary_spec_uninit (&set->specs[i]);
538   free (set->listwise_vars);
539   free (set->specs);
540 }
541
542 static bool
543 is_listwise_missing (const struct ctables_summary_spec_set *specs,
544                      const struct ccase *c)
545 {
546   for (size_t i = 0; i < specs->n_listwise_vars; i++)
547     {
548       const struct variable *var = specs->listwise_vars[i];
549       if (var_is_num_missing (var, case_num (c, var)))
550         return true;
551     }
552
553   return false;
554 }
555 \f
556 /* CTABLES postcompute expressions. */
557
558 struct ctables_postcompute
559   {
560     struct hmap_node hmap_node; /* In struct ctables's 'pcompute' hmap. */
561     char *name;                 /* Name, without leading &. */
562
563     struct msg_location *location; /* Location of definition. */
564     struct ctables_pcexpr *expr;
565     char *label;
566     struct ctables_summary_spec_set *specs;
567     bool hide_source_cats;
568   };
569
570 struct ctables_pcexpr
571   {
572     /* Precedence table:
573
574        ()
575        **
576        -
577        * /
578        - +
579     */
580     enum ctables_pcexpr_op
581       {
582         /* Terminals. */
583         CTPO_CONSTANT,          /* 5 */
584         CTPO_CAT_NUMBER,        /* [5] */
585         CTPO_CAT_STRING,        /* ["STRING"] */
586         CTPO_CAT_NRANGE,        /* [LO THRU 5] */
587         CTPO_CAT_SRANGE,        /* ["A" THRU "B"] */
588         CTPO_CAT_MISSING,       /* MISSING */
589         CTPO_CAT_OTHERNM,       /* OTHERNM */
590         CTPO_CAT_SUBTOTAL,      /* SUBTOTAL */
591         CTPO_CAT_TOTAL,         /* TOTAL */
592
593         /* Nonterminals. */
594         CTPO_ADD,
595         CTPO_SUB,
596         CTPO_MUL,
597         CTPO_DIV,
598         CTPO_POW,
599         CTPO_NEG,
600       }
601     op;
602
603     union
604       {
605         /* CTPO_CAT_NUMBER. */
606         double number;
607
608         /* CTPO_CAT_STRING, in dictionary encoding. */
609         struct substring string;
610
611         /* CTPO_CAT_NRANGE. */
612         double nrange[2];
613
614         /* CTPO_CAT_SRANGE. */
615         struct substring srange[2];
616
617         /* CTPO_CAT_SUBTOTAL. */
618         size_t subtotal_index;
619
620         /* Two elements: CTPO_ADD, CTPO_SUB, CTPO_MUL, CTPO_DIV, CTPO_POW.
621            One element: CTPO_NEG. */
622         struct ctables_pcexpr *subs[2];
623       };
624
625     /* Source location. */
626     struct msg_location *location;
627   };
628
629 static struct ctables_postcompute *ctables_find_postcompute (struct ctables *,
630                                                              const char *name);
631
632 static struct ctables_pcexpr *ctables_pcexpr_allocate_binary (
633   enum ctables_pcexpr_op, struct ctables_pcexpr *sub0,
634   struct ctables_pcexpr *sub1);
635
636 typedef struct ctables_pcexpr *parse_recursively_func (struct lexer *,
637                                                        struct dictionary *);
638
639 static void
640 ctables_pcexpr_destroy (struct ctables_pcexpr *e)
641 {
642   if (e)
643     {
644       switch (e->op)
645         {
646         case CTPO_CAT_STRING:
647           ss_dealloc (&e->string);
648           break;
649
650         case CTPO_CAT_SRANGE:
651           for (size_t i = 0; i < 2; i++)
652             ss_dealloc (&e->srange[i]);
653           break;
654
655         case CTPO_ADD:
656         case CTPO_SUB:
657         case CTPO_MUL:
658         case CTPO_DIV:
659         case CTPO_POW:
660         case CTPO_NEG:
661           for (size_t i = 0; i < 2; i++)
662             ctables_pcexpr_destroy (e->subs[i]);
663           break;
664
665         case CTPO_CONSTANT:
666         case CTPO_CAT_NUMBER:
667         case CTPO_CAT_NRANGE:
668         case CTPO_CAT_MISSING:
669         case CTPO_CAT_OTHERNM:
670         case CTPO_CAT_SUBTOTAL:
671         case CTPO_CAT_TOTAL:
672           break;
673         }
674
675       msg_location_destroy (e->location);
676       free (e);
677     }
678 }
679
680 static struct ctables_pcexpr *
681 ctables_pcexpr_allocate_binary (enum ctables_pcexpr_op op,
682                                 struct ctables_pcexpr *sub0,
683                                 struct ctables_pcexpr *sub1)
684 {
685   struct ctables_pcexpr *e = xmalloc (sizeof *e);
686   *e = (struct ctables_pcexpr) {
687     .op = op,
688     .subs = { sub0, sub1 },
689     .location = msg_location_merged (sub0->location, sub1->location),
690   };
691   return e;
692 }
693
694 /* How to parse an operator. */
695 struct operator
696   {
697     enum token_type token;
698     enum ctables_pcexpr_op op;
699   };
700
701 static const struct operator *
702 ctables_pcexpr_match_operator (struct lexer *lexer,
703                               const struct operator ops[], size_t n_ops)
704 {
705   for (const struct operator *op = ops; op < ops + n_ops; op++)
706     if (lex_token (lexer) == op->token)
707       {
708         if (op->token != T_NEG_NUM)
709           lex_get (lexer);
710
711         return op;
712       }
713
714   return NULL;
715 }
716
717 static struct ctables_pcexpr *
718 ctables_pcexpr_parse_binary_operators__ (
719   struct lexer *lexer, struct dictionary *dict,
720   const struct operator ops[], size_t n_ops,
721   parse_recursively_func *parse_next_level,
722   const char *chain_warning, struct ctables_pcexpr *lhs)
723 {
724   for (int op_count = 0; ; op_count++)
725     {
726       const struct operator *op
727         = ctables_pcexpr_match_operator (lexer, ops, n_ops);
728       if (!op)
729         {
730           if (op_count > 1 && chain_warning)
731             msg_at (SW, lhs->location, "%s", chain_warning);
732
733           return lhs;
734         }
735
736       struct ctables_pcexpr *rhs = parse_next_level (lexer, dict);
737       if (!rhs)
738         {
739           ctables_pcexpr_destroy (lhs);
740           return NULL;
741         }
742
743       lhs = ctables_pcexpr_allocate_binary (op->op, lhs, rhs);
744     }
745 }
746
747 static struct ctables_pcexpr *
748 ctables_pcexpr_parse_binary_operators (
749   struct lexer *lexer, struct dictionary *dict,
750   const struct operator ops[], size_t n_ops,
751   parse_recursively_func *parse_next_level, const char *chain_warning)
752 {
753   struct ctables_pcexpr *lhs = parse_next_level (lexer, dict);
754   if (!lhs)
755     return NULL;
756
757   return ctables_pcexpr_parse_binary_operators__ (lexer, dict, ops, n_ops,
758                                                  parse_next_level,
759                                                  chain_warning, lhs);
760 }
761
762 static struct ctables_pcexpr *ctables_pcexpr_parse_add (struct lexer *,
763                                                         struct dictionary *);
764
765 static struct ctables_pcexpr
766 ctpo_cat_nrange (double low, double high)
767 {
768   return (struct ctables_pcexpr) {
769     .op = CTPO_CAT_NRANGE,
770     .nrange = { low, high },
771   };
772 }
773
774 static struct ctables_pcexpr
775 ctpo_cat_srange (struct substring low, struct substring high)
776 {
777   return (struct ctables_pcexpr) {
778     .op = CTPO_CAT_SRANGE,
779     .srange = { low, high },
780   };
781 }
782
783 static struct substring
784 parse_substring (struct lexer *lexer, struct dictionary *dict)
785 {
786   struct substring s = recode_substring_pool (
787     dict_get_encoding (dict), "UTF-8", lex_tokss (lexer), NULL);
788   ss_rtrim (&s, ss_cstr (" "));
789   lex_get (lexer);
790   return s;
791 }
792
793 static struct ctables_pcexpr *
794 ctables_pcexpr_parse_primary (struct lexer *lexer, struct dictionary *dict)
795 {
796   int start_ofs = lex_ofs (lexer);
797   struct ctables_pcexpr e;
798   if (lex_is_number (lexer))
799     {
800       e = (struct ctables_pcexpr) { .op = CTPO_CONSTANT,
801                                     .number = lex_number (lexer) };
802       lex_get (lexer);
803     }
804   else if (lex_match_id (lexer, "MISSING"))
805     e = (struct ctables_pcexpr) { .op = CTPO_CAT_MISSING };
806   else if (lex_match_id (lexer, "OTHERNM"))
807     e = (struct ctables_pcexpr) { .op = CTPO_CAT_OTHERNM };
808   else if (lex_match_id (lexer, "TOTAL"))
809     e = (struct ctables_pcexpr) { .op = CTPO_CAT_TOTAL };
810   else if (lex_match_id (lexer, "SUBTOTAL"))
811     {
812       size_t subtotal_index = 0;
813       if (lex_match (lexer, T_LBRACK))
814         {
815           if (!lex_force_int_range (lexer, "SUBTOTAL", 1, LONG_MAX))
816             return NULL;
817           subtotal_index = lex_integer (lexer);
818           lex_get (lexer);
819           if (!lex_force_match (lexer, T_RBRACK))
820             return NULL;
821         }
822       e = (struct ctables_pcexpr) { .op = CTPO_CAT_SUBTOTAL,
823                                     .subtotal_index = subtotal_index };
824     }
825   else if (lex_match (lexer, T_LBRACK))
826     {
827       if (lex_match_id (lexer, "LO"))
828         {
829           if (!lex_force_match_id (lexer, "THRU"))
830             return false;
831
832           if (lex_is_string (lexer))
833             {
834               struct substring low = { .string = NULL };
835               struct substring high = parse_substring (lexer, dict);
836               e = ctpo_cat_srange (low, high);
837             }
838           else
839             {
840               if (!lex_force_num (lexer))
841                 return false;
842               e = ctpo_cat_nrange (-DBL_MAX, lex_number (lexer));
843               lex_get (lexer);
844             }
845         }
846       else if (lex_is_number (lexer))
847         {
848           double number = lex_number (lexer);
849           lex_get (lexer);
850           if (lex_match_id (lexer, "THRU"))
851             {
852               if (lex_match_id (lexer, "HI"))
853                 e = ctpo_cat_nrange (number, DBL_MAX);
854               else
855                 {
856                   if (!lex_force_num (lexer))
857                     return false;
858                   e = ctpo_cat_nrange (number, lex_number (lexer));
859                   lex_get (lexer);
860                 }
861             }
862           else
863             e = (struct ctables_pcexpr) { .op = CTPO_CAT_NUMBER,
864                                           .number = number };
865         }
866       else if (lex_is_string (lexer))
867         {
868           struct substring s = parse_substring (lexer, dict);
869
870           if (lex_match_id (lexer, "THRU"))
871             {
872               struct substring high;
873
874               if (lex_match_id (lexer, "HI"))
875                 high = (struct substring) { .string = NULL };
876               else
877                 {
878                   if (!lex_force_string (lexer))
879                     {
880                       ss_dealloc (&s);
881                       return false;
882                     }
883                   high = parse_substring (lexer, dict);
884                 }
885
886               e = ctpo_cat_srange (s, high);
887             }
888           else
889             e = (struct ctables_pcexpr) { .op = CTPO_CAT_STRING, .string = s };
890         }
891       else
892         {
893           lex_error (lexer,
894                      _("Syntax error expecting number or string or range."));
895           return NULL;
896         }
897
898       if (!lex_force_match (lexer, T_RBRACK))
899         {
900           if (e.op == CTPO_CAT_STRING)
901             ss_dealloc (&e.string);
902           else if (e.op == CTPO_CAT_SRANGE)
903             {
904               ss_dealloc (&e.srange[0]);
905               ss_dealloc (&e.srange[1]);
906             }
907           return NULL;
908         }
909     }
910   else if (lex_match (lexer, T_LPAREN))
911     {
912       struct ctables_pcexpr *ep = ctables_pcexpr_parse_add (lexer, dict);
913       if (!ep)
914         return NULL;
915       if (!lex_force_match (lexer, T_RPAREN))
916         {
917           ctables_pcexpr_destroy (ep);
918           return NULL;
919         }
920       return ep;
921     }
922   else
923     {
924       lex_error (lexer, _("Syntax error in postcompute expression."));
925       return NULL;
926     }
927
928   e.location = lex_ofs_location (lexer, start_ofs, lex_ofs (lexer) - 1);
929   return xmemdup (&e, sizeof e);
930 }
931
932 static struct ctables_pcexpr *
933 ctables_pcexpr_allocate_neg (struct ctables_pcexpr *sub,
934                              struct lexer *lexer, int start_ofs)
935 {
936   struct ctables_pcexpr *e = xmalloc (sizeof *e);
937   *e = (struct ctables_pcexpr) {
938     .op = CTPO_NEG,
939     .subs = { sub },
940     .location = lex_ofs_location (lexer, start_ofs, lex_ofs (lexer) - 1),
941   };
942   return e;
943 }
944
945 static struct ctables_pcexpr *
946 ctables_pcexpr_parse_exp (struct lexer *lexer, struct dictionary *dict)
947 {
948   static const struct operator op = { T_EXP, CTPO_POW };
949
950   const char *chain_warning =
951     _("The exponentiation operator (`**') is left-associative: "
952       "`a**b**c' equals `(a**b)**c', not `a**(b**c)'.  "
953       "To disable this warning, insert parentheses.");
954
955   if (lex_token (lexer) != T_NEG_NUM || lex_next_token (lexer, 1) != T_EXP)
956     return ctables_pcexpr_parse_binary_operators (lexer, dict, &op, 1,
957                                                   ctables_pcexpr_parse_primary,
958                                                   chain_warning);
959
960   /* Special case for situations like "-5**6", which must be parsed as
961      -(5**6). */
962
963   int start_ofs = lex_ofs (lexer);
964   struct ctables_pcexpr *lhs = xmalloc (sizeof *lhs);
965   *lhs = (struct ctables_pcexpr) {
966     .op = CTPO_CONSTANT,
967     .number = -lex_tokval (lexer),
968     .location = lex_ofs_location (lexer, start_ofs, lex_ofs (lexer)),
969   };
970   lex_get (lexer);
971
972   struct ctables_pcexpr *node = ctables_pcexpr_parse_binary_operators__ (
973     lexer, dict, &op, 1,
974     ctables_pcexpr_parse_primary, chain_warning, lhs);
975   if (!node)
976     return NULL;
977
978   return ctables_pcexpr_allocate_neg (node, lexer, start_ofs);
979 }
980
981 /* Parses the unary minus level. */
982 static struct ctables_pcexpr *
983 ctables_pcexpr_parse_neg (struct lexer *lexer, struct dictionary *dict)
984 {
985   int start_ofs = lex_ofs (lexer);
986   if (!lex_match (lexer, T_DASH))
987     return ctables_pcexpr_parse_exp (lexer, dict);
988
989   struct ctables_pcexpr *inner = ctables_pcexpr_parse_neg (lexer, dict);
990   if (!inner)
991     return NULL;
992
993   return ctables_pcexpr_allocate_neg (inner, lexer, start_ofs);
994 }
995
996 /* Parses the multiplication and division level. */
997 static struct ctables_pcexpr *
998 ctables_pcexpr_parse_mul (struct lexer *lexer, struct dictionary *dict)
999 {
1000   static const struct operator ops[] =
1001     {
1002       { T_ASTERISK, CTPO_MUL },
1003       { T_SLASH, CTPO_DIV },
1004     };
1005
1006   return ctables_pcexpr_parse_binary_operators (lexer, dict, ops,
1007                                                sizeof ops / sizeof *ops,
1008                                                ctables_pcexpr_parse_neg, NULL);
1009 }
1010
1011 /* Parses the addition and subtraction level. */
1012 static struct ctables_pcexpr *
1013 ctables_pcexpr_parse_add (struct lexer *lexer, struct dictionary *dict)
1014 {
1015   static const struct operator ops[] =
1016     {
1017       { T_PLUS, CTPO_ADD },
1018       { T_DASH, CTPO_SUB },
1019       { T_NEG_NUM, CTPO_ADD },
1020     };
1021
1022   return ctables_pcexpr_parse_binary_operators (lexer, dict,
1023                                                ops, sizeof ops / sizeof *ops,
1024                                                ctables_pcexpr_parse_mul, NULL);
1025 }
1026 \f
1027 /* CTABLES axis expressions. */
1028
1029 /* CTABLES has a number of extra formats that we implement via custom
1030    currency specifications on an alternate fmt_settings. */
1031 #define CTEF_NEGPAREN FMT_CCA
1032 #define CTEF_NEQUAL   FMT_CCB
1033 #define CTEF_PAREN    FMT_CCC
1034 #define CTEF_PCTPAREN FMT_CCD
1035
1036 enum ctables_summary_variant
1037   {
1038     CSV_CELL,
1039     CSV_TOTAL
1040 #define N_CSVS 2
1041   };
1042
1043 struct ctables_axis
1044   {
1045     enum ctables_axis_op
1046       {
1047         /* Terminals. */
1048         CTAO_VAR,
1049
1050         /* Nonterminals. */
1051         CTAO_STACK,             /* + */
1052         CTAO_NEST,              /* > */
1053       }
1054     op;
1055
1056     union
1057       {
1058         /* Terminals. */
1059         struct
1060           {
1061             struct variable *var;
1062             bool scale;
1063             struct ctables_summary_spec_set specs[N_CSVS];
1064           };
1065
1066         /* Nonterminals. */
1067         struct ctables_axis *subs[2];
1068       };
1069
1070     struct msg_location *loc;
1071   };
1072
1073 static void
1074 ctables_axis_destroy (struct ctables_axis *axis)
1075 {
1076   if (!axis)
1077     return;
1078
1079   switch (axis->op)
1080     {
1081     case CTAO_VAR:
1082       for (size_t i = 0; i < N_CSVS; i++)
1083         ctables_summary_spec_set_uninit (&axis->specs[i]);
1084       break;
1085
1086     case CTAO_STACK:
1087     case CTAO_NEST:
1088       ctables_axis_destroy (axis->subs[0]);
1089       ctables_axis_destroy (axis->subs[1]);
1090       break;
1091     }
1092   msg_location_destroy (axis->loc);
1093   free (axis);
1094 }
1095
1096 static struct ctables_axis *
1097 ctables_axis_new_nonterminal (enum ctables_axis_op op,
1098                               struct ctables_axis *sub0,
1099                               struct ctables_axis *sub1,
1100                               struct lexer *lexer, int start_ofs)
1101 {
1102   struct ctables_axis *axis = xmalloc (sizeof *axis);
1103   *axis = (struct ctables_axis) {
1104     .op = op,
1105     .subs = { sub0, sub1 },
1106     .loc = lex_ofs_location (lexer, start_ofs, lex_ofs (lexer) - 1),
1107   };
1108   return axis;
1109 }
1110
1111 struct ctables_axis_parse_ctx
1112   {
1113     struct lexer *lexer;
1114     struct dictionary *dict;
1115   };
1116
1117 static struct pivot_value *
1118 ctables_summary_label (const struct ctables_summary_spec *spec, double cilevel)
1119 {
1120   if (!spec->label)
1121     return ctables_summary_function_label (spec->function, spec->weighting,
1122                                            spec->user_area, spec->percentile);
1123   else
1124     {
1125       struct substring in = ss_cstr (spec->label);
1126       struct substring target = ss_cstr (")CILEVEL");
1127
1128       struct string out = DS_EMPTY_INITIALIZER;
1129       for (;;)
1130         {
1131           size_t chunk = ss_find_substring (in, target);
1132           ds_put_substring (&out, ss_head (in, chunk));
1133           ss_advance (&in, chunk);
1134           if (!in.length)
1135             return pivot_value_new_user_text_nocopy (ds_steal_cstr (&out));
1136
1137           ss_advance (&in, target.length);
1138           ds_put_format (&out, "%g", cilevel);
1139         }
1140     }
1141 }
1142
1143 static bool
1144 add_summary_spec (struct ctables_axis *axis,
1145                   enum ctables_summary_function function,
1146                   enum ctables_weighting weighting,
1147                   enum ctables_area_type area, double percentile,
1148                   const char *label, const struct fmt_spec *format,
1149                   bool is_ctables_format, const struct msg_location *loc,
1150                   enum ctables_summary_variant sv)
1151 {
1152   if (axis->op == CTAO_VAR)
1153     {
1154       char function_name[128];
1155       ctables_summary_function_name (function, weighting, area,
1156                                      function_name, sizeof function_name);
1157       const char *var_name = var_get_name (axis->var);
1158       switch (ctables_function_availability (function))
1159         {
1160 #if 0
1161         case CTFA_MRSETS:
1162           msg_at (SE, loc, _("Summary function %s applies only to multiple "
1163                              "response sets."), function_name);
1164           msg_at (SN, axis->loc, _("'%s' is not a multiple response set."),
1165                   var_name);
1166           return false;
1167 #endif
1168
1169         case CTFA_SCALE:
1170           if (!axis->scale && sv != CSV_TOTAL)
1171             {
1172               msg_at (SE, loc,
1173                       _("Summary function %s applies only to scale variables."),
1174                       function_name);
1175               msg_at (SN, axis->loc, _("'%s' is not a scale variable."),
1176                       var_name);
1177               return false;
1178             }
1179           break;
1180
1181         case CTFA_ALL:
1182           break;
1183         }
1184
1185       struct ctables_summary_spec_set *set = &axis->specs[sv];
1186       if (set->n >= set->allocated)
1187         set->specs = x2nrealloc (set->specs, &set->allocated,
1188                                  sizeof *set->specs);
1189
1190       struct ctables_summary_spec *dst = &set->specs[set->n++];
1191       *dst = (struct ctables_summary_spec) {
1192         .function = function,
1193         .weighting = weighting,
1194         .calc_area = area,
1195         .user_area = area,
1196         .percentile = percentile,
1197         .label = xstrdup_if_nonnull (label),
1198         .format = (format ? *format
1199                    : ctables_summary_default_format (function, axis->var)),
1200         .is_ctables_format = is_ctables_format,
1201       };
1202       return true;
1203     }
1204   else
1205     {
1206       for (size_t i = 0; i < 2; i++)
1207         if (!add_summary_spec (axis->subs[i], function, weighting, area,
1208                                percentile, label, format, is_ctables_format,
1209                                loc, sv))
1210           return false;
1211       return true;
1212     }
1213 }
1214
1215 static struct ctables_axis *ctables_axis_parse_stack (
1216   struct ctables_axis_parse_ctx *);
1217
1218 static struct ctables_axis *
1219 ctables_axis_parse_primary (struct ctables_axis_parse_ctx *ctx)
1220 {
1221   if (lex_match (ctx->lexer, T_LPAREN))
1222     {
1223       struct ctables_axis *sub = ctables_axis_parse_stack (ctx);
1224       if (!sub || !lex_force_match (ctx->lexer, T_RPAREN))
1225         {
1226           ctables_axis_destroy (sub);
1227           return NULL;
1228         }
1229       return sub;
1230     }
1231
1232   if (!lex_force_id (ctx->lexer))
1233     return NULL;
1234
1235   if (lex_tokcstr (ctx->lexer)[0] == '$')
1236     {
1237       lex_error (ctx->lexer,
1238                  _("Multiple response set support not implemented."));
1239       return NULL;
1240     }
1241
1242   int start_ofs = lex_ofs (ctx->lexer);
1243   struct variable *var = parse_variable (ctx->lexer, ctx->dict);
1244   if (!var)
1245     return NULL;
1246
1247   struct ctables_axis *axis = xmalloc (sizeof *axis);
1248   *axis = (struct ctables_axis) { .op = CTAO_VAR, .var = var };
1249
1250   axis->scale = (lex_match_phrase (ctx->lexer, "[S]") ? true
1251                  : lex_match_phrase (ctx->lexer, "[C]") ? false
1252                  : var_get_measure (var) == MEASURE_SCALE);
1253   axis->loc = lex_ofs_location (ctx->lexer, start_ofs,
1254                                 lex_ofs (ctx->lexer) - 1);
1255   if (axis->scale && var_is_alpha (var))
1256     {
1257       msg_at (SE, axis->loc, _("Cannot use string variable %s as a scale "
1258                                "variable."),
1259               var_get_name (var));
1260       ctables_axis_destroy (axis);
1261       return NULL;
1262     }
1263
1264   return axis;
1265 }
1266
1267 static bool
1268 has_digit (const char *s)
1269 {
1270   return s[strcspn (s, "0123456789")] != '\0';
1271 }
1272
1273 static bool
1274 parse_ctables_format_specifier (struct lexer *lexer, struct fmt_spec *format,
1275                                 bool *is_ctables_format)
1276 {
1277   char type[FMT_TYPE_LEN_MAX + 1];
1278   if (!parse_abstract_format_specifier__ (lexer, type, &format->w, &format->d))
1279     return false;
1280
1281   if (!strcasecmp (type, "NEGPAREN"))
1282     format->type = CTEF_NEGPAREN;
1283   else if (!strcasecmp (type, "NEQUAL"))
1284     format->type = CTEF_NEQUAL;
1285   else if (!strcasecmp (type, "PAREN"))
1286     format->type = CTEF_PAREN;
1287   else if (!strcasecmp (type, "PCTPAREN"))
1288     format->type = CTEF_PCTPAREN;
1289   else
1290     {
1291       *is_ctables_format = false;
1292       if (!parse_format_specifier (lexer, format))
1293         return false;
1294
1295       char *error = fmt_check_output__ (format);
1296       if (!error)
1297         error = fmt_check_type_compat__ (format, NULL, VAL_NUMERIC);
1298       if (error)
1299         {
1300           lex_next_error (lexer, -1, -1, "%s", error);
1301           free (error);
1302           return false;
1303         }
1304
1305       return true;
1306     }
1307
1308   lex_get (lexer);
1309   if (format->w < 2)
1310     {
1311       lex_next_error (lexer, -1, -1,
1312                       _("Output format %s requires width 2 or greater."), type);
1313       return false;
1314     }
1315   else if (format->d > format->w - 1)
1316     {
1317       lex_next_error (lexer, -1, -1, _("Output format %s requires width "
1318                                        "greater than decimals."), type);
1319       return false;
1320     }
1321   else
1322     {
1323       *is_ctables_format = true;
1324       return true;
1325     }
1326 }
1327
1328 static struct ctables_axis *
1329 ctables_axis_parse_postfix (struct ctables_axis_parse_ctx *ctx)
1330 {
1331   struct ctables_axis *sub = ctables_axis_parse_primary (ctx);
1332   if (!sub || !lex_match (ctx->lexer, T_LBRACK))
1333     return sub;
1334
1335   enum ctables_summary_variant sv = CSV_CELL;
1336   for (;;)
1337     {
1338       int start_ofs = lex_ofs (ctx->lexer);
1339
1340       /* Parse function. */
1341       enum ctables_summary_function function;
1342       enum ctables_weighting weighting;
1343       enum ctables_area_type area;
1344       if (!parse_ctables_summary_function (ctx->lexer, &function, &weighting,
1345                                            &area))
1346         goto error;
1347
1348       /* Parse percentile. */
1349       double percentile = 0;
1350       if (function == CTSF_PTILE)
1351         {
1352           if (!lex_force_num_range_closed (ctx->lexer, "PTILE", 0, 100))
1353             goto error;
1354           percentile = lex_number (ctx->lexer);
1355           lex_get (ctx->lexer);
1356         }
1357
1358       /* Parse label. */
1359       char *label = NULL;
1360       if (lex_is_string (ctx->lexer))
1361         {
1362           label = ss_xstrdup (lex_tokss (ctx->lexer));
1363           lex_get (ctx->lexer);
1364         }
1365
1366       /* Parse format. */
1367       struct fmt_spec format;
1368       const struct fmt_spec *formatp;
1369       bool is_ctables_format = false;
1370       if (lex_token (ctx->lexer) == T_ID
1371           && has_digit (lex_tokcstr (ctx->lexer)))
1372         {
1373           if (!parse_ctables_format_specifier (ctx->lexer, &format,
1374                                                &is_ctables_format))
1375             {
1376               free (label);
1377               goto error;
1378             }
1379           formatp = &format;
1380         }
1381       else
1382         formatp = NULL;
1383
1384       struct msg_location *loc = lex_ofs_location (ctx->lexer, start_ofs,
1385                                                    lex_ofs (ctx->lexer) - 1);
1386       add_summary_spec (sub, function, weighting, area, percentile, label,
1387                         formatp, is_ctables_format, loc, sv);
1388       free (label);
1389       msg_location_destroy (loc);
1390
1391       lex_match (ctx->lexer, T_COMMA);
1392       if (sv == CSV_CELL && lex_match_id (ctx->lexer, "TOTALS"))
1393         {
1394           if (!lex_force_match (ctx->lexer, T_LBRACK))
1395             goto error;
1396           sv = CSV_TOTAL;
1397         }
1398       else if (lex_match (ctx->lexer, T_RBRACK))
1399         {
1400           if (sv == CSV_TOTAL && !lex_force_match (ctx->lexer, T_RBRACK))
1401             goto error;
1402           return sub;
1403         }
1404     }
1405
1406 error:
1407   ctables_axis_destroy (sub);
1408   return NULL;
1409 }
1410
1411 static const struct ctables_axis *
1412 find_scale (const struct ctables_axis *axis)
1413 {
1414   if (!axis)
1415     return NULL;
1416   else if (axis->op == CTAO_VAR)
1417     return axis->scale ? axis : NULL;
1418   else
1419     {
1420       for (size_t i = 0; i < 2; i++)
1421         {
1422           const struct ctables_axis *scale = find_scale (axis->subs[i]);
1423           if (scale)
1424             return scale;
1425         }
1426       return NULL;
1427     }
1428 }
1429
1430 static const struct ctables_axis *
1431 find_categorical_summary_spec (const struct ctables_axis *axis)
1432 {
1433   if (!axis)
1434     return NULL;
1435   else if (axis->op == CTAO_VAR)
1436     return !axis->scale && axis->specs[CSV_CELL].n ? axis : NULL;
1437   else
1438     {
1439       for (size_t i = 0; i < 2; i++)
1440         {
1441           const struct ctables_axis *sum
1442             = find_categorical_summary_spec (axis->subs[i]);
1443           if (sum)
1444             return sum;
1445         }
1446       return NULL;
1447     }
1448 }
1449
1450 static struct ctables_axis *
1451 ctables_axis_parse_nest (struct ctables_axis_parse_ctx *ctx)
1452 {
1453   int start_ofs = lex_ofs (ctx->lexer);
1454   struct ctables_axis *lhs = ctables_axis_parse_postfix (ctx);
1455   if (!lhs)
1456     return NULL;
1457
1458   while (lex_match (ctx->lexer, T_GT))
1459     {
1460       struct ctables_axis *rhs = ctables_axis_parse_postfix (ctx);
1461       if (!rhs)
1462         {
1463           ctables_axis_destroy (lhs);
1464           return NULL;
1465         }
1466
1467       struct ctables_axis *nest = ctables_axis_new_nonterminal (
1468         CTAO_NEST, lhs, rhs, ctx->lexer, start_ofs);
1469
1470       const struct ctables_axis *outer_scale = find_scale (lhs);
1471       const struct ctables_axis *inner_scale = find_scale (rhs);
1472       if (outer_scale && inner_scale)
1473         {
1474           msg_at (SE, nest->loc, _("Cannot nest scale variables."));
1475           msg_at (SN, outer_scale->loc, _("This is an outer scale variable."));
1476           msg_at (SN, inner_scale->loc, _("This is an inner scale variable."));
1477           ctables_axis_destroy (nest);
1478           return NULL;
1479         }
1480
1481       const struct ctables_axis *outer_sum = find_categorical_summary_spec (lhs);
1482       if (outer_sum)
1483         {
1484           msg_at (SE, nest->loc,
1485                   _("Summaries may only be requested for categorical variables "
1486                     "at the innermost nesting level."));
1487           msg_at (SN, outer_sum->loc,
1488                   _("This outer categorical variable has a summary."));
1489           ctables_axis_destroy (nest);
1490           return NULL;
1491         }
1492
1493       lhs = nest;
1494     }
1495
1496   return lhs;
1497 }
1498
1499 static struct ctables_axis *
1500 ctables_axis_parse_stack (struct ctables_axis_parse_ctx *ctx)
1501 {
1502   int start_ofs = lex_ofs (ctx->lexer);
1503   struct ctables_axis *lhs = ctables_axis_parse_nest (ctx);
1504   if (!lhs)
1505     return NULL;
1506
1507   while (lex_match (ctx->lexer, T_PLUS))
1508     {
1509       struct ctables_axis *rhs = ctables_axis_parse_nest (ctx);
1510       if (!rhs)
1511         {
1512           ctables_axis_destroy (lhs);
1513           return NULL;
1514         }
1515
1516       lhs = ctables_axis_new_nonterminal (CTAO_STACK, lhs, rhs,
1517                                           ctx->lexer, start_ofs);
1518     }
1519
1520   return lhs;
1521 }
1522
1523 static bool
1524 ctables_axis_parse (struct lexer *lexer, struct dictionary *dict,
1525                     struct ctables_axis **axisp)
1526 {
1527   *axisp = NULL;
1528   if (lex_token (lexer) == T_BY
1529       || lex_token (lexer) == T_SLASH
1530       || lex_token (lexer) == T_ENDCMD)
1531     return true;
1532
1533   struct ctables_axis_parse_ctx ctx = {
1534     .lexer = lexer,
1535     .dict = dict,
1536   };
1537   *axisp = ctables_axis_parse_stack (&ctx);
1538   return *axisp;
1539 }
1540 \f
1541 /* CTABLES categories. */
1542
1543 struct ctables_categories
1544   {
1545     size_t n_refs;
1546     struct ctables_category *cats;
1547     size_t n_cats;
1548   };
1549
1550 struct ctables_category
1551   {
1552     enum ctables_category_type
1553       {
1554         /* Explicit category lists. */
1555         CCT_NUMBER,
1556         CCT_STRING,
1557         CCT_NRANGE,             /* Numerical range. */
1558         CCT_SRANGE,             /* String range. */
1559         CCT_MISSING,
1560         CCT_OTHERNM,
1561         CCT_POSTCOMPUTE,
1562
1563         /* Totals and subtotals. */
1564         CCT_SUBTOTAL,
1565         CCT_TOTAL,
1566
1567         /* Implicit category lists. */
1568         CCT_VALUE,
1569         CCT_LABEL,
1570         CCT_FUNCTION,
1571
1572         /* For contributing to TOTALN. */
1573         CCT_EXCLUDED_MISSING,
1574       }
1575     type;
1576
1577     struct ctables_category *subtotal;
1578
1579     bool hide;
1580
1581     union
1582       {
1583         double number;           /* CCT_NUMBER. */
1584         struct substring string; /* CCT_STRING, in dictionary encoding. */
1585         double nrange[2];        /* CCT_NRANGE. */
1586         struct substring srange[2]; /* CCT_SRANGE. */
1587
1588         struct
1589           {
1590             char *total_label;      /* CCT_SUBTOTAL, CCT_TOTAL. */
1591             bool hide_subcategories; /* CCT_SUBTOTAL. */
1592           };
1593
1594         /* CCT_POSTCOMPUTE. */
1595         struct
1596           {
1597             const struct ctables_postcompute *pc;
1598             enum fmt_type parse_format;
1599           };
1600
1601         /* CCT_VALUE, CCT_LABEL, CCT_FUNCTION. */
1602         struct
1603           {
1604             bool include_missing;
1605             bool sort_ascending;
1606
1607             /* CCT_FUNCTION. */
1608             enum ctables_summary_function sort_function;
1609             enum ctables_weighting weighting;
1610             enum ctables_area_type area;
1611             struct variable *sort_var;
1612             double percentile;
1613           };
1614       };
1615
1616     /* Source location (sometimes NULL). */
1617     struct msg_location *location;
1618   };
1619
1620 static void
1621 ctables_category_uninit (struct ctables_category *cat)
1622 {
1623   if (!cat)
1624     return;
1625
1626   msg_location_destroy (cat->location);
1627   switch (cat->type)
1628     {
1629     case CCT_NUMBER:
1630     case CCT_NRANGE:
1631     case CCT_MISSING:
1632     case CCT_OTHERNM:
1633     case CCT_POSTCOMPUTE:
1634       break;
1635
1636     case CCT_STRING:
1637       ss_dealloc (&cat->string);
1638       break;
1639
1640     case CCT_SRANGE:
1641       ss_dealloc (&cat->srange[0]);
1642       ss_dealloc (&cat->srange[1]);
1643       break;
1644
1645     case CCT_SUBTOTAL:
1646     case CCT_TOTAL:
1647       free (cat->total_label);
1648       break;
1649
1650     case CCT_VALUE:
1651     case CCT_LABEL:
1652     case CCT_FUNCTION:
1653       break;
1654
1655     case CCT_EXCLUDED_MISSING:
1656       break;
1657     }
1658 }
1659
1660 static bool
1661 nullable_substring_equal (const struct substring *a,
1662                           const struct substring *b)
1663 {
1664   return !a->string ? !b->string : b->string && ss_equals (*a, *b);
1665 }
1666
1667 static bool
1668 ctables_category_equal (const struct ctables_category *a,
1669                         const struct ctables_category *b)
1670 {
1671   if (a->type != b->type)
1672     return false;
1673
1674   switch (a->type)
1675     {
1676     case CCT_NUMBER:
1677       return a->number == b->number;
1678
1679     case CCT_STRING:
1680       return ss_equals (a->string, b->string);
1681
1682     case CCT_NRANGE:
1683       return a->nrange[0] == b->nrange[0] && a->nrange[1] == b->nrange[1];
1684
1685     case CCT_SRANGE:
1686       return (nullable_substring_equal (&a->srange[0], &b->srange[0])
1687               && nullable_substring_equal (&a->srange[1], &b->srange[1]));
1688
1689     case CCT_MISSING:
1690     case CCT_OTHERNM:
1691       return true;
1692
1693     case CCT_POSTCOMPUTE:
1694       return a->pc == b->pc;
1695
1696     case CCT_SUBTOTAL:
1697     case CCT_TOTAL:
1698       return !strcmp (a->total_label, b->total_label);
1699
1700     case CCT_VALUE:
1701     case CCT_LABEL:
1702     case CCT_FUNCTION:
1703       return (a->include_missing == b->include_missing
1704               && a->sort_ascending == b->sort_ascending
1705               && a->sort_function == b->sort_function
1706               && a->sort_var == b->sort_var
1707               && a->percentile == b->percentile);
1708
1709     case CCT_EXCLUDED_MISSING:
1710       return true;
1711     }
1712
1713   NOT_REACHED ();
1714 }
1715
1716 static void
1717 ctables_categories_unref (struct ctables_categories *c)
1718 {
1719   if (!c)
1720     return;
1721
1722   assert (c->n_refs > 0);
1723   if (--c->n_refs)
1724     return;
1725
1726   for (size_t i = 0; i < c->n_cats; i++)
1727     ctables_category_uninit (&c->cats[i]);
1728   free (c->cats);
1729   free (c);
1730 }
1731
1732 static bool
1733 ctables_categories_equal (const struct ctables_categories *a,
1734                           const struct ctables_categories *b)
1735 {
1736   if (a->n_cats != b->n_cats)
1737     return false;
1738
1739   for (size_t i = 0; i < a->n_cats; i++)
1740     if (!ctables_category_equal (&a->cats[i], &b->cats[i]))
1741       return false;
1742
1743   return true;
1744 }
1745
1746 static struct ctables_category
1747 cct_nrange (double low, double high)
1748 {
1749   return (struct ctables_category) {
1750     .type = CCT_NRANGE,
1751     .nrange = { low, high }
1752   };
1753 }
1754
1755 static struct ctables_category
1756 cct_srange (struct substring low, struct substring high)
1757 {
1758   return (struct ctables_category) {
1759     .type = CCT_SRANGE,
1760     .srange = { low, high }
1761   };
1762 }
1763
1764 static bool
1765 ctables_table_parse_subtotal (struct lexer *lexer, bool hide_subcategories,
1766                               struct ctables_category *cat)
1767 {
1768   char *total_label;
1769   if (lex_match (lexer, T_EQUALS))
1770     {
1771       if (!lex_force_string (lexer))
1772         return false;
1773
1774       total_label = ss_xstrdup (lex_tokss (lexer));
1775       lex_get (lexer);
1776     }
1777   else
1778     total_label = xstrdup (_("Subtotal"));
1779
1780   *cat = (struct ctables_category) {
1781     .type = CCT_SUBTOTAL,
1782     .hide_subcategories = hide_subcategories,
1783     .total_label = total_label
1784   };
1785   return true;
1786 }
1787
1788 static bool
1789 ctables_table_parse_explicit_category (struct lexer *lexer,
1790                                        struct dictionary *dict,
1791                                        struct ctables *ct,
1792                                        struct ctables_category *cat)
1793 {
1794   if (lex_match_id (lexer, "OTHERNM"))
1795     *cat = (struct ctables_category) { .type = CCT_OTHERNM };
1796   else if (lex_match_id (lexer, "MISSING"))
1797     *cat = (struct ctables_category) { .type = CCT_MISSING };
1798   else if (lex_match_id (lexer, "SUBTOTAL"))
1799     return ctables_table_parse_subtotal (lexer, false, cat);
1800   else if (lex_match_id (lexer, "HSUBTOTAL"))
1801     return ctables_table_parse_subtotal (lexer, true, cat);
1802   else if (lex_match_id (lexer, "LO"))
1803     {
1804       if (!lex_force_match_id (lexer, "THRU"))
1805         return false;
1806       if (lex_is_string (lexer))
1807         {
1808           struct substring sr0 = { .string = NULL };
1809           struct substring sr1 = parse_substring (lexer, dict);
1810           *cat = cct_srange (sr0, sr1);
1811         }
1812       else if (lex_force_num (lexer))
1813         {
1814           *cat = cct_nrange (-DBL_MAX, lex_number (lexer));
1815           lex_get (lexer);
1816         }
1817       else
1818         return false;
1819     }
1820   else if (lex_is_number (lexer))
1821     {
1822       double number = lex_number (lexer);
1823       lex_get (lexer);
1824       if (lex_match_id (lexer, "THRU"))
1825         {
1826           if (lex_match_id (lexer, "HI"))
1827             *cat = cct_nrange (number, DBL_MAX);
1828           else
1829             {
1830               if (!lex_force_num (lexer))
1831                 return false;
1832               *cat = cct_nrange (number, lex_number (lexer));
1833               lex_get (lexer);
1834             }
1835         }
1836       else
1837         *cat = (struct ctables_category) {
1838           .type = CCT_NUMBER,
1839           .number = number
1840         };
1841     }
1842   else if (lex_is_string (lexer))
1843     {
1844       struct substring s = parse_substring (lexer, dict);
1845       if (lex_match_id (lexer, "THRU"))
1846         {
1847           if (lex_match_id (lexer, "HI"))
1848             {
1849               struct substring sr1 = { .string = NULL };
1850               *cat = cct_srange (s, sr1);
1851             }
1852           else
1853             {
1854               if (!lex_force_string (lexer))
1855                 {
1856                   ss_dealloc (&s);
1857                   return false;
1858                 }
1859               struct substring sr1 = parse_substring (lexer, dict);
1860               *cat = cct_srange (s, sr1);
1861             }
1862         }
1863       else
1864         *cat = (struct ctables_category) { .type = CCT_STRING, .string = s };
1865     }
1866   else if (lex_match (lexer, T_AND))
1867     {
1868       if (!lex_force_id (lexer))
1869         return false;
1870       struct ctables_postcompute *pc = ctables_find_postcompute (
1871         ct, lex_tokcstr (lexer));
1872       if (!pc)
1873         {
1874           struct msg_location *loc = lex_get_location (lexer, -1, 0);
1875           msg_at (SE, loc, _("Unknown postcompute &%s."),
1876                   lex_tokcstr (lexer));
1877           msg_location_destroy (loc);
1878           return false;
1879         }
1880       lex_get (lexer);
1881
1882       *cat = (struct ctables_category) { .type = CCT_POSTCOMPUTE, .pc = pc };
1883     }
1884   else
1885     {
1886       lex_error (lexer, _("Syntax error expecting category specification."));
1887       return false;
1888     }
1889
1890   return true;
1891 }
1892
1893 static bool
1894 parse_category_string (struct msg_location *location,
1895                        struct substring s, const struct dictionary *dict,
1896                        enum fmt_type format, double *n)
1897 {
1898   union value v;
1899   char *error = data_in (s, dict_get_encoding (dict), format,
1900                          settings_get_fmt_settings (), &v, 0, NULL);
1901   if (error)
1902     {
1903       msg_at (SE, location,
1904               _("Failed to parse category specification as format %s: %s."),
1905               fmt_name (format), error);
1906       free (error);
1907       return false;
1908     }
1909
1910   *n = v.f;
1911   return true;
1912 }
1913
1914 static struct ctables_category *
1915 ctables_find_category_for_postcompute__ (const struct ctables_categories *cats,
1916                                          const struct ctables_pcexpr *e)
1917 {
1918   struct ctables_category *best = NULL;
1919   size_t n_subtotals = 0;
1920   for (size_t i = 0; i < cats->n_cats; i++)
1921     {
1922       struct ctables_category *cat = &cats->cats[i];
1923       switch (e->op)
1924         {
1925         case CTPO_CAT_NUMBER:
1926           if (cat->type == CCT_NUMBER && cat->number == e->number)
1927             best = cat;
1928           break;
1929
1930         case CTPO_CAT_STRING:
1931           if (cat->type == CCT_STRING && ss_equals (cat->string, e->string))
1932             best = cat;
1933           break;
1934
1935         case CTPO_CAT_NRANGE:
1936           if (cat->type == CCT_NRANGE
1937               && cat->nrange[0] == e->nrange[0]
1938               && cat->nrange[1] == e->nrange[1])
1939             best = cat;
1940           break;
1941
1942         case CTPO_CAT_SRANGE:
1943           if (cat->type == CCT_SRANGE
1944               && nullable_substring_equal (&cat->srange[0], &e->srange[0])
1945               && nullable_substring_equal (&cat->srange[1], &e->srange[1]))
1946             best = cat;
1947           break;
1948
1949         case CTPO_CAT_MISSING:
1950           if (cat->type == CCT_MISSING)
1951             best = cat;
1952           break;
1953
1954         case CTPO_CAT_OTHERNM:
1955           if (cat->type == CCT_OTHERNM)
1956             best = cat;
1957           break;
1958
1959         case CTPO_CAT_SUBTOTAL:
1960           if (cat->type == CCT_SUBTOTAL)
1961             {
1962               n_subtotals++;
1963               if (e->subtotal_index == n_subtotals)
1964                 return cat;
1965               else if (e->subtotal_index == 0)
1966                 best = cat;
1967             }
1968           break;
1969
1970         case CTPO_CAT_TOTAL:
1971           if (cat->type == CCT_TOTAL)
1972             return cat;
1973           break;
1974
1975         case CTPO_CONSTANT:
1976         case CTPO_ADD:
1977         case CTPO_SUB:
1978         case CTPO_MUL:
1979         case CTPO_DIV:
1980         case CTPO_POW:
1981         case CTPO_NEG:
1982           NOT_REACHED ();
1983         }
1984     }
1985   if (e->op == CTPO_CAT_SUBTOTAL && e->subtotal_index == 0 && n_subtotals > 1)
1986     return NULL;
1987   return best;
1988 }
1989
1990 static struct ctables_category *
1991 ctables_find_category_for_postcompute (const struct dictionary *dict,
1992                                        const struct ctables_categories *cats,
1993                                        enum fmt_type parse_format,
1994                                        const struct ctables_pcexpr *e)
1995 {
1996   if (parse_format != FMT_F)
1997     {
1998       if (e->op == CTPO_CAT_STRING)
1999         {
2000           double number;
2001           if (!parse_category_string (e->location, e->string, dict,
2002                                       parse_format, &number))
2003             return NULL;
2004
2005           struct ctables_pcexpr e2 = {
2006             .op = CTPO_CAT_NUMBER,
2007             .number = number,
2008             .location = e->location,
2009           };
2010           return ctables_find_category_for_postcompute__ (cats, &e2);
2011         }
2012       else if (e->op == CTPO_CAT_SRANGE)
2013         {
2014           double nrange[2];
2015           if (!e->srange[0].string)
2016             nrange[0] = -DBL_MAX;
2017           else if (!parse_category_string (e->location, e->srange[0], dict,
2018                                            parse_format, &nrange[0]))
2019             return NULL;
2020
2021           if (!e->srange[1].string)
2022             nrange[1] = DBL_MAX;
2023           else if (!parse_category_string (e->location, e->srange[1], dict,
2024                                            parse_format, &nrange[1]))
2025             return NULL;
2026
2027           struct ctables_pcexpr e2 = {
2028             .op = CTPO_CAT_NRANGE,
2029             .nrange = { nrange[0], nrange[1] },
2030             .location = e->location,
2031           };
2032           return ctables_find_category_for_postcompute__ (cats, &e2);
2033         }
2034     }
2035   return ctables_find_category_for_postcompute__ (cats, e);
2036 }
2037
2038 static struct substring
2039 rtrim_value (const union value *v, const struct variable *var)
2040 {
2041   struct substring s = ss_buffer (CHAR_CAST (char *, v->s),
2042                                   var_get_width (var));
2043   ss_rtrim (&s, ss_cstr (" "));
2044   return s;
2045 }
2046
2047 static bool
2048 in_string_range (const union value *v, const struct variable *var,
2049                  const struct substring *srange)
2050 {
2051   struct substring s = rtrim_value (v, var);
2052   return ((!srange[0].string || ss_compare (s, srange[0]) >= 0)
2053           && (!srange[1].string || ss_compare (s, srange[1]) <= 0));
2054 }
2055
2056 static const struct ctables_category *
2057 ctables_categories_match (const struct ctables_categories *c,
2058                           const union value *v, const struct variable *var)
2059 {
2060   if (var_is_numeric (var) && v->f == SYSMIS)
2061     return NULL;
2062
2063   const struct ctables_category *othernm = NULL;
2064   for (size_t i = c->n_cats; i-- > 0; )
2065     {
2066       const struct ctables_category *cat = &c->cats[i];
2067       switch (cat->type)
2068         {
2069         case CCT_NUMBER:
2070           if (cat->number == v->f)
2071             return cat;
2072           break;
2073
2074         case CCT_STRING:
2075           if (ss_equals (cat->string, rtrim_value (v, var)))
2076             return cat;
2077           break;
2078
2079         case CCT_NRANGE:
2080           if ((cat->nrange[0] == -DBL_MAX || v->f >= cat->nrange[0])
2081               && (cat->nrange[1] == DBL_MAX || v->f <= cat->nrange[1]))
2082             return cat;
2083           break;
2084
2085         case CCT_SRANGE:
2086           if (in_string_range (v, var, cat->srange))
2087             return cat;
2088           break;
2089
2090         case CCT_MISSING:
2091           if (var_is_value_missing (var, v))
2092             return cat;
2093           break;
2094
2095         case CCT_POSTCOMPUTE:
2096           break;
2097
2098         case CCT_OTHERNM:
2099           if (!othernm)
2100             othernm = cat;
2101           break;
2102
2103         case CCT_SUBTOTAL:
2104         case CCT_TOTAL:
2105           break;
2106
2107         case CCT_VALUE:
2108         case CCT_LABEL:
2109         case CCT_FUNCTION:
2110           return (cat->include_missing || !var_is_value_missing (var, v) ? cat
2111                   : NULL);
2112
2113         case CCT_EXCLUDED_MISSING:
2114           break;
2115         }
2116     }
2117
2118   return var_is_value_missing (var, v) ? NULL : othernm;
2119 }
2120
2121 static const struct ctables_category *
2122 ctables_categories_total (const struct ctables_categories *c)
2123 {
2124   const struct ctables_category *first = &c->cats[0];
2125   const struct ctables_category *last = &c->cats[c->n_cats - 1];
2126   return (first->type == CCT_TOTAL ? first
2127           : last->type == CCT_TOTAL ? last
2128           : NULL);
2129 }
2130
2131 static void
2132 ctables_category_format_number (double number, const struct variable *var,
2133                                 struct string *s)
2134 {
2135   struct pivot_value *pv = pivot_value_new_var_value (
2136     var, &(union value) { .f = number });
2137   pivot_value_format (pv, NULL, s);
2138   pivot_value_destroy (pv);
2139 }
2140
2141 static void
2142 ctables_category_format_string (struct substring string,
2143                                 const struct variable *var, struct string *out)
2144 {
2145   int width = var_get_width (var);
2146   char *s = xmalloc (width);
2147   buf_copy_rpad (s, width, string.string, string.length, ' ');
2148   struct pivot_value *pv = pivot_value_new_var_value (
2149     var, &(union value) { .s = CHAR_CAST (uint8_t *, s) });
2150   pivot_value_format (pv, NULL, out);
2151   pivot_value_destroy (pv);
2152   free (s);
2153 }
2154
2155 static bool
2156 ctables_category_format_label (const struct ctables_category *cat,
2157                                const struct variable *var,
2158                                struct string *s)
2159 {
2160   switch (cat->type)
2161     {
2162     case CCT_NUMBER:
2163       ctables_category_format_number (cat->number, var, s);
2164       return true;
2165
2166     case CCT_STRING:
2167       ctables_category_format_string (cat->string, var, s);
2168       return true;
2169
2170     case CCT_NRANGE:
2171       ctables_category_format_number (cat->nrange[0], var, s);
2172       ds_put_format (s, " THRU ");
2173       ctables_category_format_number (cat->nrange[1], var, s);
2174       return true;
2175
2176     case CCT_SRANGE:
2177       ctables_category_format_string (cat->srange[0], var, s);
2178       ds_put_format (s, " THRU ");
2179       ctables_category_format_string (cat->srange[1], var, s);
2180       return true;
2181
2182     case CCT_MISSING:
2183       ds_put_cstr (s, "MISSING");
2184       return true;
2185
2186     case CCT_OTHERNM:
2187       ds_put_cstr (s, "OTHERNM");
2188       return true;
2189
2190     case CCT_POSTCOMPUTE:
2191       ds_put_format (s, "&%s", cat->pc->name);
2192       return true;
2193
2194     case CCT_TOTAL:
2195     case CCT_SUBTOTAL:
2196       ds_put_cstr (s, cat->total_label);
2197       return true;
2198
2199     case CCT_VALUE:
2200     case CCT_LABEL:
2201     case CCT_FUNCTION:
2202     case CCT_EXCLUDED_MISSING:
2203       return false;
2204     }
2205
2206   return false;
2207 }
2208
2209 static bool
2210 ctables_recursive_check_postcompute (struct dictionary *dict,
2211                                      const struct ctables_pcexpr *e,
2212                                      struct ctables_category *pc_cat,
2213                                      const struct ctables_categories *cats,
2214                                      const struct msg_location *cats_location)
2215 {
2216   switch (e->op)
2217     {
2218     case CTPO_CAT_NUMBER:
2219     case CTPO_CAT_STRING:
2220     case CTPO_CAT_NRANGE:
2221     case CTPO_CAT_SRANGE:
2222     case CTPO_CAT_MISSING:
2223     case CTPO_CAT_OTHERNM:
2224     case CTPO_CAT_SUBTOTAL:
2225     case CTPO_CAT_TOTAL:
2226       {
2227         struct ctables_category *cat = ctables_find_category_for_postcompute (
2228           dict, cats, pc_cat->parse_format, e);
2229         if (!cat)
2230           {
2231             if (e->op == CTPO_CAT_SUBTOTAL && e->subtotal_index == 0)
2232               {
2233                 size_t n_subtotals = 0;
2234                 for (size_t i = 0; i < cats->n_cats; i++)
2235                   n_subtotals += cats->cats[i].type == CCT_SUBTOTAL;
2236                 if (n_subtotals > 1)
2237                   {
2238                     msg_at (SE, cats_location,
2239                             ngettext ("These categories include %zu instance "
2240                                       "of SUBTOTAL or HSUBTOTAL, so references "
2241                                       "from computed categories must refer to "
2242                                       "subtotals by position, "
2243                                       "e.g. SUBTOTAL[1].",
2244                                       "These categories include %zu instances "
2245                                       "of SUBTOTAL or HSUBTOTAL, so references "
2246                                       "from computed categories must refer to "
2247                                       "subtotals by position, "
2248                                       "e.g. SUBTOTAL[1].",
2249                                       n_subtotals),
2250                             n_subtotals);
2251                     msg_at (SN, e->location,
2252                             _("This is the reference that lacks a position."));
2253                     return NULL;
2254                   }
2255               }
2256
2257             msg_at (SE, pc_cat->location,
2258                     _("Computed category &%s references a category not included "
2259                       "in the category list."),
2260                     pc_cat->pc->name);
2261             msg_at (SN, e->location, _("This is the missing category."));
2262             if (e->op == CTPO_CAT_SUBTOTAL)
2263               msg_at (SN, cats_location,
2264                       _("To fix the problem, add subtotals to the "
2265                         "list of categories here."));
2266             else if (e->op == CTPO_CAT_TOTAL)
2267               msg (SN, _("To fix the problem, add TOTAL=YES to the variable's "
2268                          "CATEGORIES specification."));
2269             else
2270               msg_at (SN, cats_location,
2271                       _("To fix the problem, add the missing category to the "
2272                         "list of categories here."));
2273             return false;
2274           }
2275         if (pc_cat->pc->hide_source_cats)
2276           cat->hide = true;
2277         return true;
2278       }
2279
2280     case CTPO_CONSTANT:
2281       return true;
2282
2283     case CTPO_ADD:
2284     case CTPO_SUB:
2285     case CTPO_MUL:
2286     case CTPO_DIV:
2287     case CTPO_POW:
2288     case CTPO_NEG:
2289       for (size_t i = 0; i < 2; i++)
2290         if (e->subs[i] && !ctables_recursive_check_postcompute (
2291               dict, e->subs[i], pc_cat, cats, cats_location))
2292           return false;
2293       return true;
2294     }
2295
2296   NOT_REACHED ();
2297 }
2298
2299 static struct pivot_value *
2300 ctables_postcompute_label (const struct ctables_categories *cats,
2301                            const struct ctables_category *cat,
2302                            const struct variable *var)
2303 {
2304   struct substring in = ss_cstr (cat->pc->label);
2305   struct substring target = ss_cstr (")LABEL[");
2306
2307   struct string out = DS_EMPTY_INITIALIZER;
2308   for (;;)
2309     {
2310       size_t chunk = ss_find_substring (in, target);
2311       if (chunk == SIZE_MAX)
2312         {
2313           if (ds_is_empty (&out))
2314             return pivot_value_new_user_text (in.string, in.length);
2315           else
2316             {
2317               ds_put_substring (&out, in);
2318               return pivot_value_new_user_text_nocopy (ds_steal_cstr (&out));
2319             }
2320         }
2321
2322       ds_put_substring (&out, ss_head (in, chunk));
2323       ss_advance (&in, chunk + target.length);
2324
2325       struct substring idx_s;
2326       if (!ss_get_until (&in, ']', &idx_s))
2327         goto error;
2328       char *tail;
2329       long int idx = strtol (idx_s.string, &tail, 10);
2330       if (idx < 1 || idx > cats->n_cats || tail != ss_end (idx_s))
2331         goto error;
2332
2333       struct ctables_category *cat2 = &cats->cats[idx - 1];
2334       if (!ctables_category_format_label (cat2, var, &out))
2335         goto error;
2336     }
2337
2338 error:
2339   ds_destroy (&out);
2340   return pivot_value_new_user_text (cat->pc->label, SIZE_MAX);
2341 }
2342
2343 static struct pivot_value *
2344 ctables_category_create_value_label (const struct ctables_categories *cats,
2345                                      const struct ctables_category *cat,
2346                                      const struct variable *var,
2347                                      const union value *value)
2348 {
2349   return (cat->type == CCT_POSTCOMPUTE && cat->pc->label
2350           ? ctables_postcompute_label (cats, cat, var)
2351           : cat->type == CCT_TOTAL || cat->type == CCT_SUBTOTAL
2352           ? pivot_value_new_user_text (cat->total_label, SIZE_MAX)
2353           : pivot_value_new_var_value (var, value));
2354 }
2355 \f
2356 /* CTABLES variable nesting and stacking. */
2357
2358 /* A nested sequence of variables, e.g. a > b > c. */
2359 struct ctables_nest
2360   {
2361     struct variable **vars;
2362     size_t n;
2363     size_t scale_idx;
2364     size_t summary_idx;
2365     size_t *areas[N_CTATS];
2366     size_t n_areas[N_CTATS];
2367     size_t group_head;
2368
2369     struct ctables_summary_spec_set specs[N_CSVS];
2370   };
2371
2372 /* A stack of nestings, e.g. nest1 + nest2 + ... + nestN. */
2373 struct ctables_stack
2374   {
2375     struct ctables_nest *nests;
2376     size_t n;
2377   };
2378
2379 static void
2380 ctables_nest_uninit (struct ctables_nest *nest)
2381 {
2382   free (nest->vars);
2383   for (enum ctables_summary_variant sv = 0; sv < N_CSVS; sv++)
2384     ctables_summary_spec_set_uninit (&nest->specs[sv]);
2385   for (enum ctables_area_type at = 0; at < N_CTATS; at++)
2386     free (nest->areas[at]);
2387 }
2388
2389 static void
2390 ctables_stack_uninit (struct ctables_stack *stack)
2391 {
2392   if (stack)
2393     {
2394       for (size_t i = 0; i < stack->n; i++)
2395         ctables_nest_uninit (&stack->nests[i]);
2396       free (stack->nests);
2397     }
2398 }
2399
2400 static struct ctables_stack
2401 nest_fts (struct ctables_stack s0, struct ctables_stack s1)
2402 {
2403   if (!s0.n)
2404     return s1;
2405   else if (!s1.n)
2406     return s0;
2407
2408   struct ctables_stack stack = { .nests = xnmalloc (s0.n, s1.n * sizeof *stack.nests) };
2409   for (size_t i = 0; i < s0.n; i++)
2410     for (size_t j = 0; j < s1.n; j++)
2411       {
2412         const struct ctables_nest *a = &s0.nests[i];
2413         const struct ctables_nest *b = &s1.nests[j];
2414
2415         size_t allocate = a->n + b->n;
2416         struct variable **vars = xnmalloc (allocate, sizeof *vars);
2417         size_t n = 0;
2418         for (size_t k = 0; k < a->n; k++)
2419           vars[n++] = a->vars[k];
2420         for (size_t k = 0; k < b->n; k++)
2421           vars[n++] = b->vars[k];
2422         assert (n == allocate);
2423
2424         const struct ctables_nest *summary_src;
2425         if (!a->specs[CSV_CELL].var)
2426           summary_src = b;
2427         else if (!b->specs[CSV_CELL].var)
2428           summary_src = a;
2429         else
2430           NOT_REACHED ();
2431
2432         struct ctables_nest *new = &stack.nests[stack.n++];
2433         *new = (struct ctables_nest) {
2434           .vars = vars,
2435           .scale_idx = (a->scale_idx != SIZE_MAX ? a->scale_idx
2436                         : b->scale_idx != SIZE_MAX ? a->n + b->scale_idx
2437                         : SIZE_MAX),
2438           .summary_idx = (a->summary_idx != SIZE_MAX ? a->summary_idx
2439                           : b->summary_idx != SIZE_MAX ? a->n + b->summary_idx
2440                           : SIZE_MAX),
2441           .n = n,
2442         };
2443         for (enum ctables_summary_variant sv = 0; sv < N_CSVS; sv++)
2444           ctables_summary_spec_set_clone (&new->specs[sv], &summary_src->specs[sv]);
2445       }
2446   ctables_stack_uninit (&s0);
2447   ctables_stack_uninit (&s1);
2448   return stack;
2449 }
2450
2451 static struct ctables_stack
2452 stack_fts (struct ctables_stack s0, struct ctables_stack s1)
2453 {
2454   struct ctables_stack stack = { .nests = xnmalloc (s0.n + s1.n, sizeof *stack.nests) };
2455   for (size_t i = 0; i < s0.n; i++)
2456     stack.nests[stack.n++] = s0.nests[i];
2457   for (size_t i = 0; i < s1.n; i++)
2458     {
2459       stack.nests[stack.n] = s1.nests[i];
2460       stack.nests[stack.n].group_head += s0.n;
2461       stack.n++;
2462     }
2463   assert (stack.n == s0.n + s1.n);
2464   free (s0.nests);
2465   free (s1.nests);
2466   return stack;
2467 }
2468
2469 static struct ctables_stack
2470 var_fts (const struct ctables_axis *a)
2471 {
2472   struct variable **vars = xmalloc (sizeof *vars);
2473   *vars = a->var;
2474
2475   bool is_summary = a->specs[CSV_CELL].n || a->scale;
2476   struct ctables_nest *nest = xmalloc (sizeof *nest);
2477   *nest = (struct ctables_nest) {
2478     .vars = vars,
2479     .n = 1,
2480     .scale_idx = a->scale ? 0 : SIZE_MAX,
2481     .summary_idx = is_summary ? 0 : SIZE_MAX,
2482   };
2483   if (is_summary)
2484     for (enum ctables_summary_variant sv = 0; sv < N_CSVS; sv++)
2485       {
2486         ctables_summary_spec_set_clone (&nest->specs[sv], &a->specs[sv]);
2487         nest->specs[sv].var = a->var;
2488         nest->specs[sv].is_scale = a->scale;
2489       }
2490   return (struct ctables_stack) { .nests = nest, .n = 1 };
2491 }
2492
2493 static struct ctables_stack
2494 enumerate_fts (enum pivot_axis_type axis_type, const struct ctables_axis *a)
2495 {
2496   if (!a)
2497     return (struct ctables_stack) { .n = 0 };
2498
2499   switch (a->op)
2500     {
2501     case CTAO_VAR:
2502       return var_fts (a);
2503
2504     case CTAO_STACK:
2505       return stack_fts (enumerate_fts (axis_type, a->subs[0]),
2506                         enumerate_fts (axis_type, a->subs[1]));
2507
2508     case CTAO_NEST:
2509       /* This should consider any of the scale variables found in the result to
2510          be linked to each other listwise for SMISSING=LISTWISE. */
2511       return nest_fts (enumerate_fts (axis_type, a->subs[0]),
2512                        enumerate_fts (axis_type, a->subs[1]));
2513     }
2514
2515   NOT_REACHED ();
2516 }
2517 \f
2518 /* CTABLES summary calculation. */
2519
2520 union ctables_summary
2521   {
2522     /* COUNT, VALIDN, TOTALN. */
2523     double count;
2524
2525     /* MINIMUM, MAXIMUM, RANGE. */
2526     struct
2527       {
2528         double min;
2529         double max;
2530       };
2531
2532     /* MEAN, SEMEAN, STDDEV, SUM, VARIANCE, *.SUM. */
2533     struct moments1 *moments;
2534
2535     /* MEDIAN, MODE, PTILE. */
2536     struct
2537       {
2538         struct casewriter *writer;
2539         double ovalid;
2540         double ovalue;
2541       };
2542   };
2543
2544 static void
2545 ctables_summary_init (union ctables_summary *s,
2546                       const struct ctables_summary_spec *ss)
2547 {
2548   switch (ss->function)
2549     {
2550     case CTSF_COUNT:
2551     case CTSF_areaPCT_COUNT:
2552     case CTSF_areaPCT_VALIDN:
2553     case CTSF_areaPCT_TOTALN:
2554     case CTSF_MISSING:
2555     case CTSF_TOTALN:
2556     case CTSF_VALIDN:
2557       s->count = 0;
2558       break;
2559
2560     case CTSF_areaID:
2561       break;
2562
2563     case CTSF_MAXIMUM:
2564     case CTSF_MINIMUM:
2565     case CTSF_RANGE:
2566       s->min = s->max = SYSMIS;
2567       break;
2568
2569     case CTSF_MEAN:
2570     case CTSF_SUM:
2571     case CTSF_areaPCT_SUM:
2572       s->moments = moments1_create (MOMENT_MEAN);
2573       break;
2574
2575     case CTSF_SEMEAN:
2576     case CTSF_STDDEV:
2577     case CTSF_VARIANCE:
2578       s->moments = moments1_create (MOMENT_VARIANCE);
2579       break;
2580
2581     case CTSF_MEDIAN:
2582     case CTSF_MODE:
2583     case CTSF_PTILE:
2584       {
2585         struct caseproto *proto = caseproto_create ();
2586         proto = caseproto_add_width (proto, 0);
2587         proto = caseproto_add_width (proto, 0);
2588
2589         struct subcase ordering;
2590         subcase_init (&ordering, 0, 0, SC_ASCEND);
2591         s->writer = sort_create_writer (&ordering, proto);
2592         subcase_uninit (&ordering);
2593         caseproto_unref (proto);
2594
2595         s->ovalid = 0;
2596         s->ovalue = SYSMIS;
2597       }
2598       break;
2599     }
2600 }
2601
2602 static void
2603 ctables_summary_uninit (union ctables_summary *s,
2604                         const struct ctables_summary_spec *ss)
2605 {
2606   switch (ss->function)
2607     {
2608     case CTSF_COUNT:
2609     case CTSF_areaPCT_COUNT:
2610     case CTSF_areaPCT_VALIDN:
2611     case CTSF_areaPCT_TOTALN:
2612     case CTSF_MISSING:
2613     case CTSF_TOTALN:
2614     case CTSF_VALIDN:
2615       break;
2616
2617     case CTSF_areaID:
2618       break;
2619
2620     case CTSF_MAXIMUM:
2621     case CTSF_MINIMUM:
2622     case CTSF_RANGE:
2623       break;
2624
2625     case CTSF_MEAN:
2626     case CTSF_SEMEAN:
2627     case CTSF_STDDEV:
2628     case CTSF_SUM:
2629     case CTSF_VARIANCE:
2630     case CTSF_areaPCT_SUM:
2631       moments1_destroy (s->moments);
2632       break;
2633
2634     case CTSF_MEDIAN:
2635     case CTSF_MODE:
2636     case CTSF_PTILE:
2637       casewriter_destroy (s->writer);
2638       break;
2639     }
2640 }
2641
2642 static void
2643 ctables_summary_add (union ctables_summary *s,
2644                      const struct ctables_summary_spec *ss,
2645                      const union value *value,
2646                      bool is_missing, bool is_included,
2647                      double weight)
2648 {
2649   /* To determine whether a case is included in a given table for a particular
2650      kind of summary, consider the following charts for the variable being
2651      summarized.  Only if "yes" appears is the case counted.
2652
2653      Categorical variables:                    VALIDN   other   TOTALN
2654        Valid values in included categories       yes     yes      yes
2655        Missing values in included categories     ---     yes      yes
2656        Missing values in excluded categories     ---     ---      yes
2657        Valid values in excluded categories       ---     ---      ---
2658
2659      Scale variables:                          VALIDN   other   TOTALN
2660        Valid value                               yes     yes      yes
2661        Missing value                             ---     yes      yes
2662
2663      Missing values include both user- and system-missing.  (The system-missing
2664      value is always in an excluded category.)
2665
2666      One way to interpret the above table is that scale variables are like
2667      categorical variables in which all values are in included categories.
2668   */
2669   switch (ss->function)
2670     {
2671     case CTSF_TOTALN:
2672     case CTSF_areaPCT_TOTALN:
2673       s->count += weight;
2674       break;
2675
2676     case CTSF_COUNT:
2677     case CTSF_areaPCT_COUNT:
2678       if (is_included)
2679         s->count += weight;
2680       break;
2681
2682     case CTSF_VALIDN:
2683     case CTSF_areaPCT_VALIDN:
2684       if (!is_missing)
2685         s->count += weight;
2686       break;
2687
2688     case CTSF_areaID:
2689       break;
2690
2691     case CTSF_MISSING:
2692       if (is_missing)
2693         s->count += weight;
2694       break;
2695
2696     case CTSF_MAXIMUM:
2697     case CTSF_MINIMUM:
2698     case CTSF_RANGE:
2699       if (!is_missing)
2700         {
2701           if (s->min == SYSMIS || value->f < s->min)
2702             s->min = value->f;
2703           if (s->max == SYSMIS || value->f > s->max)
2704             s->max = value->f;
2705         }
2706       break;
2707
2708     case CTSF_MEAN:
2709     case CTSF_SEMEAN:
2710     case CTSF_STDDEV:
2711     case CTSF_SUM:
2712     case CTSF_VARIANCE:
2713       if (!is_missing)
2714         moments1_add (s->moments, value->f, weight);
2715       break;
2716
2717     case CTSF_areaPCT_SUM:
2718       if (!is_missing)
2719         moments1_add (s->moments, value->f, weight);
2720       break;
2721
2722     case CTSF_MEDIAN:
2723     case CTSF_MODE:
2724     case CTSF_PTILE:
2725       if (!is_missing)
2726         {
2727           s->ovalid += weight;
2728
2729           struct ccase *c = case_create (casewriter_get_proto (s->writer));
2730           *case_num_rw_idx (c, 0) = value->f;
2731           *case_num_rw_idx (c, 1) = weight;
2732           casewriter_write (s->writer, c);
2733         }
2734       break;
2735     }
2736 }
2737
2738 static double
2739 ctables_summary_value (struct ctables_area *areas[N_CTATS],
2740                        union ctables_summary *s,
2741                        const struct ctables_summary_spec *ss)
2742 {
2743   switch (ss->function)
2744     {
2745     case CTSF_COUNT:
2746       return s->count;
2747
2748     case CTSF_areaID:
2749       return areas[ss->calc_area]->sequence;
2750
2751     case CTSF_areaPCT_COUNT:
2752       {
2753         const struct ctables_area *a = areas[ss->calc_area];
2754         double a_count = a->count[ss->weighting];
2755         return a_count ? s->count / a_count * 100 : SYSMIS;
2756       }
2757
2758     case CTSF_areaPCT_VALIDN:
2759       {
2760         const struct ctables_area *a = areas[ss->calc_area];
2761         double a_valid = a->valid[ss->weighting];
2762         return a_valid ? s->count / a_valid * 100 : SYSMIS;
2763       }
2764
2765     case CTSF_areaPCT_TOTALN:
2766       {
2767         const struct ctables_area *a = areas[ss->calc_area];
2768         double a_total = a->total[ss->weighting];
2769         return a_total ? s->count / a_total * 100 : SYSMIS;
2770       }
2771
2772     case CTSF_MISSING:
2773     case CTSF_TOTALN:
2774     case CTSF_VALIDN:
2775       return s->count;
2776
2777     case CTSF_MAXIMUM:
2778       return s->max;
2779
2780     case CTSF_MINIMUM:
2781       return s->min;
2782
2783     case CTSF_RANGE:
2784       return s->max != SYSMIS && s->min != SYSMIS ? s->max - s->min : SYSMIS;
2785
2786     case CTSF_MEAN:
2787       {
2788         double mean;
2789         moments1_calculate (s->moments, NULL, &mean, NULL, NULL, NULL);
2790         return mean;
2791       }
2792
2793     case CTSF_SEMEAN:
2794       {
2795         double weight, variance;
2796         moments1_calculate (s->moments, &weight, NULL, &variance, NULL, NULL);
2797         return calc_semean (variance, weight);
2798       }
2799
2800     case CTSF_STDDEV:
2801       {
2802         double variance;
2803         moments1_calculate (s->moments, NULL, NULL, &variance, NULL, NULL);
2804         return variance != SYSMIS ? sqrt (variance) : SYSMIS;
2805       }
2806
2807     case CTSF_SUM:
2808       {
2809         double weight, mean;
2810         moments1_calculate (s->moments, &weight, &mean, NULL, NULL, NULL);
2811         return weight != SYSMIS && mean != SYSMIS ? weight * mean : SYSMIS;
2812       }
2813
2814     case CTSF_VARIANCE:
2815       {
2816         double variance;
2817         moments1_calculate (s->moments, NULL, NULL, &variance, NULL, NULL);
2818         return variance;
2819       }
2820
2821     case CTSF_areaPCT_SUM:
2822       {
2823         double weight, mean;
2824         moments1_calculate (s->moments, &weight, &mean, NULL, NULL, NULL);
2825         if (weight == SYSMIS || mean == SYSMIS)
2826           return SYSMIS;
2827
2828         const struct ctables_area *a = areas[ss->calc_area];
2829         const struct ctables_sum *sum = &a->sums[ss->sum_var_idx];
2830         double denom = sum->sum[ss->weighting];
2831         return denom != 0 ? weight * mean / denom * 100 : SYSMIS;
2832       }
2833
2834     case CTSF_MEDIAN:
2835     case CTSF_PTILE:
2836       if (s->writer)
2837         {
2838           struct casereader *reader = casewriter_make_reader (s->writer);
2839           s->writer = NULL;
2840
2841           struct percentile *ptile = percentile_create (
2842             ss->function == CTSF_PTILE ? ss->percentile : 0.5, s->ovalid);
2843           struct order_stats *os = &ptile->parent;
2844           order_stats_accumulate_idx (&os, 1, reader, 1, 0);
2845           s->ovalue = percentile_calculate (ptile, PC_HAVERAGE);
2846           statistic_destroy (&ptile->parent.parent);
2847         }
2848       return s->ovalue;
2849
2850     case CTSF_MODE:
2851       if (s->writer)
2852         {
2853           struct casereader *reader = casewriter_make_reader (s->writer);
2854           s->writer = NULL;
2855
2856           struct mode *mode = mode_create ();
2857           struct order_stats *os = &mode->parent;
2858           order_stats_accumulate_idx (&os, 1, reader, 1, 0);
2859           s->ovalue = mode->mode;
2860           statistic_destroy (&mode->parent.parent);
2861         }
2862       return s->ovalue;
2863     }
2864
2865   NOT_REACHED ();
2866 }
2867 \f
2868 /* CTABLES occurrences. */
2869
2870 struct ctables_occurrence
2871   {
2872     struct hmap_node node;
2873     union value value;
2874   };
2875
2876 static void
2877 ctables_add_occurrence (const struct variable *var,
2878                         const union value *value,
2879                         struct hmap *occurrences)
2880 {
2881   int width = var_get_width (var);
2882   unsigned int hash = value_hash (value, width, 0);
2883
2884   struct ctables_occurrence *o;
2885   HMAP_FOR_EACH_WITH_HASH (o, struct ctables_occurrence, node, hash,
2886                            occurrences)
2887     if (value_equal (value, &o->value, width))
2888       return;
2889
2890   o = xmalloc (sizeof *o);
2891   value_clone (&o->value, value, width);
2892   hmap_insert (occurrences, &o->node, hash);
2893 }
2894 \f
2895 enum ctables_vlabel
2896   {
2897     CTVL_NONE = SETTINGS_VALUE_SHOW_DEFAULT,
2898     CTVL_NAME = SETTINGS_VALUE_SHOW_VALUE,
2899     CTVL_LABEL = SETTINGS_VALUE_SHOW_LABEL,
2900     CTVL_BOTH = SETTINGS_VALUE_SHOW_BOTH,
2901   };
2902
2903 struct ctables_cell
2904   {
2905     /* In struct ctables_section's 'cells' hmap.  Indexed by all the values in
2906        all the axes (except the scalar variable, if any). */
2907     struct hmap_node node;
2908     struct ctables_section *section;
2909
2910     /* The areas that contain this cell. */
2911     uint32_t omit_areas;
2912     struct ctables_area *areas[N_CTATS];
2913
2914     bool hide;
2915
2916     bool postcompute;
2917     enum ctables_summary_variant sv;
2918
2919     struct ctables_cell_axis
2920       {
2921         struct ctables_cell_value
2922           {
2923             const struct ctables_category *category;
2924             union value value;
2925           }
2926         *cvs;
2927         int leaf;
2928       }
2929     axes[PIVOT_N_AXES];
2930
2931     union ctables_summary *summaries;
2932   };
2933
2934 struct ctables_section
2935   {
2936     /* Settings. */
2937     struct ctables_table *table;
2938     struct ctables_nest *nests[PIVOT_N_AXES];
2939
2940     /* Data. */
2941     struct hmap *occurrences[PIVOT_N_AXES]; /* "struct ctables_occurrence"s. */
2942     struct hmap cells;            /* Contains "struct ctables_cell"s. */
2943     struct hmap areas[N_CTATS];   /* Contains "struct ctables_area"s. */
2944   };
2945
2946 static void ctables_section_uninit (struct ctables_section *);
2947
2948 struct ctables_table
2949   {
2950     struct ctables *ctables;
2951     struct ctables_axis *axes[PIVOT_N_AXES];
2952     struct ctables_stack stacks[PIVOT_N_AXES];
2953     struct ctables_section *sections;
2954     size_t n_sections;
2955     enum pivot_axis_type summary_axis;
2956     struct ctables_summary_spec_set summary_specs;
2957     struct variable **sum_vars;
2958     size_t n_sum_vars;
2959
2960     enum pivot_axis_type slabels_axis;
2961     bool slabels_visible;
2962
2963     /* The innermost category labels for axis 'a' appear on axis label_axis[a].
2964
2965        Most commonly, label_axis[a] == a, and in particular we always have
2966        label_axis{PIVOT_AXIS_LAYER] == PIVOT_AXIS_LAYER.
2967
2968        If ROWLABELS or COLLABELS is specified, then one of
2969        label_axis[PIVOT_AXIS_ROW] or label_axis[PIVOT_AXIS_COLUMN] can be the
2970        opposite axis or PIVOT_AXIS_LAYER.  Only one of them will differ.
2971
2972        If any category labels are moved, then 'clabels_example' is one of the
2973        variables being moved (and it is otherwise NULL).  All of the variables
2974        being moved have the same width, value labels, and categories, so this
2975        example variable can be used to find those out.
2976
2977        The remaining members in this group are relevant only if category labels
2978        are moved.
2979
2980        'clabels_values_map' holds a "struct ctables_value" for all the values
2981        that appear in all of the variables in the moved categories.  It is
2982        accumulated as the data is read.  Once the data is fully read, its
2983        sorted values are put into 'clabels_values' and 'n_clabels_values'.
2984     */
2985     enum pivot_axis_type label_axis[PIVOT_N_AXES];
2986     enum pivot_axis_type clabels_from_axis;
2987     enum pivot_axis_type clabels_to_axis;
2988     int clabels_start_ofs, clabels_end_ofs;
2989     const struct variable *clabels_example;
2990     struct hmap clabels_values_map;
2991     struct ctables_value **clabels_values;
2992     size_t n_clabels_values;
2993
2994     /* Indexed by variable dictionary index. */
2995     struct ctables_categories **categories;
2996     size_t n_categories;
2997     bool *show_empty;
2998
2999     double cilevel;
3000
3001     char *caption;
3002     char *corner;
3003     char *title;
3004
3005     struct ctables_chisq *chisq;
3006     struct ctables_pairwise *pairwise;
3007   };
3008
3009 struct ctables_cell_sort_aux
3010   {
3011     const struct ctables_nest *nest;
3012     enum pivot_axis_type a;
3013   };
3014
3015 static int
3016 ctables_cell_compare_3way (const void *a_, const void *b_, const void *aux_)
3017 {
3018   const struct ctables_cell_sort_aux *aux = aux_;
3019   struct ctables_cell *const *ap = a_;
3020   struct ctables_cell *const *bp = b_;
3021   const struct ctables_cell *a = *ap;
3022   const struct ctables_cell *b = *bp;
3023
3024   const struct ctables_nest *nest = aux->nest;
3025   for (size_t i = 0; i < nest->n; i++)
3026     if (i != nest->scale_idx)
3027       {
3028         const struct variable *var = nest->vars[i];
3029         const struct ctables_cell_value *a_cv = &a->axes[aux->a].cvs[i];
3030         const struct ctables_cell_value *b_cv = &b->axes[aux->a].cvs[i];
3031         if (a_cv->category != b_cv->category)
3032           return a_cv->category > b_cv->category ? 1 : -1;
3033
3034         const union value *a_val = &a_cv->value;
3035         const union value *b_val = &b_cv->value;
3036         switch (a_cv->category->type)
3037           {
3038           case CCT_NUMBER:
3039           case CCT_STRING:
3040           case CCT_SUBTOTAL:
3041           case CCT_TOTAL:
3042           case CCT_POSTCOMPUTE:
3043           case CCT_EXCLUDED_MISSING:
3044             /* Must be equal. */
3045             continue;
3046
3047           case CCT_NRANGE:
3048           case CCT_SRANGE:
3049           case CCT_MISSING:
3050           case CCT_OTHERNM:
3051             {
3052               int cmp = value_compare_3way (a_val, b_val, var_get_width (var));
3053               if (cmp)
3054                 return cmp;
3055             }
3056             break;
3057
3058           case CCT_VALUE:
3059             {
3060               int cmp = value_compare_3way (a_val, b_val, var_get_width (var));
3061               if (cmp)
3062                 return a_cv->category->sort_ascending ? cmp : -cmp;
3063             }
3064             break;
3065
3066           case CCT_LABEL:
3067             {
3068               const char *a_label = var_lookup_value_label (var, a_val);
3069               const char *b_label = var_lookup_value_label (var, b_val);
3070               int cmp;
3071               if (a_label)
3072                 {
3073                   if (!b_label)
3074                     return -1;
3075                   cmp = strcmp (a_label, b_label);
3076                 }
3077               else
3078                 {
3079                   if (b_label)
3080                     return 1;
3081                   cmp = value_compare_3way (a_val, b_val, var_get_width (var));
3082                 }
3083               if (cmp)
3084                 return a_cv->category->sort_ascending ? cmp : -cmp;
3085             }
3086             break;
3087
3088           case CCT_FUNCTION:
3089             NOT_REACHED ();
3090           }
3091       }
3092   return 0;
3093 }
3094
3095 static struct ctables_area *
3096 ctables_area_insert (struct ctables_cell *cell, enum ctables_area_type area)
3097 {
3098   struct ctables_section *s = cell->section;
3099   size_t hash = 0;
3100   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3101     {
3102       const struct ctables_nest *nest = s->nests[a];
3103       for (size_t i = 0; i < nest->n_areas[area]; i++)
3104         {
3105           size_t v_idx = nest->areas[area][i];
3106           struct ctables_cell_value *cv = &cell->axes[a].cvs[v_idx];
3107           hash = hash_pointer (cv->category, hash);
3108           if (cv->category->type != CCT_TOTAL
3109               && cv->category->type != CCT_SUBTOTAL
3110               && cv->category->type != CCT_POSTCOMPUTE)
3111             hash = value_hash (&cv->value,
3112                                var_get_width (nest->vars[v_idx]), hash);
3113         }
3114     }
3115
3116   struct ctables_area *a;
3117   HMAP_FOR_EACH_WITH_HASH (a, struct ctables_area, node, hash, &s->areas[area])
3118     {
3119       const struct ctables_cell *df = a->example;
3120       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3121         {
3122           const struct ctables_nest *nest = s->nests[a];
3123           for (size_t i = 0; i < nest->n_areas[area]; i++)
3124             {
3125               size_t v_idx = nest->areas[area][i];
3126               struct ctables_cell_value *cv1 = &df->axes[a].cvs[v_idx];
3127               struct ctables_cell_value *cv2 = &cell->axes[a].cvs[v_idx];
3128               if (cv1->category != cv2->category
3129                   || (cv1->category->type != CCT_TOTAL
3130                       && cv1->category->type != CCT_SUBTOTAL
3131                       && cv1->category->type != CCT_POSTCOMPUTE
3132                       && !value_equal (&cv1->value, &cv2->value,
3133                                        var_get_width (nest->vars[v_idx]))))
3134                 goto not_equal;
3135             }
3136         }
3137       return a;
3138
3139     not_equal: ;
3140     }
3141
3142   struct ctables_sum *sums = (s->table->n_sum_vars
3143                               ? xzalloc (s->table->n_sum_vars * sizeof *sums)
3144                               : NULL);
3145
3146   a = xmalloc (sizeof *a);
3147   *a = (struct ctables_area) { .example = cell, .sums = sums };
3148   hmap_insert (&s->areas[area], &a->node, hash);
3149   return a;
3150 }
3151
3152 static struct ctables_cell *
3153 ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
3154                        const struct ctables_category **cats[PIVOT_N_AXES])
3155 {
3156   size_t hash = 0;
3157   enum ctables_summary_variant sv = CSV_CELL;
3158   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3159     {
3160       const struct ctables_nest *nest = s->nests[a];
3161       for (size_t i = 0; i < nest->n; i++)
3162         if (i != nest->scale_idx)
3163           {
3164             hash = hash_pointer (cats[a][i], hash);
3165             if (cats[a][i]->type != CCT_TOTAL
3166                 && cats[a][i]->type != CCT_SUBTOTAL
3167                 && cats[a][i]->type != CCT_POSTCOMPUTE)
3168               hash = value_hash (case_data (c, nest->vars[i]),
3169                                  var_get_width (nest->vars[i]), hash);
3170             else
3171               sv = CSV_TOTAL;
3172           }
3173     }
3174
3175   struct ctables_cell *cell;
3176   HMAP_FOR_EACH_WITH_HASH (cell, struct ctables_cell, node, hash, &s->cells)
3177     {
3178       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3179         {
3180           const struct ctables_nest *nest = s->nests[a];
3181           for (size_t i = 0; i < nest->n; i++)
3182             if (i != nest->scale_idx
3183                 && (cats[a][i] != cell->axes[a].cvs[i].category
3184                     || (cats[a][i]->type != CCT_TOTAL
3185                         && cats[a][i]->type != CCT_SUBTOTAL
3186                         && cats[a][i]->type != CCT_POSTCOMPUTE
3187                         && !value_equal (case_data (c, nest->vars[i]),
3188                                          &cell->axes[a].cvs[i].value,
3189                                          var_get_width (nest->vars[i])))))
3190                 goto not_equal;
3191         }
3192
3193       return cell;
3194
3195     not_equal: ;
3196     }
3197
3198   cell = xmalloc (sizeof *cell);
3199   cell->section = s;
3200   cell->hide = false;
3201   cell->sv = sv;
3202   cell->omit_areas = 0;
3203   cell->postcompute = false;
3204   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3205     {
3206       const struct ctables_nest *nest = s->nests[a];
3207       cell->axes[a].cvs = (nest->n
3208                            ? xnmalloc (nest->n, sizeof *cell->axes[a].cvs)
3209                            : NULL);
3210       for (size_t i = 0; i < nest->n; i++)
3211         {
3212           const struct ctables_category *cat = cats[a][i];
3213           const struct variable *var = nest->vars[i];
3214           const union value *value = case_data (c, var);
3215           if (i != nest->scale_idx)
3216             {
3217               const struct ctables_category *subtotal = cat->subtotal;
3218               if (cat->hide || (subtotal && subtotal->hide_subcategories))
3219                 cell->hide = true;
3220
3221               if (cat->type == CCT_TOTAL
3222                   || cat->type == CCT_SUBTOTAL
3223                   || cat->type == CCT_POSTCOMPUTE)
3224                 {
3225                   switch (a)
3226                     {
3227                     case PIVOT_AXIS_COLUMN:
3228                       cell->omit_areas |= ((1u << CTAT_TABLE) |
3229                                            (1u << CTAT_LAYER) |
3230                                            (1u << CTAT_LAYERCOL) |
3231                                            (1u << CTAT_SUBTABLE) |
3232                                            (1u << CTAT_COL));
3233                       break;
3234                     case PIVOT_AXIS_ROW:
3235                       cell->omit_areas |= ((1u << CTAT_TABLE) |
3236                                            (1u << CTAT_LAYER) |
3237                                            (1u << CTAT_LAYERROW) |
3238                                            (1u << CTAT_SUBTABLE) |
3239                                            (1u << CTAT_ROW));
3240                       break;
3241                     case PIVOT_AXIS_LAYER:
3242                       cell->omit_areas |= ((1u << CTAT_TABLE) |
3243                                            (1u << CTAT_LAYER));
3244                       break;
3245                     }
3246                 }
3247               if (cat->type == CCT_POSTCOMPUTE)
3248                 cell->postcompute = true;
3249             }
3250
3251           cell->axes[a].cvs[i].category = cat;
3252           value_clone (&cell->axes[a].cvs[i].value, value, var_get_width (var));
3253         }
3254     }
3255
3256   const struct ctables_nest *ss = s->nests[s->table->summary_axis];
3257   const struct ctables_summary_spec_set *specs = &ss->specs[cell->sv];
3258   cell->summaries = xmalloc (specs->n * sizeof *cell->summaries);
3259   for (size_t i = 0; i < specs->n; i++)
3260     ctables_summary_init (&cell->summaries[i], &specs->specs[i]);
3261   for (enum ctables_area_type at = 0; at < N_CTATS; at++)
3262     cell->areas[at] = ctables_area_insert (cell, at);
3263   hmap_insert (&s->cells, &cell->node, hash);
3264   return cell;
3265 }
3266
3267 static void
3268 add_weight (double dst[N_CTWS], const double src[N_CTWS])
3269 {
3270   for (enum ctables_weighting wt = 0; wt < N_CTWS; wt++)
3271     dst[wt] += src[wt];
3272 }
3273
3274 static void
3275 ctables_cell_add__ (struct ctables_section *s, const struct ccase *c,
3276                     const struct ctables_category **cats[PIVOT_N_AXES],
3277                     bool is_included, double weight[N_CTWS])
3278 {
3279   struct ctables_cell *cell = ctables_cell_insert__ (s, c, cats);
3280   const struct ctables_nest *ss = s->nests[s->table->summary_axis];
3281
3282   const struct ctables_summary_spec_set *specs = &ss->specs[cell->sv];
3283   const union value *value = case_data (c, specs->var);
3284   bool is_missing = var_is_value_missing (specs->var, value);
3285   bool is_scale_missing
3286     = is_missing || (specs->is_scale && is_listwise_missing (specs, c));
3287
3288   for (size_t i = 0; i < specs->n; i++)
3289      ctables_summary_add (&cell->summaries[i], &specs->specs[i], value,
3290                           is_scale_missing, is_included,
3291                           weight[specs->specs[i].weighting]);
3292   for (enum ctables_area_type at = 0; at < N_CTATS; at++)
3293     if (!(cell->omit_areas && (1u << at)))
3294       {
3295         struct ctables_area *a = cell->areas[at];
3296
3297         add_weight (a->total, weight);
3298         if (is_included)
3299           add_weight (a->count, weight);
3300         if (!is_missing)
3301           {
3302             add_weight (a->valid, weight);
3303
3304             if (!is_scale_missing)
3305               for (size_t i = 0; i < s->table->n_sum_vars; i++)
3306                 {
3307                   const struct variable *var = s->table->sum_vars[i];
3308                   double addend = case_num (c, var);
3309                   if (!var_is_num_missing (var, addend))
3310                     for (enum ctables_weighting wt = 0; wt < N_CTWS; wt++)
3311                       a->sums[i].sum[wt] += addend * weight[wt];
3312                 }
3313           }
3314       }
3315 }
3316
3317 static void
3318 recurse_totals (struct ctables_section *s, const struct ccase *c,
3319                 const struct ctables_category **cats[PIVOT_N_AXES],
3320                 bool is_included, double weight[N_CTWS],
3321                 enum pivot_axis_type start_axis, size_t start_nest)
3322 {
3323   for (enum pivot_axis_type a = start_axis; a < PIVOT_N_AXES; a++)
3324     {
3325       const struct ctables_nest *nest = s->nests[a];
3326       for (size_t i = start_nest; i < nest->n; i++)
3327         {
3328           if (i == nest->scale_idx)
3329             continue;
3330
3331           const struct variable *var = nest->vars[i];
3332
3333           const struct ctables_category *total = ctables_categories_total (
3334             s->table->categories[var_get_dict_index (var)]);
3335           if (total)
3336             {
3337               const struct ctables_category *save = cats[a][i];
3338               cats[a][i] = total;
3339               ctables_cell_add__ (s, c, cats, is_included, weight);
3340               recurse_totals (s, c, cats, is_included, weight, a, i + 1);
3341               cats[a][i] = save;
3342             }
3343         }
3344       start_nest = 0;
3345     }
3346 }
3347
3348 static void
3349 recurse_subtotals (struct ctables_section *s, const struct ccase *c,
3350                    const struct ctables_category **cats[PIVOT_N_AXES],
3351                    bool is_included, double weight[N_CTWS],
3352                    enum pivot_axis_type start_axis, size_t start_nest)
3353 {
3354   for (enum pivot_axis_type a = start_axis; a < PIVOT_N_AXES; a++)
3355     {
3356       const struct ctables_nest *nest = s->nests[a];
3357       for (size_t i = start_nest; i < nest->n; i++)
3358         {
3359           if (i == nest->scale_idx)
3360             continue;
3361
3362           const struct ctables_category *save = cats[a][i];
3363           if (save->subtotal)
3364             {
3365               cats[a][i] = save->subtotal;
3366               ctables_cell_add__ (s, c, cats, is_included, weight);
3367               recurse_subtotals (s, c, cats, is_included, weight, a, i + 1);
3368               cats[a][i] = save;
3369             }
3370         }
3371       start_nest = 0;
3372     }
3373 }
3374
3375 static void
3376 ctables_cell_insert (struct ctables_section *s, const struct ccase *c,
3377                      double weight[N_CTWS])
3378 {
3379   const struct ctables_category *layer_cats[s->nests[PIVOT_AXIS_LAYER]->n];
3380   const struct ctables_category *row_cats[s->nests[PIVOT_AXIS_ROW]->n];
3381   const struct ctables_category *column_cats[s->nests[PIVOT_AXIS_COLUMN]->n];
3382   const struct ctables_category **cats[PIVOT_N_AXES] =
3383     {
3384       [PIVOT_AXIS_LAYER] = layer_cats,
3385       [PIVOT_AXIS_ROW] = row_cats,
3386       [PIVOT_AXIS_COLUMN] = column_cats,
3387     };
3388
3389   bool is_included = true;
3390
3391   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3392     {
3393       const struct ctables_nest *nest = s->nests[a];
3394       for (size_t i = 0; i < nest->n; i++)
3395         if (i != nest->scale_idx)
3396           {
3397             const struct variable *var = nest->vars[i];
3398             const union value *value = case_data (c, var);
3399
3400             cats[a][i] = ctables_categories_match (
3401               s->table->categories[var_get_dict_index (var)], value, var);
3402             if (!cats[a][i])
3403               {
3404                 if (i != nest->summary_idx)
3405                   return;
3406
3407                 if (!var_is_value_missing (var, value))
3408                   return;
3409
3410                 static const struct ctables_category cct_excluded_missing = {
3411                   .type = CCT_EXCLUDED_MISSING,
3412                   .hide = true,
3413                 };
3414                 cats[a][i] = &cct_excluded_missing;
3415                 is_included = false;
3416               }
3417         }
3418     }
3419
3420   if (is_included)
3421     for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3422       {
3423         const struct ctables_nest *nest = s->nests[a];
3424         for (size_t i = 0; i < nest->n; i++)
3425           if (i != nest->scale_idx)
3426             {
3427               const struct variable *var = nest->vars[i];
3428               const union value *value = case_data (c, var);
3429               ctables_add_occurrence (var, value, &s->occurrences[a][i]);
3430             }
3431       }
3432
3433   ctables_cell_add__ (s, c, cats, is_included, weight);
3434   recurse_totals (s, c, cats, is_included, weight, 0, 0);
3435   recurse_subtotals (s, c, cats, is_included, weight, 0, 0);
3436 }
3437 \f
3438 struct ctables_value
3439   {
3440     struct hmap_node node;
3441     union value value;
3442     int leaf;
3443   };
3444
3445 static struct ctables_value *
3446 ctables_value_find__ (const struct ctables_table *t, const union value *value,
3447                       int width, unsigned int hash)
3448 {
3449   struct ctables_value *clv;
3450   HMAP_FOR_EACH_WITH_HASH (clv, struct ctables_value, node,
3451                            hash, &t->clabels_values_map)
3452     if (value_equal (value, &clv->value, width))
3453       return clv;
3454   return NULL;
3455 }
3456
3457 static void
3458 ctables_value_insert (struct ctables_table *t, const union value *value,
3459                       int width)
3460 {
3461   unsigned int hash = value_hash (value, width, 0);
3462   struct ctables_value *clv = ctables_value_find__ (t, value, width, hash);
3463   if (!clv)
3464     {
3465       clv = xmalloc (sizeof *clv);
3466       value_clone (&clv->value, value, width);
3467       hmap_insert (&t->clabels_values_map, &clv->node, hash);
3468     }
3469 }
3470
3471 static const struct ctables_value *
3472 ctables_value_find (const struct ctables_cell *cell)
3473 {
3474   const struct ctables_section *s = cell->section;
3475   const struct ctables_table *t = s->table;
3476   if (!t->clabels_example)
3477     return NULL;
3478
3479   const struct ctables_nest *clabels_nest = s->nests[t->clabels_from_axis];
3480   const struct variable *var = clabels_nest->vars[clabels_nest->n - 1];
3481   const union value *value
3482     = &cell->axes[t->clabels_from_axis].cvs[clabels_nest->n - 1].value;
3483   int width = var_get_width (var);
3484   const struct ctables_value *ctv = ctables_value_find__ (
3485     t, value, width, value_hash (value, width, 0));
3486   assert (ctv != NULL);
3487   return ctv;
3488 }
3489
3490 static int
3491 compare_ctables_values_3way (const void *a_, const void *b_, const void *width_)
3492 {
3493   const struct ctables_value *const *ap = a_;
3494   const struct ctables_value *const *bp = b_;
3495   const struct ctables_value *a = *ap;
3496   const struct ctables_value *b = *bp;
3497   const int *width = width_;
3498   return value_compare_3way (&a->value, &b->value, *width);
3499 }
3500
3501 static void
3502 ctables_sort_clabels_values (struct ctables_table *t)
3503 {
3504   const struct variable *v0 = t->clabels_example;
3505   int width = var_get_width (v0);
3506
3507   size_t i0 = var_get_dict_index (v0);
3508   struct ctables_categories *c0 = t->categories[i0];
3509   if (t->show_empty[i0])
3510     {
3511       const struct val_labs *val_labs = var_get_value_labels (v0);
3512       for (const struct val_lab *vl = val_labs_first (val_labs); vl;
3513            vl = val_labs_next (val_labs, vl))
3514         if (ctables_categories_match (c0, &vl->value, v0))
3515           ctables_value_insert (t, &vl->value, width);
3516     }
3517
3518   size_t n = hmap_count (&t->clabels_values_map);
3519   t->clabels_values = xnmalloc (n, sizeof *t->clabels_values);
3520
3521   struct ctables_value *clv;
3522   size_t i = 0;
3523   HMAP_FOR_EACH (clv, struct ctables_value, node, &t->clabels_values_map)
3524     t->clabels_values[i++] = clv;
3525   t->n_clabels_values = n;
3526   assert (i == n);
3527
3528   sort (t->clabels_values, n, sizeof *t->clabels_values,
3529         compare_ctables_values_3way, &width);
3530
3531   for (size_t i = 0; i < n; i++)
3532     t->clabels_values[i]->leaf = i;
3533 }
3534 \f
3535 struct ctables
3536   {
3537     const struct dictionary *dict;
3538     struct pivot_table_look *look;
3539
3540     /* For CTEF_* formats. */
3541     struct fmt_settings ctables_formats;
3542
3543     /* If this is NULL, zeros are displayed using the normal print format.
3544        Otherwise, this string is displayed. */
3545     char *zero;
3546
3547     /* If this is NULL, missing values are displayed using the normal print
3548        format.  Otherwise, this string is displayed. */
3549     char *missing;
3550
3551     /* Indexed by variable dictionary index. */
3552     enum ctables_vlabel *vlabels;
3553
3554     struct hmap postcomputes;   /* Contains "struct ctables_postcompute"s. */
3555
3556     bool mrsets_count_duplicates; /* MRSETS. */
3557     bool smissing_listwise;       /* SMISSING. */
3558     struct variable *e_weight;    /* WEIGHT. */
3559     int hide_threshold;           /* HIDESMALLCOUNTS. */
3560
3561     struct ctables_table **tables;
3562     size_t n_tables;
3563   };
3564 \f
3565 static double
3566 ctpo_add (double a, double b)
3567 {
3568   return a + b;
3569 }
3570
3571 static double
3572 ctpo_sub (double a, double b)
3573 {
3574   return a - b;
3575 }
3576
3577 static double
3578 ctpo_mul (double a, double b)
3579 {
3580   return a * b;
3581 }
3582
3583 static double
3584 ctpo_div (double a, double b)
3585 {
3586   return b ? a / b : SYSMIS;
3587 }
3588
3589 static double
3590 ctpo_pow (double a, double b)
3591 {
3592   int save_errno = errno;
3593   errno = 0;
3594   double result = pow (a, b);
3595   if (errno)
3596     result = SYSMIS;
3597   errno = save_errno;
3598   return result;
3599 }
3600
3601 static double
3602 ctpo_neg (double a, double b UNUSED)
3603 {
3604   return -a;
3605 }
3606
3607 struct ctables_pcexpr_evaluate_ctx
3608   {
3609     const struct ctables_cell *cell;
3610     const struct ctables_section *section;
3611     const struct ctables_categories *cats;
3612     enum pivot_axis_type pc_a;
3613     size_t pc_a_idx;
3614     size_t summary_idx;
3615     enum fmt_type parse_format;
3616   };
3617
3618 static double ctables_pcexpr_evaluate (
3619   const struct ctables_pcexpr_evaluate_ctx *, const struct ctables_pcexpr *);
3620
3621 static double
3622 ctables_pcexpr_evaluate_nonterminal (
3623   const struct ctables_pcexpr_evaluate_ctx *ctx,
3624   const struct ctables_pcexpr *e, size_t n_args,
3625   double evaluate (double, double))
3626 {
3627   double args[2] = { 0, 0 };
3628   for (size_t i = 0; i < n_args; i++)
3629     {
3630       args[i] = ctables_pcexpr_evaluate (ctx, e->subs[i]);
3631       if (!isfinite (args[i]) || args[i] == SYSMIS)
3632         return SYSMIS;
3633     }
3634   return evaluate (args[0], args[1]);
3635 }
3636
3637 static double
3638 ctables_pcexpr_evaluate_category (const struct ctables_pcexpr_evaluate_ctx *ctx,
3639                                   const struct ctables_cell_value *pc_cv)
3640 {
3641   const struct ctables_section *s = ctx->section;
3642
3643   size_t hash = 0;
3644   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3645     {
3646       const struct ctables_nest *nest = s->nests[a];
3647       for (size_t i = 0; i < nest->n; i++)
3648         if (i != nest->scale_idx)
3649           {
3650             const struct ctables_cell_value *cv
3651               = (a == ctx->pc_a && i == ctx->pc_a_idx ? pc_cv
3652                  : &ctx->cell->axes[a].cvs[i]);
3653             hash = hash_pointer (cv->category, hash);
3654             if (cv->category->type != CCT_TOTAL
3655                 && cv->category->type != CCT_SUBTOTAL
3656                 && cv->category->type != CCT_POSTCOMPUTE)
3657               hash = value_hash (&cv->value,
3658                                  var_get_width (nest->vars[i]), hash);
3659           }
3660     }
3661
3662   struct ctables_cell *tc;
3663   HMAP_FOR_EACH_WITH_HASH (tc, struct ctables_cell, node, hash, &s->cells)
3664     {
3665       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3666         {
3667           const struct ctables_nest *nest = s->nests[a];
3668           for (size_t i = 0; i < nest->n; i++)
3669             if (i != nest->scale_idx)
3670               {
3671                 const struct ctables_cell_value *p_cv
3672                   = (a == ctx->pc_a && i == ctx->pc_a_idx ? pc_cv
3673                      : &ctx->cell->axes[a].cvs[i]);
3674                 const struct ctables_cell_value *t_cv = &tc->axes[a].cvs[i];
3675                 if (p_cv->category != t_cv->category
3676                     || (p_cv->category->type != CCT_TOTAL
3677                         && p_cv->category->type != CCT_SUBTOTAL
3678                         && p_cv->category->type != CCT_POSTCOMPUTE
3679                         && !value_equal (&p_cv->value,
3680                                          &t_cv->value,
3681                                          var_get_width (nest->vars[i]))))
3682                   goto not_equal;
3683               }
3684         }
3685
3686       goto found;
3687
3688     not_equal: ;
3689     }
3690   return 0;
3691
3692 found: ;
3693   const struct ctables_table *t = s->table;
3694   const struct ctables_nest *specs_nest = s->nests[t->summary_axis];
3695   const struct ctables_summary_spec_set *specs = &specs_nest->specs[tc->sv];
3696   return ctables_summary_value (tc->areas, &tc->summaries[ctx->summary_idx],
3697                                 &specs->specs[ctx->summary_idx]);
3698 }
3699
3700 static double
3701 ctables_pcexpr_evaluate (const struct ctables_pcexpr_evaluate_ctx *ctx,
3702                          const struct ctables_pcexpr *e)
3703 {
3704   switch (e->op)
3705     {
3706     case CTPO_CONSTANT:
3707       return e->number;
3708
3709     case CTPO_CAT_NRANGE:
3710     case CTPO_CAT_SRANGE:
3711     case CTPO_CAT_MISSING:
3712     case CTPO_CAT_OTHERNM:
3713       {
3714         struct ctables_cell_value cv = {
3715           .category = ctables_find_category_for_postcompute (ctx->section->table->ctables->dict, ctx->cats, ctx->parse_format, e)
3716         };
3717         assert (cv.category != NULL);
3718
3719         struct hmap *occurrences = &ctx->section->occurrences[ctx->pc_a][ctx->pc_a_idx];
3720         const struct ctables_occurrence *o;
3721
3722         double sum = 0.0;
3723         const struct variable *var = ctx->section->nests[ctx->pc_a]->vars[ctx->pc_a_idx];
3724         HMAP_FOR_EACH (o, struct ctables_occurrence, node, occurrences)
3725           if (ctables_categories_match (ctx->cats, &o->value, var) == cv.category)
3726             {
3727               cv.value = o->value;
3728               sum += ctables_pcexpr_evaluate_category (ctx, &cv);
3729             }
3730         return sum;
3731       }
3732
3733     case CTPO_CAT_NUMBER:
3734     case CTPO_CAT_SUBTOTAL:
3735     case CTPO_CAT_TOTAL:
3736       {
3737         struct ctables_cell_value cv = {
3738           .category = ctables_find_category_for_postcompute (ctx->section->table->ctables->dict, ctx->cats, ctx->parse_format, e),
3739           .value = { .f = e->number },
3740         };
3741         assert (cv.category != NULL);
3742         return ctables_pcexpr_evaluate_category (ctx, &cv);
3743       }
3744
3745     case CTPO_CAT_STRING:
3746       {
3747         int width = var_get_width (ctx->section->nests[ctx->pc_a]->vars[ctx->pc_a_idx]);
3748         char *s = NULL;
3749         if (width > e->string.length)
3750           {
3751             s = xmalloc (width);
3752             buf_copy_rpad (s, width, e->string.string, e->string.length, ' ');
3753           }
3754
3755         const struct ctables_category *category
3756           = ctables_find_category_for_postcompute (
3757             ctx->section->table->ctables->dict,
3758             ctx->cats, ctx->parse_format, e);
3759         assert (category != NULL);
3760
3761         struct ctables_cell_value cv = { .category = category };
3762         if (category->type == CCT_NUMBER)
3763           cv.value.f = category->number;
3764         else if (category->type == CCT_STRING)
3765           cv.value.s = CHAR_CAST (uint8_t *, s ? s : e->string.string);
3766         else
3767           NOT_REACHED ();
3768
3769         double retval = ctables_pcexpr_evaluate_category (ctx, &cv);
3770         free (s);
3771         return retval;
3772       }
3773
3774     case CTPO_ADD:
3775       return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_add);
3776
3777     case CTPO_SUB:
3778       return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_sub);
3779
3780     case CTPO_MUL:
3781       return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_mul);
3782
3783     case CTPO_DIV:
3784       return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_div);
3785
3786     case CTPO_POW:
3787       return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_pow);
3788
3789     case CTPO_NEG:
3790       return ctables_pcexpr_evaluate_nonterminal (ctx, e, 1, ctpo_neg);
3791     }
3792
3793   NOT_REACHED ();
3794 }
3795
3796 static const struct ctables_category *
3797 ctables_cell_postcompute (const struct ctables_section *s,
3798                           const struct ctables_cell *cell,
3799                           enum pivot_axis_type *pc_a_p,
3800                           size_t *pc_a_idx_p)
3801 {
3802   assert (cell->postcompute);
3803   const struct ctables_category *pc_cat = NULL;
3804   for (enum pivot_axis_type pc_a = 0; pc_a < PIVOT_N_AXES; pc_a++)
3805     for (size_t pc_a_idx = 0; pc_a_idx < s->nests[pc_a]->n; pc_a_idx++)
3806       {
3807         const struct ctables_cell_value *cv = &cell->axes[pc_a].cvs[pc_a_idx];
3808         if (cv->category->type == CCT_POSTCOMPUTE)
3809           {
3810             if (pc_cat)
3811               {
3812                 /* Multiple postcomputes cross each other.  The value is
3813                    undefined. */
3814                 return NULL;
3815               }
3816
3817             pc_cat = cv->category;
3818             if (pc_a_p)
3819               *pc_a_p = pc_a;
3820             if (pc_a_idx_p)
3821               *pc_a_idx_p = pc_a_idx;
3822           }
3823       }
3824
3825   assert (pc_cat != NULL);
3826   return pc_cat;
3827 }
3828
3829 static double
3830 ctables_cell_calculate_postcompute (const struct ctables_section *s,
3831                                     const struct ctables_cell *cell,
3832                                     const struct ctables_summary_spec *ss,
3833                                     struct fmt_spec *format,
3834                                     bool *is_ctables_format,
3835                                     size_t summary_idx)
3836 {
3837   enum pivot_axis_type pc_a = 0;
3838   size_t pc_a_idx = 0;
3839   const struct ctables_category *pc_cat = ctables_cell_postcompute (
3840     s, cell, &pc_a, &pc_a_idx);
3841   if (!pc_cat)
3842     return SYSMIS;
3843
3844   const struct ctables_postcompute *pc = pc_cat->pc;
3845   if (pc->specs)
3846     {
3847       for (size_t i = 0; i < pc->specs->n; i++)
3848         {
3849           const struct ctables_summary_spec *ss2 = &pc->specs->specs[i];
3850           if (ss->function == ss2->function
3851               && ss->weighting == ss2->weighting
3852               && ss->calc_area == ss2->calc_area
3853               && ss->percentile == ss2->percentile)
3854             {
3855               *format = ss2->format;
3856               *is_ctables_format = ss2->is_ctables_format;
3857               break;
3858             }
3859         }
3860     }
3861
3862   const struct variable *var = s->nests[pc_a]->vars[pc_a_idx];
3863   const struct ctables_categories *cats = s->table->categories[
3864     var_get_dict_index (var)];
3865   struct ctables_pcexpr_evaluate_ctx ctx = {
3866     .cell = cell,
3867     .section = s,
3868     .cats = cats,
3869     .pc_a = pc_a,
3870     .pc_a_idx = pc_a_idx,
3871     .summary_idx = summary_idx,
3872     .parse_format = pc_cat->parse_format,
3873   };
3874   return ctables_pcexpr_evaluate (&ctx, pc->expr);
3875 }
3876 \f
3877 /* Chi-square test (SIGTEST). */
3878 struct ctables_chisq
3879   {
3880     double alpha;
3881     bool include_mrsets;
3882     bool all_visible;
3883   };
3884
3885 /* Pairwise comparison test (COMPARETEST). */
3886 struct ctables_pairwise
3887   {
3888     enum { PROP, MEAN } type;
3889     double alpha[2];
3890     bool include_mrsets;
3891     bool meansvariance_allcats;
3892     bool all_visible;
3893     enum { BONFERRONI = 1, BH } adjust;
3894     bool merge;
3895     bool apa_style;
3896     bool show_sig;
3897   };
3898
3899
3900
3901 static bool
3902 parse_col_width (struct lexer *lexer, const char *name, double *width)
3903 {
3904   lex_match (lexer, T_EQUALS);
3905   if (lex_match_id (lexer, "DEFAULT"))
3906     *width = SYSMIS;
3907   else if (lex_force_num_range_closed (lexer, name, 0, DBL_MAX))
3908     {
3909       *width = lex_number (lexer);
3910       lex_get (lexer);
3911     }
3912   else
3913     return false;
3914
3915   return true;
3916 }
3917
3918 static bool
3919 parse_bool (struct lexer *lexer, bool *b)
3920 {
3921   if (lex_match_id (lexer, "NO"))
3922     *b = false;
3923   else if (lex_match_id (lexer, "YES"))
3924     *b = true;
3925   else
3926     {
3927       lex_error_expecting (lexer, "YES", "NO");
3928       return false;
3929     }
3930   return true;
3931 }
3932
3933 static void
3934 ctables_chisq_destroy (struct ctables_chisq *chisq)
3935 {
3936   free (chisq);
3937 }
3938
3939 static void
3940 ctables_pairwise_destroy (struct ctables_pairwise *pairwise)
3941 {
3942   free (pairwise);
3943 }
3944
3945 static void
3946 ctables_table_destroy (struct ctables_table *t)
3947 {
3948   if (!t)
3949     return;
3950
3951   for (size_t i = 0; i < t->n_sections; i++)
3952     ctables_section_uninit (&t->sections[i]);
3953   free (t->sections);
3954
3955   for (size_t i = 0; i < t->n_categories; i++)
3956     ctables_categories_unref (t->categories[i]);
3957   free (t->categories);
3958   free (t->show_empty);
3959
3960   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
3961     {
3962       ctables_axis_destroy (t->axes[a]);
3963       ctables_stack_uninit (&t->stacks[a]);
3964     }
3965   free (t->summary_specs.specs);
3966
3967   struct ctables_value *ctv, *next_ctv;
3968   HMAP_FOR_EACH_SAFE (ctv, next_ctv, struct ctables_value, node,
3969                       &t->clabels_values_map)
3970     {
3971       value_destroy (&ctv->value, var_get_width (t->clabels_example));
3972       hmap_delete (&t->clabels_values_map, &ctv->node);
3973       free (ctv);
3974     }
3975   hmap_destroy (&t->clabels_values_map);
3976   free (t->clabels_values);
3977
3978   free (t->sum_vars);
3979   free (t->caption);
3980   free (t->corner);
3981   free (t->title);
3982   ctables_chisq_destroy (t->chisq);
3983   ctables_pairwise_destroy (t->pairwise);
3984   free (t);
3985 }
3986
3987 static void
3988 ctables_destroy (struct ctables *ct)
3989 {
3990   if (!ct)
3991     return;
3992
3993   struct ctables_postcompute *pc, *next_pc;
3994   HMAP_FOR_EACH_SAFE (pc, next_pc, struct ctables_postcompute, hmap_node,
3995                       &ct->postcomputes)
3996     {
3997       free (pc->name);
3998       msg_location_destroy (pc->location);
3999       ctables_pcexpr_destroy (pc->expr);
4000       free (pc->label);
4001       if (pc->specs)
4002         {
4003           ctables_summary_spec_set_uninit (pc->specs);
4004           free (pc->specs);
4005         }
4006       hmap_delete (&ct->postcomputes, &pc->hmap_node);
4007       free (pc);
4008     }
4009   hmap_destroy (&ct->postcomputes);
4010
4011   fmt_settings_uninit (&ct->ctables_formats);
4012   pivot_table_look_unref (ct->look);
4013   free (ct->zero);
4014   free (ct->missing);
4015   free (ct->vlabels);
4016   for (size_t i = 0; i < ct->n_tables; i++)
4017     ctables_table_destroy (ct->tables[i]);
4018   free (ct->tables);
4019   free (ct);
4020 }
4021
4022 static bool
4023 all_strings (struct variable **vars, size_t n_vars,
4024              const struct ctables_category *cat)
4025 {
4026   for (size_t j = 0; j < n_vars; j++)
4027     if (var_is_numeric (vars[j]))
4028       {
4029         msg_at (SE, cat->location,
4030                 _("This category specification may be applied only to string "
4031                   "variables, but this subcommand tries to apply it to "
4032                   "numeric variable %s."),
4033                 var_get_name (vars[j]));
4034         return false;
4035       }
4036   return true;
4037 }
4038
4039 static bool
4040 ctables_table_parse_categories (struct lexer *lexer, struct dictionary *dict,
4041                                 struct ctables *ct, struct ctables_table *t)
4042 {
4043   if (!lex_force_match_id (lexer, "VARIABLES"))
4044     return false;
4045   lex_match (lexer, T_EQUALS);
4046
4047   struct variable **vars;
4048   size_t n_vars;
4049   if (!parse_variables (lexer, dict, &vars, &n_vars, PV_NO_SCRATCH))
4050     return false;
4051
4052   const struct fmt_spec *common_format = var_get_print_format (vars[0]);
4053   for (size_t i = 1; i < n_vars; i++)
4054     {
4055       const struct fmt_spec *f = var_get_print_format (vars[i]);
4056       if (f->type != common_format->type)
4057         {
4058           common_format = NULL;
4059           break;
4060         }
4061     }
4062   bool parse_strings
4063     = (common_format
4064        && (fmt_get_category (common_format->type)
4065            & (FMT_CAT_DATE | FMT_CAT_TIME | FMT_CAT_DATE_COMPONENT)));
4066
4067   struct ctables_categories *c = xmalloc (sizeof *c);
4068   *c = (struct ctables_categories) { .n_refs = 1 };
4069
4070   bool set_categories = false;
4071
4072   size_t allocated_cats = 0;
4073   int cats_start_ofs = -1;
4074   int cats_end_ofs = -1;
4075   if (lex_match (lexer, T_LBRACK))
4076     {
4077       set_categories = true;
4078       cats_start_ofs = lex_ofs (lexer);
4079       do
4080         {
4081           if (c->n_cats >= allocated_cats)
4082             c->cats = x2nrealloc (c->cats, &allocated_cats, sizeof *c->cats);
4083
4084           int start_ofs = lex_ofs (lexer);
4085           struct ctables_category *cat = &c->cats[c->n_cats];
4086           if (!ctables_table_parse_explicit_category (lexer, dict, ct, cat))
4087             goto error;
4088           cat->location = lex_ofs_location (lexer, start_ofs, lex_ofs (lexer) - 1);
4089           c->n_cats++;
4090
4091           lex_match (lexer, T_COMMA);
4092         }
4093       while (!lex_match (lexer, T_RBRACK));
4094       cats_end_ofs = lex_ofs (lexer) - 1;
4095     }
4096
4097   struct ctables_category cat = {
4098     .type = CCT_VALUE,
4099     .include_missing = false,
4100     .sort_ascending = true,
4101   };
4102   bool show_totals = false;
4103   char *total_label = NULL;
4104   bool totals_before = false;
4105   int key_start_ofs = 0;
4106   int key_end_ofs = 0;
4107   while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)
4108     {
4109       if (!c->n_cats && lex_match_id (lexer, "ORDER"))
4110         {
4111           set_categories = true;
4112           lex_match (lexer, T_EQUALS);
4113           if (lex_match_id (lexer, "A"))
4114             cat.sort_ascending = true;
4115           else if (lex_match_id (lexer, "D"))
4116             cat.sort_ascending = false;
4117           else
4118             {
4119               lex_error_expecting (lexer, "A", "D");
4120               goto error;
4121             }
4122         }
4123       else if (!c->n_cats && lex_match_id (lexer, "KEY"))
4124         {
4125           set_categories = true;
4126           key_start_ofs = lex_ofs (lexer) - 1;
4127           lex_match (lexer, T_EQUALS);
4128           if (lex_match_id (lexer, "VALUE"))
4129             cat.type = CCT_VALUE;
4130           else if (lex_match_id (lexer, "LABEL"))
4131             cat.type = CCT_LABEL;
4132           else
4133             {
4134               cat.type = CCT_FUNCTION;
4135               if (!parse_ctables_summary_function (lexer, &cat.sort_function,
4136                                                    &cat.weighting, &cat.area))
4137                 goto error;
4138
4139               if (lex_match (lexer, T_LPAREN))
4140                 {
4141                   cat.sort_var = parse_variable (lexer, dict);
4142                   if (!cat.sort_var)
4143                     goto error;
4144
4145                   if (cat.sort_function == CTSF_PTILE)
4146                     {
4147                       lex_match (lexer, T_COMMA);
4148                       if (!lex_force_num_range_closed (lexer, "PTILE", 0, 100))
4149                         goto error;
4150                       cat.percentile = lex_number (lexer);
4151                       lex_get (lexer);
4152                     }
4153
4154                   if (!lex_force_match (lexer, T_RPAREN))
4155                     goto error;
4156                 }
4157               else if (ctables_function_availability (cat.sort_function)
4158                        == CTFA_SCALE)
4159                 {
4160                   bool UNUSED b = lex_force_match (lexer, T_LPAREN);
4161                   goto error;
4162                 }
4163             }
4164           key_end_ofs = lex_ofs (lexer) - 1;
4165
4166           if (cat.type == CCT_FUNCTION)
4167             {
4168               lex_ofs_error (lexer, key_start_ofs, key_end_ofs,
4169                              _("Data-dependent sorting is not implemented."));
4170               goto error;
4171             }
4172         }
4173       else if (!c->n_cats && lex_match_id (lexer, "MISSING"))
4174         {
4175           set_categories = true;
4176           lex_match (lexer, T_EQUALS);
4177           if (lex_match_id (lexer, "INCLUDE"))
4178             cat.include_missing = true;
4179           else if (lex_match_id (lexer, "EXCLUDE"))
4180             cat.include_missing = false;
4181           else
4182             {
4183               lex_error_expecting (lexer, "INCLUDE", "EXCLUDE");
4184               goto error;
4185             }
4186         }
4187       else if (lex_match_id (lexer, "TOTAL"))
4188         {
4189           set_categories = true;
4190           lex_match (lexer, T_EQUALS);
4191           if (!parse_bool (lexer, &show_totals))
4192             goto error;
4193         }
4194       else if (lex_match_id (lexer, "LABEL"))
4195         {
4196           lex_match (lexer, T_EQUALS);
4197           if (!lex_force_string (lexer))
4198             goto error;
4199           free (total_label);
4200           total_label = ss_xstrdup (lex_tokss (lexer));
4201           lex_get (lexer);
4202         }
4203       else if (lex_match_id (lexer, "POSITION"))
4204         {
4205           lex_match (lexer, T_EQUALS);
4206           if (lex_match_id (lexer, "BEFORE"))
4207             totals_before = true;
4208           else if (lex_match_id (lexer, "AFTER"))
4209             totals_before = false;
4210           else
4211             {
4212               lex_error_expecting (lexer, "BEFORE", "AFTER");
4213               goto error;
4214             }
4215         }
4216       else if (lex_match_id (lexer, "EMPTY"))
4217         {
4218           lex_match (lexer, T_EQUALS);
4219
4220           bool show_empty;
4221           if (lex_match_id (lexer, "INCLUDE"))
4222             show_empty = true;
4223           else if (lex_match_id (lexer, "EXCLUDE"))
4224             show_empty = false;
4225           else
4226             {
4227               lex_error_expecting (lexer, "INCLUDE", "EXCLUDE");
4228               goto error;
4229             }
4230
4231           for (size_t i = 0; i < n_vars; i++)
4232             t->show_empty[var_get_dict_index (vars[i])] = show_empty;
4233         }
4234       else
4235         {
4236           if (!c->n_cats)
4237             lex_error_expecting (lexer, "ORDER", "KEY", "MISSING",
4238                                  "TOTAL", "LABEL", "POSITION", "EMPTY");
4239           else
4240             lex_error_expecting (lexer, "TOTAL", "LABEL", "POSITION", "EMPTY");
4241           goto error;
4242         }
4243     }
4244
4245   if (!c->n_cats)
4246     {
4247       if (key_start_ofs)
4248         cat.location = lex_ofs_location (lexer, key_start_ofs, key_end_ofs);
4249
4250       if (c->n_cats >= allocated_cats)
4251         c->cats = x2nrealloc (c->cats, &allocated_cats, sizeof *c->cats);
4252       c->cats[c->n_cats++] = cat;
4253     }
4254
4255   if (show_totals)
4256     {
4257       if (c->n_cats >= allocated_cats)
4258         c->cats = x2nrealloc (c->cats, &allocated_cats, sizeof *c->cats);
4259
4260       struct ctables_category *totals;
4261       if (totals_before)
4262         {
4263           insert_element (c->cats, c->n_cats, sizeof *c->cats, 0);
4264           totals = &c->cats[0];
4265         }
4266       else
4267         totals = &c->cats[c->n_cats];
4268       c->n_cats++;
4269
4270       *totals = (struct ctables_category) {
4271         .type = CCT_TOTAL,
4272         .total_label = total_label ? total_label : xstrdup (_("Total")),
4273       };
4274     }
4275
4276   struct ctables_category *subtotal = NULL;
4277   for (size_t i = totals_before ? 0 : c->n_cats;
4278        totals_before ? i < c->n_cats : i-- > 0;
4279        totals_before ? i++ : 0)
4280     {
4281       struct ctables_category *cat = &c->cats[i];
4282       switch (cat->type)
4283         {
4284         case CCT_NUMBER:
4285         case CCT_STRING:
4286         case CCT_NRANGE:
4287         case CCT_SRANGE:
4288         case CCT_MISSING:
4289         case CCT_OTHERNM:
4290           cat->subtotal = subtotal;
4291           break;
4292
4293         case CCT_POSTCOMPUTE:
4294           break;
4295
4296         case CCT_SUBTOTAL:
4297           subtotal = cat;
4298           break;
4299
4300         case CCT_TOTAL:
4301         case CCT_VALUE:
4302         case CCT_LABEL:
4303         case CCT_FUNCTION:
4304         case CCT_EXCLUDED_MISSING:
4305           break;
4306         }
4307     }
4308
4309   if (cats_start_ofs != -1)
4310     {
4311       for (size_t i = 0; i < c->n_cats; i++)
4312         {
4313           struct ctables_category *cat = &c->cats[i];
4314           switch (cat->type)
4315             {
4316             case CCT_POSTCOMPUTE:
4317               cat->parse_format = parse_strings ? common_format->type : FMT_F;
4318               struct msg_location *cats_location
4319                 = lex_ofs_location (lexer, cats_start_ofs, cats_end_ofs);
4320               bool ok = ctables_recursive_check_postcompute (
4321                 dict, cat->pc->expr, cat, c, cats_location);
4322               msg_location_destroy (cats_location);
4323               if (!ok)
4324                 goto error;
4325               break;
4326
4327             case CCT_NUMBER:
4328             case CCT_NRANGE:
4329               for (size_t j = 0; j < n_vars; j++)
4330                 if (var_is_alpha (vars[j]))
4331                   {
4332                     msg_at (SE, cat->location,
4333                             _("This category specification may be applied "
4334                               "only to numeric variables, but this "
4335                               "subcommand tries to apply it to string "
4336                               "variable %s."),
4337                             var_get_name (vars[j]));
4338                     goto error;
4339                   }
4340               break;
4341
4342             case CCT_STRING:
4343               if (parse_strings)
4344                 {
4345                   double n;
4346                   if (!parse_category_string (cat->location, cat->string, dict,
4347                                               common_format->type, &n))
4348                     goto error;
4349
4350                   ss_dealloc (&cat->string);
4351
4352                   cat->type = CCT_NUMBER;
4353                   cat->number = n;
4354                 }
4355               else if (!all_strings (vars, n_vars, cat))
4356                 goto error;
4357               break;
4358
4359             case CCT_SRANGE:
4360               if (parse_strings)
4361                 {
4362                   double n[2];
4363
4364                   if (!cat->srange[0].string)
4365                     n[0] = -DBL_MAX;
4366                   else if (!parse_category_string (cat->location,
4367                                                    cat->srange[0], dict,
4368                                                    common_format->type, &n[0]))
4369                     goto error;
4370
4371                   if (!cat->srange[1].string)
4372                     n[1] = DBL_MAX;
4373                   else if (!parse_category_string (cat->location,
4374                                                    cat->srange[1], dict,
4375                                                    common_format->type, &n[1]))
4376                     goto error;
4377
4378                   ss_dealloc (&cat->srange[0]);
4379                   ss_dealloc (&cat->srange[1]);
4380
4381                   cat->type = CCT_NRANGE;
4382                   cat->nrange[0] = n[0];
4383                   cat->nrange[1] = n[1];
4384                 }
4385               else if (!all_strings (vars, n_vars, cat))
4386                 goto error;
4387               break;
4388
4389             case CCT_MISSING:
4390             case CCT_OTHERNM:
4391             case CCT_SUBTOTAL:
4392             case CCT_TOTAL:
4393             case CCT_VALUE:
4394             case CCT_LABEL:
4395             case CCT_FUNCTION:
4396             case CCT_EXCLUDED_MISSING:
4397               break;
4398             }
4399         }
4400     }
4401
4402   if (set_categories)
4403     for (size_t i = 0; i < n_vars; i++)
4404       {
4405         struct ctables_categories **cp
4406           = &t->categories[var_get_dict_index (vars[i])];
4407         ctables_categories_unref (*cp);
4408         *cp = c;
4409         c->n_refs++;
4410       }
4411
4412   ctables_categories_unref (c);
4413   free (vars);
4414   return true;
4415
4416 error:
4417   ctables_categories_unref (c);
4418   free (vars);
4419   return false;
4420 }
4421 \f
4422
4423 struct merge_item
4424   {
4425     const struct ctables_summary_spec_set *set;
4426     size_t ofs;
4427   };
4428
4429 static int
4430 merge_item_compare_3way (const struct merge_item *a, const struct merge_item *b)
4431 {
4432   const struct ctables_summary_spec *as = &a->set->specs[a->ofs];
4433   const struct ctables_summary_spec *bs = &b->set->specs[b->ofs];
4434   if (as->function != bs->function)
4435     return as->function > bs->function ? 1 : -1;
4436   else if (as->weighting != bs->weighting)
4437     return as->weighting > bs->weighting ? 1 : -1;
4438   else if (as->calc_area != bs->calc_area)
4439     return as->calc_area > bs->calc_area ? 1 : -1;
4440   else if (as->percentile != bs->percentile)
4441     return as->percentile < bs->percentile ? 1 : -1;
4442
4443   const char *as_label = as->label ? as->label : "";
4444   const char *bs_label = bs->label ? bs->label : "";
4445   return strcmp (as_label, bs_label);
4446 }
4447
4448 static void
4449 ctables_table_add_section (struct ctables_table *t, enum pivot_axis_type a,
4450                            size_t ix[PIVOT_N_AXES])
4451 {
4452   if (a < PIVOT_N_AXES)
4453     {
4454       size_t limit = MAX (t->stacks[a].n, 1);
4455       for (ix[a] = 0; ix[a] < limit; ix[a]++)
4456         ctables_table_add_section (t, a + 1, ix);
4457     }
4458   else
4459     {
4460       struct ctables_section *s = &t->sections[t->n_sections++];
4461       *s = (struct ctables_section) {
4462         .table = t,
4463         .cells = HMAP_INITIALIZER (s->cells),
4464       };
4465       for (a = 0; a < PIVOT_N_AXES; a++)
4466         if (t->stacks[a].n)
4467           {
4468             struct ctables_nest *nest = &t->stacks[a].nests[ix[a]];
4469             s->nests[a] = nest;
4470             s->occurrences[a] = xnmalloc (nest->n, sizeof *s->occurrences[a]);
4471             for (size_t i = 0; i < nest->n; i++)
4472               hmap_init (&s->occurrences[a][i]);
4473         }
4474       for (enum ctables_area_type at = 0; at < N_CTATS; at++)
4475         hmap_init (&s->areas[at]);
4476     }
4477 }
4478
4479 static char *
4480 ctables_format (double d, const struct fmt_spec *format,
4481                 const struct fmt_settings *settings)
4482 {
4483   const union value v = { .f = d };
4484   char *s = data_out_stretchy (&v, "UTF-8", format, settings, NULL);
4485
4486   /* The custom-currency specifications for NEQUAL, PAREN, and PCTPAREN don't
4487      produce the results we want for negative numbers, putting the negative
4488      sign in the wrong spot, before the prefix instead of after it.  We can't,
4489      in fact, produce the desired results using a custom-currency
4490      specification.  Instead, we postprocess the output, moving the negative
4491      sign into place:
4492
4493          NEQUAL:   "-N=3"  => "N=-3"
4494          PAREN:    "-(3)"  => "(-3)"
4495          PCTPAREN: "-(3%)" => "(-3%)"
4496
4497      This transformation doesn't affect NEGPAREN. */
4498   char *minus_src = strchr (s, '-');
4499   if (minus_src && (minus_src == s || minus_src[-1] != 'E'))
4500     {
4501       char *n_equals = strstr (s, "N=");
4502       char *lparen = strchr (s, '(');
4503       char *minus_dst = n_equals ? n_equals + 1 : lparen;
4504       if (minus_dst)
4505         move_element (s, minus_dst - s + 1, 1, minus_src - s, minus_dst - s);
4506     }
4507   return s;
4508 }
4509
4510 static bool
4511 all_hidden_vlabels (const struct ctables_table *t, enum pivot_axis_type a)
4512 {
4513   for (size_t i = 0; i < t->stacks[a].n; i++)
4514     {
4515       struct ctables_nest *nest = &t->stacks[a].nests[i];
4516       if (nest->n != 1 || nest->scale_idx != 0)
4517         return false;
4518
4519       enum ctables_vlabel vlabel
4520         = t->ctables->vlabels[var_get_dict_index (nest->vars[0])];
4521       if (vlabel != CTVL_NONE)
4522         return false;
4523     }
4524   return true;
4525 }
4526
4527 static int
4528 compare_ints_3way (int a, int b)
4529 {
4530   return a < b ? -1 : a > b;
4531 }
4532
4533 static int
4534 ctables_cell_compare_leaf_3way (const void *a_, const void *b_,
4535                                 const void *aux UNUSED)
4536 {
4537   struct ctables_cell *const *ap = a_;
4538   struct ctables_cell *const *bp = b_;
4539   const struct ctables_cell *a = *ap;
4540   const struct ctables_cell *b = *bp;
4541
4542   if (a == b)
4543     {
4544       assert (a_ == b_);
4545       return 0;
4546     }
4547
4548   for (enum pivot_axis_type axis = 0; axis < PIVOT_N_AXES; axis++)
4549     {
4550       int cmp = compare_ints_3way (a->axes[axis].leaf, b->axes[axis].leaf);
4551       if (cmp)
4552         return cmp;
4553     }
4554
4555   const struct ctables_value *a_ctv = ctables_value_find (a);
4556   const struct ctables_value *b_ctv = ctables_value_find (b);
4557   if (a_ctv && b_ctv)
4558     {
4559       int cmp = compare_ints_3way (a_ctv->leaf, b_ctv->leaf);
4560       if (cmp)
4561         return cmp;
4562     }
4563   else
4564     assert (!a_ctv && !b_ctv);
4565   return 0;
4566 }
4567
4568 static void
4569 ctables_table_output (struct ctables *ct, struct ctables_table *t)
4570 {
4571   struct pivot_table *pt = pivot_table_create__ (
4572     (t->title
4573      ? pivot_value_new_user_text (t->title, SIZE_MAX)
4574      : pivot_value_new_text (N_("Custom Tables"))),
4575     "Custom Tables");
4576   if (t->caption)
4577     pivot_table_set_caption (
4578       pt, pivot_value_new_user_text (t->caption, SIZE_MAX));
4579   if (t->corner)
4580     pivot_table_set_corner_text (
4581       pt, pivot_value_new_user_text (t->corner, SIZE_MAX));
4582
4583   bool summary_dimension = (t->summary_axis != t->slabels_axis
4584                             || (!t->slabels_visible
4585                                 && t->summary_specs.n > 1));
4586   if (summary_dimension)
4587     {
4588       struct pivot_dimension *d = pivot_dimension_create (
4589         pt, t->slabels_axis, N_("Statistics"));
4590       const struct ctables_summary_spec_set *specs = &t->summary_specs;
4591       if (!t->slabels_visible)
4592         d->hide_all_labels = true;
4593       for (size_t i = 0; i < specs->n; i++)
4594         pivot_category_create_leaf (
4595           d->root, ctables_summary_label (&specs->specs[i], t->cilevel));
4596     }
4597
4598   bool categories_dimension = t->clabels_example != NULL;
4599   if (categories_dimension)
4600     {
4601       struct pivot_dimension *d = pivot_dimension_create (
4602         pt, t->label_axis[t->clabels_from_axis],
4603         t->clabels_from_axis == PIVOT_AXIS_ROW
4604         ? N_("Row Categories")
4605         : N_("Column Categories"));
4606       const struct variable *var = t->clabels_example;
4607       const struct ctables_categories *c = t->categories[var_get_dict_index (var)];
4608       for (size_t i = 0; i < t->n_clabels_values; i++)
4609         {
4610           const struct ctables_value *value = t->clabels_values[i];
4611           const struct ctables_category *cat = ctables_categories_match (c, &value->value, var);
4612           assert (cat != NULL);
4613           pivot_category_create_leaf (
4614             d->root, ctables_category_create_value_label (c, cat,
4615                                                           t->clabels_example,
4616                                                           &value->value));
4617         }
4618     }
4619
4620   pivot_table_set_look (pt, ct->look);
4621   struct pivot_dimension *d[PIVOT_N_AXES];
4622   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
4623     {
4624       static const char *names[] = {
4625         [PIVOT_AXIS_ROW] = N_("Rows"),
4626         [PIVOT_AXIS_COLUMN] = N_("Columns"),
4627         [PIVOT_AXIS_LAYER] = N_("Layers"),
4628       };
4629       d[a] = (t->axes[a] || a == t->summary_axis
4630               ? pivot_dimension_create (pt, a, names[a])
4631               : NULL);
4632       if (!d[a])
4633         continue;
4634
4635       assert (t->axes[a]);
4636
4637       for (size_t i = 0; i < t->stacks[a].n; i++)
4638         {
4639           struct ctables_nest *nest = &t->stacks[a].nests[i];
4640           struct ctables_section **sections = xnmalloc (t->n_sections,
4641                                                         sizeof *sections);
4642           size_t n_sections = 0;
4643
4644           size_t n_total_cells = 0;
4645           size_t max_depth = 0;
4646           for (size_t j = 0; j < t->n_sections; j++)
4647             if (t->sections[j].nests[a] == nest)
4648               {
4649                 struct ctables_section *s = &t->sections[j];
4650                 sections[n_sections++] = s;
4651                 n_total_cells += hmap_count (&s->cells);
4652
4653                 size_t depth = s->nests[a]->n;
4654                 max_depth = MAX (depth, max_depth);
4655               }
4656
4657           struct ctables_cell **sorted = xnmalloc (n_total_cells,
4658                                                    sizeof *sorted);
4659           size_t n_sorted = 0;
4660
4661           for (size_t j = 0; j < n_sections; j++)
4662             {
4663               struct ctables_section *s = sections[j];
4664
4665               struct ctables_cell *cell;
4666               HMAP_FOR_EACH (cell, struct ctables_cell, node, &s->cells)
4667                 if (!cell->hide)
4668                   sorted[n_sorted++] = cell;
4669               assert (n_sorted <= n_total_cells);
4670             }
4671
4672           struct ctables_cell_sort_aux aux = { .nest = nest, .a = a };
4673           sort (sorted, n_sorted, sizeof *sorted, ctables_cell_compare_3way, &aux);
4674
4675           struct ctables_level
4676             {
4677               enum ctables_level_type
4678                 {
4679                   CTL_VAR,          /* Variable label for nest->vars[var_idx]. */
4680                   CTL_CATEGORY,     /* Category for nest->vars[var_idx]. */
4681                   CTL_SUMMARY,      /* Summary functions. */
4682                 }
4683                 type;
4684
4685               enum settings_value_show vlabel; /* CTL_VAR only. */
4686               size_t var_idx;
4687             };
4688           struct ctables_level *levels = xnmalloc (1 + 2 * max_depth, sizeof *levels);
4689           size_t n_levels = 0;
4690           for (size_t k = 0; k < nest->n; k++)
4691             {
4692               enum ctables_vlabel vlabel = ct->vlabels[var_get_dict_index (nest->vars[k])];
4693               if (vlabel == CTVL_NONE && nest->scale_idx == k)
4694                 vlabel = CTVL_NAME;
4695               if (vlabel != CTVL_NONE)
4696                 {
4697                   levels[n_levels++] = (struct ctables_level) {
4698                     .type = CTL_VAR,
4699                     .vlabel = (enum settings_value_show) vlabel,
4700                     .var_idx = k,
4701                   };
4702                 }
4703
4704               if (nest->scale_idx != k
4705                   && (k != nest->n - 1 || t->label_axis[a] == a))
4706                 {
4707                   levels[n_levels++] = (struct ctables_level) {
4708                     .type = CTL_CATEGORY,
4709                     .var_idx = k,
4710                   };
4711                 }
4712             }
4713
4714           if (!summary_dimension && a == t->slabels_axis)
4715             {
4716               levels[n_levels++] = (struct ctables_level) {
4717                 .type = CTL_SUMMARY,
4718                 .var_idx = SIZE_MAX,
4719               };
4720             }
4721
4722           /* Pivot categories:
4723
4724              - variable label for nest->vars[0], if vlabel != CTVL_NONE
4725              - category for nest->vars[0], if nest->scale_idx != 0
4726              - variable label for nest->vars[1], if vlabel != CTVL_NONE
4727              - category for nest->vars[1], if nest->scale_idx != 1
4728              ...
4729              - variable label for nest->vars[n - 1], if vlabel != CTVL_NONE
4730              - category for nest->vars[n - 1], if t->label_axis[a] == a && nest->scale_idx != n - 1.
4731              - summary function, if 'a == t->slabels_axis && a ==
4732              t->summary_axis'.
4733
4734              Additional dimensions:
4735
4736              - If 'a == t->slabels_axis && a != t->summary_axis', add a summary
4737              dimension.
4738              - If 't->label_axis[b] == a' for some 'b != a', add a category
4739              dimension to 'a'.
4740           */
4741
4742
4743           struct pivot_category **groups = xnmalloc (1 + 2 * max_depth, sizeof *groups);
4744           int prev_leaf = 0;
4745           for (size_t j = 0; j < n_sorted; j++)
4746             {
4747               struct ctables_cell *cell = sorted[j];
4748               struct ctables_cell *prev = j > 0 ? sorted[j - 1] : NULL;
4749
4750               size_t n_common = 0;
4751               if (j > 0)
4752                 {
4753                   for (; n_common < n_levels; n_common++)
4754                     {
4755                       const struct ctables_level *level = &levels[n_common];
4756                       if (level->type == CTL_CATEGORY)
4757                         {
4758                           size_t var_idx = level->var_idx;
4759                           const struct ctables_category *c = cell->axes[a].cvs[var_idx].category;
4760                           if (prev->axes[a].cvs[var_idx].category != c)
4761                             break;
4762                           else if (c->type != CCT_SUBTOTAL
4763                                    && c->type != CCT_TOTAL
4764                                    && c->type != CCT_POSTCOMPUTE
4765                                    && !value_equal (&prev->axes[a].cvs[var_idx].value,
4766                                                     &cell->axes[a].cvs[var_idx].value,
4767                                                     var_get_type (nest->vars[var_idx])))
4768                             break;
4769                         }
4770                     }
4771                 }
4772
4773               for (size_t k = n_common; k < n_levels; k++)
4774                 {
4775                   const struct ctables_level *level = &levels[k];
4776                   struct pivot_category *parent = k ? groups[k - 1] : d[a]->root;
4777                   if (level->type == CTL_SUMMARY)
4778                     {
4779                       assert (k == n_levels - 1);
4780
4781                       const struct ctables_summary_spec_set *specs = &t->summary_specs;
4782                       for (size_t m = 0; m < specs->n; m++)
4783                         {
4784                           int leaf = pivot_category_create_leaf (
4785                             parent, ctables_summary_label (&specs->specs[m],
4786                                                            t->cilevel));
4787                           if (!m)
4788                             prev_leaf = leaf;
4789                         }
4790                     }
4791                   else
4792                     {
4793                       const struct variable *var = nest->vars[level->var_idx];
4794                       struct pivot_value *label;
4795                       if (level->type == CTL_VAR)
4796                         {
4797                           label = pivot_value_new_variable (var);
4798                           label->variable.show = level->vlabel;
4799                         }
4800                       else if (level->type == CTL_CATEGORY)
4801                         {
4802                           const struct ctables_cell_value *cv = &cell->axes[a].cvs[level->var_idx];
4803                           label = ctables_category_create_value_label (
4804                             t->categories[var_get_dict_index (var)],
4805                             cv->category, var, &cv->value);
4806                         }
4807                       else
4808                         NOT_REACHED ();
4809
4810                       if (k == n_levels - 1)
4811                         prev_leaf = pivot_category_create_leaf (parent, label);
4812                       else
4813                         groups[k] = pivot_category_create_group__ (parent, label);
4814                     }
4815                 }
4816
4817               cell->axes[a].leaf = prev_leaf;
4818             }
4819           free (sorted);
4820           free (groups);
4821           free (levels);
4822           free (sections);
4823
4824         }
4825
4826       d[a]->hide_all_labels = all_hidden_vlabels (t, a);
4827     }
4828
4829   {
4830     size_t n_total_cells = 0;
4831     for (size_t j = 0; j < t->n_sections; j++)
4832       n_total_cells += hmap_count (&t->sections[j].cells);
4833
4834     struct ctables_cell **sorted = xnmalloc (n_total_cells, sizeof *sorted);
4835     size_t n_sorted = 0;
4836     for (size_t j = 0; j < t->n_sections; j++)
4837       {
4838         const struct ctables_section *s = &t->sections[j];
4839         struct ctables_cell *cell;
4840         HMAP_FOR_EACH (cell, struct ctables_cell, node, &s->cells)
4841           if (!cell->hide)
4842             sorted[n_sorted++] = cell;
4843       }
4844     assert (n_sorted <= n_total_cells);
4845     sort (sorted, n_sorted, sizeof *sorted, ctables_cell_compare_leaf_3way,
4846           NULL);
4847     size_t ids[N_CTATS];
4848     memset (ids, 0, sizeof ids);
4849     for (size_t j = 0; j < n_sorted; j++)
4850       {
4851         struct ctables_cell *cell = sorted[j];
4852         for (enum ctables_area_type at = 0; at < N_CTATS; at++)
4853           {
4854             struct ctables_area *area = cell->areas[at];
4855             if (!area->sequence)
4856               area->sequence = ++ids[at];
4857           }
4858       }
4859
4860     free (sorted);
4861   }
4862
4863   for (size_t i = 0; i < t->n_sections; i++)
4864     {
4865       struct ctables_section *s = &t->sections[i];
4866
4867       struct ctables_cell *cell;
4868       HMAP_FOR_EACH (cell, struct ctables_cell, node, &s->cells)
4869         {
4870           if (cell->hide)
4871             continue;
4872
4873           const struct ctables_value *ctv = ctables_value_find (cell);
4874           const struct ctables_nest *specs_nest = s->nests[t->summary_axis];
4875           const struct ctables_summary_spec_set *specs = &specs_nest->specs[cell->sv];
4876           for (size_t j = 0; j < specs->n; j++)
4877             {
4878               size_t dindexes[5];
4879               size_t n_dindexes = 0;
4880
4881               if (summary_dimension)
4882                 dindexes[n_dindexes++] = specs->specs[j].axis_idx;
4883
4884               if (ctv)
4885                 dindexes[n_dindexes++] = ctv->leaf;
4886
4887               for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
4888                 if (d[a])
4889                   {
4890                     int leaf = cell->axes[a].leaf;
4891                     if (a == t->summary_axis && !summary_dimension)
4892                       leaf += specs->specs[j].axis_idx;
4893                     dindexes[n_dindexes++] = leaf;
4894                   }
4895
4896               const struct ctables_summary_spec *ss = &specs->specs[j];
4897
4898               struct fmt_spec format = specs->specs[j].format;
4899               bool is_ctables_format = ss->is_ctables_format;
4900               double d = (cell->postcompute
4901                           ? ctables_cell_calculate_postcompute (
4902                             s, cell, ss, &format, &is_ctables_format, j)
4903                           : ctables_summary_value (cell->areas,
4904                                                    &cell->summaries[j], ss));
4905
4906               struct pivot_value *value;
4907               if (ct->hide_threshold != 0
4908                   && d < ct->hide_threshold
4909                   && ss->function == CTSF_COUNT)
4910                 {
4911                   value = pivot_value_new_user_text_nocopy (
4912                     xasprintf ("<%d", ct->hide_threshold));
4913                 }
4914               else if (d == 0 && ct->zero)
4915                 value = pivot_value_new_user_text (ct->zero, SIZE_MAX);
4916               else if (d == SYSMIS && ct->missing)
4917                 value = pivot_value_new_user_text (ct->missing, SIZE_MAX);
4918               else if (is_ctables_format)
4919                 value = pivot_value_new_user_text_nocopy (
4920                   ctables_format (d, &format, &ct->ctables_formats));
4921               else
4922                 {
4923                   value = pivot_value_new_number (d);
4924                   value->numeric.format = format;
4925                 }
4926               /* XXX should text values be right-justified? */
4927               pivot_table_put (pt, dindexes, n_dindexes, value);
4928             }
4929         }
4930     }
4931
4932   pivot_table_submit (pt);
4933 }
4934
4935 static bool
4936 ctables_check_label_position (struct ctables_table *t, struct lexer *lexer,
4937                               enum pivot_axis_type a)
4938 {
4939   enum pivot_axis_type label_pos = t->label_axis[a];
4940   if (label_pos == a)
4941     return true;
4942
4943   const struct ctables_stack *stack = &t->stacks[a];
4944   if (!stack->n)
4945     return true;
4946
4947   const struct ctables_nest *n0 = &stack->nests[0];
4948   if (n0->n == 0)
4949     {
4950       assert (stack->n == 1);
4951       return true;
4952     }
4953
4954   const struct variable *v0 = n0->vars[n0->n - 1];
4955   struct ctables_categories *c0 = t->categories[var_get_dict_index (v0)];
4956   t->clabels_example = v0;
4957
4958   for (size_t i = 0; i < c0->n_cats; i++)
4959     if (c0->cats[i].type == CCT_FUNCTION)
4960       {
4961         msg (SE, _("Category labels may not be moved to another axis when "
4962                    "sorting by a summary function."));
4963         lex_ofs_msg (lexer, SN, t->clabels_start_ofs, t->clabels_end_ofs,
4964                      _("This syntax moves category labels to another axis."));
4965         msg_at (SN, c0->cats[i].location,
4966                 _("This syntax requests sorting by a summary function."));
4967         return false;
4968       }
4969
4970   for (size_t i = 0; i < stack->n; i++)
4971     {
4972       const struct ctables_nest *ni = &stack->nests[i];
4973       assert (ni->n > 0);
4974       const struct variable *vi = ni->vars[ni->n - 1];
4975       if (n0->n - 1 == ni->scale_idx)
4976         {
4977           msg (SE, _("To move category labels from one axis to another, "
4978                      "the variables whose labels are to be moved must be "
4979                      "categorical, but %s is scale."), var_get_name (vi));
4980           lex_ofs_msg (lexer, SN, t->clabels_start_ofs, t->clabels_end_ofs,
4981                        _("This syntax moves category labels to another axis."));
4982           return false;
4983         }
4984     }
4985
4986   for (size_t i = 1; i < stack->n; i++)
4987     {
4988       const struct ctables_nest *ni = &stack->nests[i];
4989       assert (ni->n > 0);
4990       const struct variable *vi = ni->vars[ni->n - 1];
4991       struct ctables_categories *ci = t->categories[var_get_dict_index (vi)];
4992
4993       if (var_get_width (v0) != var_get_width (vi))
4994         {
4995           msg (SE, _("To move category labels from one axis to another, "
4996                      "the variables whose labels are to be moved must all "
4997                      "have the same width, but %s has width %d and %s has "
4998                      "width %d."),
4999                var_get_name (v0), var_get_width (v0),
5000                var_get_name (vi), var_get_width (vi));
5001           lex_ofs_msg (lexer, SN, t->clabels_start_ofs, t->clabels_end_ofs,
5002                        _("This syntax moves category labels to another axis."));
5003           return false;
5004         }
5005       if (!val_labs_equal (var_get_value_labels (v0),
5006                            var_get_value_labels (vi)))
5007         {
5008           msg (SE, _("To move category labels from one axis to another, "
5009                      "the variables whose labels are to be moved must all "
5010                      "have the same value labels, but %s and %s have "
5011                      "different value labels."),
5012                var_get_name (v0), var_get_name (vi));
5013           lex_ofs_msg (lexer, SN, t->clabels_start_ofs, t->clabels_end_ofs,
5014                        _("This syntax moves category labels to another axis."));
5015           return false;
5016         }
5017       if (!ctables_categories_equal (c0, ci))
5018         {
5019           msg (SE, _("To move category labels from one axis to another, "
5020                      "the variables whose labels are to be moved must all "
5021                      "have the same category specifications, but %s and %s "
5022                      "have different category specifications."),
5023                var_get_name (v0), var_get_name (vi));
5024           lex_ofs_msg (lexer, SN, t->clabels_start_ofs, t->clabels_end_ofs,
5025                        _("This syntax moves category labels to another axis."));
5026           return false;
5027         }
5028     }
5029
5030   return true;
5031 }
5032
5033 static size_t
5034 add_sum_var (struct variable *var,
5035              struct variable ***sum_vars, size_t *n, size_t *allocated)
5036 {
5037   for (size_t i = 0; i < *n; i++)
5038     if (var == (*sum_vars)[i])
5039       return i;
5040
5041   if (*n >= *allocated)
5042     *sum_vars = x2nrealloc (*sum_vars, allocated, sizeof **sum_vars);
5043   (*sum_vars)[*n] = var;
5044   return (*n)++;
5045 }
5046
5047 static enum ctables_area_type
5048 rotate_area (enum ctables_area_type area)
5049 {
5050   return area;
5051   switch (area)
5052     {
5053     case CTAT_TABLE:
5054     case CTAT_LAYER:
5055     case CTAT_SUBTABLE:
5056       return area;
5057
5058     case CTAT_LAYERROW:
5059       return CTAT_LAYERCOL;
5060
5061     case CTAT_LAYERCOL:
5062       return CTAT_LAYERROW;
5063
5064     case CTAT_ROW:
5065       return CTAT_COL;
5066
5067     case CTAT_COL:
5068       return CTAT_ROW;
5069     }
5070
5071   NOT_REACHED ();
5072 }
5073
5074 static void
5075 enumerate_sum_vars (const struct ctables_axis *a,
5076                     struct variable ***sum_vars, size_t *n, size_t *allocated)
5077 {
5078   if (!a)
5079     return;
5080
5081   switch (a->op)
5082     {
5083     case CTAO_VAR:
5084       for (size_t i = 0; i < N_CSVS; i++)
5085         for (size_t j = 0; j < a->specs[i].n; j++)
5086           {
5087             struct ctables_summary_spec *spec = &a->specs[i].specs[j];
5088             if (spec->function == CTSF_areaPCT_SUM)
5089               spec->sum_var_idx = add_sum_var (a->var, sum_vars, n, allocated);
5090           }
5091       break;
5092
5093     case CTAO_STACK:
5094     case CTAO_NEST:
5095       for (size_t i = 0; i < 2; i++)
5096         enumerate_sum_vars (a->subs[i], sum_vars, n, allocated);
5097       break;
5098     }
5099 }
5100
5101 static bool
5102 ctables_prepare_table (struct ctables_table *t, struct lexer *lexer)
5103 {
5104   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
5105     if (t->axes[a])
5106       {
5107         t->stacks[a] = enumerate_fts (a, t->axes[a]);
5108
5109         for (size_t j = 0; j < t->stacks[a].n; j++)
5110           {
5111             struct ctables_nest *nest = &t->stacks[a].nests[j];
5112             for (enum ctables_area_type at = 0; at < N_CTATS; at++)
5113               {
5114                 nest->areas[at] = xmalloc (nest->n * sizeof *nest->areas[at]);
5115                 nest->n_areas[at] = 0;
5116
5117                 enum pivot_axis_type ata, atb;
5118                 if (at == CTAT_ROW || at == CTAT_LAYERROW)
5119                   {
5120                     ata = PIVOT_AXIS_ROW;
5121                     atb = PIVOT_AXIS_COLUMN;
5122                   }
5123                 else if (at == CTAT_COL || at == CTAT_LAYERCOL)
5124                   {
5125                     ata = PIVOT_AXIS_COLUMN;
5126                     atb = PIVOT_AXIS_ROW;
5127                   }
5128
5129                 if (at == CTAT_LAYER
5130                     ? a != PIVOT_AXIS_LAYER && t->label_axis[a] == PIVOT_AXIS_LAYER
5131                     : at == CTAT_LAYERCOL || at == CTAT_LAYERROW
5132                     ? a == atb && t->label_axis[a] != a
5133                     : false)
5134                   {
5135                     for (size_t k = nest->n - 1; k < nest->n; k--)
5136                       if (k != nest->scale_idx)
5137                         {
5138                           nest->areas[at][nest->n_areas[at]++] = k;
5139                           break;
5140                         }
5141                     continue;
5142                   }
5143
5144                 if (at == CTAT_LAYER ? a != PIVOT_AXIS_LAYER
5145                     : at == CTAT_LAYERROW || at == CTAT_LAYERCOL ? a == atb
5146                     : at == CTAT_TABLE ? true
5147                     : false)
5148                   continue;
5149
5150                 for (size_t k = 0; k < nest->n; k++)
5151                   if (k != nest->scale_idx)
5152                     nest->areas[at][nest->n_areas[at]++] = k;
5153
5154                 int n_drop;
5155                 switch (at)
5156                   {
5157                   case CTAT_SUBTABLE:
5158 #define L PIVOT_AXIS_LAYER
5159                     n_drop = (t->clabels_from_axis == L ? a != L
5160                               : t->clabels_to_axis == L ? (t->clabels_from_axis == a ? -1 : a != L)
5161                               : t->clabels_from_axis == a ? 2
5162                               : 0);
5163 #undef L
5164                     break;
5165
5166                   case CTAT_LAYERROW:
5167                   case CTAT_LAYERCOL:
5168                     n_drop = a == ata && t->label_axis[ata] == atb;
5169                     break;
5170
5171                   case CTAT_ROW:
5172                   case CTAT_COL:
5173                     n_drop = (a == ata ? t->label_axis[ata] == atb
5174                               : a != atb ? 0
5175                               : t->clabels_from_axis == atb ? -1
5176                               : t->clabels_to_axis != atb ? 1
5177                               : 0);
5178                     break;
5179
5180                   case CTAT_LAYER:
5181                   case CTAT_TABLE:
5182                     n_drop = 0;
5183                     break;
5184                   }
5185
5186                 if (n_drop < 0)
5187                   {
5188                     size_t n = nest->n_areas[at];
5189                     if (n > 1)
5190                       {
5191                         nest->areas[at][n - 2] = nest->areas[at][n - 1];
5192                         nest->n_areas[at]--;
5193                       }
5194                   }
5195                 else
5196                   {
5197                     for (int i = 0; i < n_drop; i++)
5198                       if (nest->n_areas[at] > 0)
5199                         nest->n_areas[at]--;
5200                   }
5201               }
5202           }
5203       }
5204     else
5205       {
5206         struct ctables_nest *nest = xmalloc (sizeof *nest);
5207         *nest = (struct ctables_nest) {
5208           .n = 0,
5209           .scale_idx = SIZE_MAX,
5210           .summary_idx = SIZE_MAX
5211         };
5212         t->stacks[a] = (struct ctables_stack) { .nests = nest, .n = 1 };
5213
5214         /* There's no point in moving labels away from an axis that has no
5215            labels, so avoid dealing with the special cases around that. */
5216         t->label_axis[a] = a;
5217       }
5218
5219   struct ctables_stack *stack = &t->stacks[t->summary_axis];
5220   for (size_t i = 0; i < stack->n; i++)
5221     {
5222       struct ctables_nest *nest = &stack->nests[i];
5223       if (!nest->specs[CSV_CELL].n)
5224         {
5225           struct ctables_summary_spec_set *ss = &nest->specs[CSV_CELL];
5226           ss->specs = xmalloc (sizeof *ss->specs);
5227           ss->n = 1;
5228
5229           enum ctables_summary_function function
5230             = ss->is_scale ? CTSF_MEAN : CTSF_COUNT;
5231
5232           if (!ss->var)
5233             {
5234               nest->summary_idx = nest->n - 1;
5235               ss->var = nest->vars[nest->summary_idx];
5236             }
5237           *ss->specs = (struct ctables_summary_spec) {
5238             .function = function,
5239             .weighting = ss->is_scale ? CTW_EFFECTIVE : CTW_DICTIONARY,
5240             .format = ctables_summary_default_format (function, ss->var),
5241           };
5242
5243           ctables_summary_spec_set_clone (&nest->specs[CSV_TOTAL],
5244                                           &nest->specs[CSV_CELL]);
5245         }
5246       else if (!nest->specs[CSV_TOTAL].n)
5247         ctables_summary_spec_set_clone (&nest->specs[CSV_TOTAL],
5248                                         &nest->specs[CSV_CELL]);
5249
5250       if (t->label_axis[PIVOT_AXIS_ROW] == PIVOT_AXIS_COLUMN
5251           || t->label_axis[PIVOT_AXIS_COLUMN] == PIVOT_AXIS_ROW)
5252         {
5253           for (enum ctables_summary_variant sv = 0; sv < N_CSVS; sv++)
5254             for (size_t i = 0; i < nest->specs[sv].n; i++)
5255               {
5256                 struct ctables_summary_spec *ss = &nest->specs[sv].specs[i];
5257                 const struct ctables_function_info *cfi =
5258                   &ctables_function_info[ss->function];
5259                 if (cfi->is_area)
5260                   ss->calc_area = rotate_area (ss->calc_area);
5261               }
5262         }
5263
5264       if (t->ctables->smissing_listwise)
5265         {
5266           struct variable **listwise_vars = NULL;
5267           size_t n = 0;
5268           size_t allocated = 0;
5269
5270           for (size_t j = nest->group_head; j < stack->n; j++)
5271             {
5272               const struct ctables_nest *other_nest = &stack->nests[j];
5273               if (other_nest->group_head != nest->group_head)
5274                 break;
5275
5276               if (nest != other_nest && other_nest->scale_idx < other_nest->n)
5277                 {
5278                   if (n >= allocated)
5279                     listwise_vars = x2nrealloc (listwise_vars, &allocated,
5280                                                 sizeof *listwise_vars);
5281                   listwise_vars[n++] = other_nest->vars[other_nest->scale_idx];
5282                 }
5283             }
5284           for (enum ctables_summary_variant sv = 0; sv < N_CSVS; sv++)
5285             {
5286               if (sv > 0)
5287                 listwise_vars = xmemdup (listwise_vars,
5288                                          n * sizeof *listwise_vars);
5289               nest->specs[sv].listwise_vars = listwise_vars;
5290               nest->specs[sv].n_listwise_vars = n;
5291             }
5292         }
5293     }
5294
5295   struct ctables_summary_spec_set *merged = &t->summary_specs;
5296   struct merge_item *items = xnmalloc (N_CSVS * stack->n, sizeof *items);
5297   size_t n_left = 0;
5298   for (size_t j = 0; j < stack->n; j++)
5299     {
5300       const struct ctables_nest *nest = &stack->nests[j];
5301       if (nest->n)
5302         for (enum ctables_summary_variant sv = 0; sv < N_CSVS; sv++)
5303           items[n_left++] = (struct merge_item) { .set = &nest->specs[sv] };
5304     }
5305
5306   while (n_left > 0)
5307     {
5308       struct merge_item min = items[0];
5309       for (size_t j = 1; j < n_left; j++)
5310         if (merge_item_compare_3way (&items[j], &min) < 0)
5311           min = items[j];
5312
5313       if (merged->n >= merged->allocated)
5314         merged->specs = x2nrealloc (merged->specs, &merged->allocated,
5315                                     sizeof *merged->specs);
5316       merged->specs[merged->n++] = min.set->specs[min.ofs];
5317
5318       for (size_t j = 0; j < n_left; )
5319         {
5320           if (merge_item_compare_3way (&items[j], &min) == 0)
5321             {
5322               struct merge_item *item = &items[j];
5323               item->set->specs[item->ofs++].axis_idx = merged->n - 1;
5324               if (item->ofs >= item->set->n)
5325                 {
5326                   items[j] = items[--n_left];
5327                   continue;
5328                 }
5329             }
5330           j++;
5331         }
5332     }
5333   free (items);
5334
5335   size_t allocated_sum_vars = 0;
5336   enumerate_sum_vars (t->axes[t->summary_axis],
5337                       &t->sum_vars, &t->n_sum_vars, &allocated_sum_vars);
5338
5339   return (ctables_check_label_position (t, lexer, PIVOT_AXIS_ROW)
5340           && ctables_check_label_position (t, lexer, PIVOT_AXIS_COLUMN));
5341 }
5342
5343 static void
5344 ctables_insert_clabels_values (struct ctables_table *t, const struct ccase *c,
5345                                enum pivot_axis_type a)
5346 {
5347   struct ctables_stack *stack = &t->stacks[a];
5348   for (size_t i = 0; i < stack->n; i++)
5349     {
5350       const struct ctables_nest *nest = &stack->nests[i];
5351       const struct variable *var = nest->vars[nest->n - 1];
5352       const union value *value = case_data (c, var);
5353
5354       if (var_is_numeric (var) && value->f == SYSMIS)
5355         continue;
5356
5357       if (ctables_categories_match (t->categories [var_get_dict_index (var)],
5358                                     value, var))
5359         ctables_value_insert (t, value, var_get_width (var));
5360     }
5361 }
5362
5363 static void
5364 ctables_add_category_occurrences (const struct variable *var,
5365                                   struct hmap *occurrences,
5366                                   const struct ctables_categories *cats)
5367 {
5368   const struct val_labs *val_labs = var_get_value_labels (var);
5369
5370   for (size_t i = 0; i < cats->n_cats; i++)
5371     {
5372       const struct ctables_category *c = &cats->cats[i];
5373       switch (c->type)
5374         {
5375         case CCT_NUMBER:
5376           ctables_add_occurrence (var, &(const union value) { .f = c->number },
5377                                   occurrences);
5378           break;
5379
5380         case CCT_STRING:
5381           {
5382             int width = var_get_width (var);
5383             union value value;
5384             value_init (&value, width);
5385             value_copy_buf_rpad (&value, width,
5386                                  CHAR_CAST (uint8_t *, c->string.string),
5387                                  c->string.length, ' ');
5388             ctables_add_occurrence (var, &value, occurrences);
5389             value_destroy (&value, width);
5390           }
5391           break;
5392
5393         case CCT_NRANGE:
5394           assert (var_is_numeric (var));
5395           for (const struct val_lab *vl = val_labs_first (val_labs); vl;
5396                vl = val_labs_next (val_labs, vl))
5397             if (vl->value.f >= c->nrange[0] && vl->value.f <= c->nrange[1])
5398               ctables_add_occurrence (var, &vl->value, occurrences);
5399           break;
5400
5401         case CCT_SRANGE:
5402           assert (var_is_alpha (var));
5403           for (const struct val_lab *vl = val_labs_first (val_labs); vl;
5404                vl = val_labs_next (val_labs, vl))
5405             if (in_string_range (&vl->value, var, c->srange))
5406               ctables_add_occurrence (var, &vl->value, occurrences);
5407           break;
5408
5409         case CCT_MISSING:
5410           for (const struct val_lab *vl = val_labs_first (val_labs); vl;
5411                vl = val_labs_next (val_labs, vl))
5412             if (var_is_value_missing (var, &vl->value))
5413               ctables_add_occurrence (var, &vl->value, occurrences);
5414           break;
5415
5416         case CCT_OTHERNM:
5417           for (const struct val_lab *vl = val_labs_first (val_labs); vl;
5418                vl = val_labs_next (val_labs, vl))
5419             ctables_add_occurrence (var, &vl->value, occurrences);
5420           break;
5421
5422         case CCT_POSTCOMPUTE:
5423           break;
5424
5425         case CCT_SUBTOTAL:
5426         case CCT_TOTAL:
5427           break;
5428
5429         case CCT_VALUE:
5430         case CCT_LABEL:
5431         case CCT_FUNCTION:
5432           for (const struct val_lab *vl = val_labs_first (val_labs); vl;
5433                vl = val_labs_next (val_labs, vl))
5434             if (c->include_missing || !var_is_value_missing (var, &vl->value))
5435               ctables_add_occurrence (var, &vl->value, occurrences);
5436           break;
5437
5438         case CCT_EXCLUDED_MISSING:
5439           break;
5440         }
5441     }
5442 }
5443
5444 static void
5445 ctables_section_recurse_add_empty_categories (
5446   struct ctables_section *s,
5447   const struct ctables_category **cats[PIVOT_N_AXES], struct ccase *c,
5448   enum pivot_axis_type a, size_t a_idx)
5449 {
5450   if (a >= PIVOT_N_AXES)
5451     ctables_cell_insert__ (s, c, cats);
5452   else if (!s->nests[a] || a_idx >= s->nests[a]->n)
5453     ctables_section_recurse_add_empty_categories (s, cats, c, a + 1, 0);
5454   else
5455     {
5456       const struct variable *var = s->nests[a]->vars[a_idx];
5457       const struct ctables_categories *categories = s->table->categories[
5458         var_get_dict_index (var)];
5459       int width = var_get_width (var);
5460       const struct hmap *occurrences = &s->occurrences[a][a_idx];
5461       const struct ctables_occurrence *o;
5462       HMAP_FOR_EACH (o, struct ctables_occurrence, node, occurrences)
5463         {
5464           union value *value = case_data_rw (c, var);
5465           value_destroy (value, width);
5466           value_clone (value, &o->value, width);
5467           cats[a][a_idx] = ctables_categories_match (categories, value, var);
5468           assert (cats[a][a_idx] != NULL);
5469           ctables_section_recurse_add_empty_categories (s, cats, c, a, a_idx + 1);
5470         }
5471
5472       for (size_t i = 0; i < categories->n_cats; i++)
5473         {
5474           const struct ctables_category *cat = &categories->cats[i];
5475           if (cat->type == CCT_POSTCOMPUTE)
5476             {
5477               cats[a][a_idx] = cat;
5478               ctables_section_recurse_add_empty_categories (s, cats, c, a, a_idx + 1);
5479             }
5480         }
5481     }
5482 }
5483
5484 static void
5485 ctables_section_add_empty_categories (struct ctables_section *s)
5486 {
5487   bool show_empty = false;
5488   for (size_t a = 0; a < PIVOT_N_AXES; a++)
5489     if (s->nests[a])
5490       for (size_t k = 0; k < s->nests[a]->n; k++)
5491         if (k != s->nests[a]->scale_idx)
5492           {
5493             const struct variable *var = s->nests[a]->vars[k];
5494             size_t idx = var_get_dict_index (var);
5495             const struct ctables_categories *cats = s->table->categories[idx];
5496             if (s->table->show_empty[idx])
5497               {
5498                 show_empty = true;
5499                 ctables_add_category_occurrences (var, &s->occurrences[a][k], cats);
5500               }
5501           }
5502   if (!show_empty)
5503     return;
5504
5505   const struct ctables_category *layer_cats[s->nests[PIVOT_AXIS_LAYER]->n];
5506   const struct ctables_category *row_cats[s->nests[PIVOT_AXIS_ROW]->n];
5507   const struct ctables_category *column_cats[s->nests[PIVOT_AXIS_COLUMN]->n];
5508   const struct ctables_category **cats[PIVOT_N_AXES] =
5509     {
5510       [PIVOT_AXIS_LAYER] = layer_cats,
5511       [PIVOT_AXIS_ROW] = row_cats,
5512       [PIVOT_AXIS_COLUMN] = column_cats,
5513     };
5514   struct ccase *c = case_create (dict_get_proto (s->table->ctables->dict));
5515   ctables_section_recurse_add_empty_categories (s, cats, c, 0, 0);
5516   case_unref (c);
5517 }
5518
5519 static void
5520 ctables_section_clear (struct ctables_section *s)
5521 {
5522   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
5523     {
5524       const struct ctables_nest *nest = s->nests[a];
5525       for (size_t i = 0; i < nest->n; i++)
5526         if (i != nest->scale_idx)
5527           {
5528             const struct variable *var = nest->vars[i];
5529             int width = var_get_width (var);
5530             struct ctables_occurrence *o, *next;
5531             struct hmap *map = &s->occurrences[a][i];
5532             HMAP_FOR_EACH_SAFE (o, next, struct ctables_occurrence, node, map)
5533               {
5534                 value_destroy (&o->value, width);
5535                 hmap_delete (map, &o->node);
5536                 free (o);
5537               }
5538             hmap_shrink (map);
5539           }
5540     }
5541
5542   struct ctables_cell *cell, *next_cell;
5543   HMAP_FOR_EACH_SAFE (cell, next_cell, struct ctables_cell, node, &s->cells)
5544     {
5545       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
5546         {
5547           const struct ctables_nest *nest = s->nests[a];
5548           for (size_t i = 0; i < nest->n; i++)
5549             if (i != nest->scale_idx)
5550               value_destroy (&cell->axes[a].cvs[i].value,
5551                              var_get_width (nest->vars[i]));
5552           free (cell->axes[a].cvs);
5553         }
5554
5555       const struct ctables_nest *ss = s->nests[s->table->summary_axis];
5556       const struct ctables_summary_spec_set *specs = &ss->specs[cell->sv];
5557       for (size_t i = 0; i < specs->n; i++)
5558         ctables_summary_uninit (&cell->summaries[i], &specs->specs[i]);
5559       free (cell->summaries);
5560
5561       hmap_delete (&s->cells, &cell->node);
5562       free (cell);
5563     }
5564   hmap_shrink (&s->cells);
5565
5566   for (enum ctables_area_type at = 0; at < N_CTATS; at++)
5567     {
5568       struct ctables_area *area, *next_area;
5569       HMAP_FOR_EACH_SAFE (area, next_area, struct ctables_area, node,
5570                           &s->areas[at])
5571         {
5572           free (area->sums);
5573           hmap_delete (&s->areas[at], &area->node);
5574           free (area);
5575         }
5576       hmap_shrink (&s->areas[at]);
5577     }
5578 }
5579
5580 static void
5581 ctables_section_uninit (struct ctables_section *s)
5582 {
5583   ctables_section_clear (s);
5584
5585   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
5586     {
5587       struct ctables_nest *nest = s->nests[a];
5588       for (size_t i = 0; i < nest->n; i++)
5589         hmap_destroy (&s->occurrences[a][i]);
5590       free (s->occurrences[a]);
5591     }
5592
5593   hmap_destroy (&s->cells);
5594   for (enum ctables_area_type at = 0; at < N_CTATS; at++)
5595     hmap_destroy (&s->areas[at]);
5596 }
5597
5598 static void
5599 ctables_table_clear (struct ctables_table *t)
5600 {
5601   for (size_t i = 0; i < t->n_sections; i++)
5602     ctables_section_clear (&t->sections[i]);
5603
5604   if (t->clabels_example)
5605     {
5606       int width = var_get_width (t->clabels_example);
5607       struct ctables_value *value, *next_value;
5608       HMAP_FOR_EACH_SAFE (value, next_value, struct ctables_value, node,
5609                           &t->clabels_values_map)
5610         {
5611           value_destroy (&value->value, width);
5612           hmap_delete (&t->clabels_values_map, &value->node);
5613           free (value);
5614         }
5615       hmap_shrink (&t->clabels_values_map);
5616
5617       free (t->clabels_values);
5618       t->clabels_values = NULL;
5619       t->n_clabels_values = 0;
5620     }
5621 }
5622
5623 static bool
5624 ctables_execute (struct dataset *ds, struct casereader *input,
5625                  struct ctables *ct)
5626 {
5627   for (size_t i = 0; i < ct->n_tables; i++)
5628     {
5629       struct ctables_table *t = ct->tables[i];
5630       t->sections = xnmalloc (MAX (1, t->stacks[PIVOT_AXIS_ROW].n) *
5631                               MAX (1, t->stacks[PIVOT_AXIS_COLUMN].n) *
5632                               MAX (1, t->stacks[PIVOT_AXIS_LAYER].n),
5633                               sizeof *t->sections);
5634       size_t ix[PIVOT_N_AXES];
5635       ctables_table_add_section (t, 0, ix);
5636     }
5637
5638   struct dictionary *dict = dataset_dict (ds);
5639
5640   bool splitting = dict_get_split_type (dict) == SPLIT_SEPARATE;
5641   struct casegrouper *grouper
5642     = (splitting
5643        ? casegrouper_create_splits (input, dict)
5644        : casegrouper_create_vars (input, NULL, 0));
5645   struct casereader *group;
5646   while (casegrouper_get_next_group (grouper, &group))
5647     {
5648       if (splitting)
5649         output_split_file_values_peek (ds, group);
5650
5651       bool warn_on_invalid = true;
5652       for (struct ccase *c = casereader_read (group); c;
5653            case_unref (c), c = casereader_read (group))
5654         {
5655           double d_weight = dict_get_rounded_case_weight (dict, c, &warn_on_invalid);
5656           double e_weight = (ct->e_weight
5657                              ? var_force_valid_weight (ct->e_weight,
5658                                                        case_num (c, ct->e_weight),
5659                                                        &warn_on_invalid)
5660                              : d_weight);
5661           double weight[] = {
5662             [CTW_DICTIONARY] = d_weight,
5663             [CTW_EFFECTIVE] = e_weight,
5664             [CTW_UNWEIGHTED] = 1.0,
5665           };
5666
5667           for (size_t i = 0; i < ct->n_tables; i++)
5668             {
5669               struct ctables_table *t = ct->tables[i];
5670
5671               for (size_t j = 0; j < t->n_sections; j++)
5672                 ctables_cell_insert (&t->sections[j], c, weight);
5673
5674               for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
5675                 if (t->label_axis[a] != a)
5676                   ctables_insert_clabels_values (t, c, a);
5677             }
5678         }
5679       casereader_destroy (group);
5680
5681       for (size_t i = 0; i < ct->n_tables; i++)
5682         {
5683           struct ctables_table *t = ct->tables[i];
5684
5685           if (t->clabels_example)
5686             ctables_sort_clabels_values (t);
5687
5688           for (size_t j = 0; j < t->n_sections; j++)
5689             ctables_section_add_empty_categories (&t->sections[j]);
5690
5691           ctables_table_output (ct, t);
5692           ctables_table_clear (t);
5693         }
5694     }
5695   return casegrouper_destroy (grouper);
5696 }
5697 \f
5698 static struct ctables_postcompute *
5699 ctables_find_postcompute (struct ctables *ct, const char *name)
5700 {
5701   struct ctables_postcompute *pc;
5702   HMAP_FOR_EACH_WITH_HASH (pc, struct ctables_postcompute, hmap_node,
5703                            utf8_hash_case_string (name, 0), &ct->postcomputes)
5704     if (!utf8_strcasecmp (pc->name, name))
5705       return pc;
5706   return NULL;
5707 }
5708
5709 static bool
5710 ctables_parse_pcompute (struct lexer *lexer, struct dictionary *dict,
5711                         struct ctables *ct)
5712 {
5713   int pcompute_start = lex_ofs (lexer) - 1;
5714
5715   if (!lex_match (lexer, T_AND))
5716     {
5717       lex_error_expecting (lexer, "&");
5718       return false;
5719     }
5720   if (!lex_force_id (lexer))
5721     return false;
5722
5723   char *name = ss_xstrdup (lex_tokss (lexer));
5724
5725   lex_get (lexer);
5726   if (!lex_force_match_phrase (lexer, "=EXPR("))
5727     {
5728       free (name);
5729       return false;
5730     }
5731
5732   int expr_start = lex_ofs (lexer);
5733   struct ctables_pcexpr *expr = ctables_pcexpr_parse_add (lexer, dict);
5734   int expr_end = lex_ofs (lexer) - 1;
5735   if (!expr || !lex_force_match (lexer, T_RPAREN))
5736     {
5737       ctables_pcexpr_destroy (expr);
5738       free (name);
5739       return false;
5740     }
5741   int pcompute_end = lex_ofs (lexer) - 1;
5742
5743   struct msg_location *location = lex_ofs_location (lexer, pcompute_start,
5744                                                     pcompute_end);
5745
5746   struct ctables_postcompute *pc = ctables_find_postcompute (ct, name);
5747   if (pc)
5748     {
5749       msg_at (SW, location, _("New definition of &%s will override the "
5750                               "previous definition."),
5751               pc->name);
5752       msg_at (SN, pc->location, _("This is the previous definition."));
5753
5754       ctables_pcexpr_destroy (pc->expr);
5755       msg_location_destroy (pc->location);
5756       free (name);
5757     }
5758   else
5759     {
5760       pc = xmalloc (sizeof *pc);
5761       *pc = (struct ctables_postcompute) { .name = name };
5762       hmap_insert (&ct->postcomputes, &pc->hmap_node,
5763                    utf8_hash_case_string (pc->name, 0));
5764     }
5765   pc->expr = expr;
5766   pc->location = location;
5767   if (!pc->label)
5768     pc->label = lex_ofs_representation (lexer, expr_start, expr_end);
5769   return true;
5770 }
5771
5772 static bool
5773 ctables_parse_pproperties_format (struct lexer *lexer,
5774                                   struct ctables_summary_spec_set *sss)
5775 {
5776   *sss = (struct ctables_summary_spec_set) { .n = 0 };
5777
5778   while (lex_token (lexer) != T_ENDCMD && lex_token (lexer) != T_SLASH
5779          && !(lex_token (lexer) == T_ID
5780               && (lex_id_match (ss_cstr ("LABEL"), lex_tokss (lexer))
5781                   || lex_id_match (ss_cstr ("HIDESOURCECATS"),
5782                                    lex_tokss (lexer)))))
5783     {
5784       /* Parse function. */
5785       enum ctables_summary_function function;
5786       enum ctables_weighting weighting;
5787       enum ctables_area_type area;
5788       if (!parse_ctables_summary_function (lexer, &function, &weighting, &area))
5789         goto error;
5790
5791       /* Parse percentile. */
5792       double percentile = 0;
5793       if (function == CTSF_PTILE)
5794         {
5795           if (!lex_force_num_range_closed (lexer, "PTILE", 0, 100))
5796             goto error;
5797           percentile = lex_number (lexer);
5798           lex_get (lexer);
5799         }
5800
5801       /* Parse format. */
5802       struct fmt_spec format;
5803       bool is_ctables_format;
5804       if (!parse_ctables_format_specifier (lexer, &format, &is_ctables_format))
5805         goto error;
5806
5807       if (sss->n >= sss->allocated)
5808         sss->specs = x2nrealloc (sss->specs, &sss->allocated,
5809                                  sizeof *sss->specs);
5810       sss->specs[sss->n++] = (struct ctables_summary_spec) {
5811         .function = function,
5812         .weighting = weighting,
5813         .calc_area = area,
5814         .user_area = area,
5815         .percentile = percentile,
5816         .format = format,
5817         .is_ctables_format = is_ctables_format,
5818       };
5819     }
5820   return true;
5821
5822 error:
5823   ctables_summary_spec_set_uninit (sss);
5824   return false;
5825 }
5826
5827 static bool
5828 ctables_parse_pproperties (struct lexer *lexer, struct ctables *ct)
5829 {
5830   struct ctables_postcompute **pcs = NULL;
5831   size_t n_pcs = 0;
5832   size_t allocated_pcs = 0;
5833
5834   while (lex_match (lexer, T_AND))
5835     {
5836       if (!lex_force_id (lexer))
5837         goto error;
5838       struct ctables_postcompute *pc
5839         = ctables_find_postcompute (ct, lex_tokcstr (lexer));
5840       if (!pc)
5841         {
5842           lex_error (lexer, _("Unknown computed category &%s."),
5843                      lex_tokcstr (lexer));
5844           goto error;
5845         }
5846       lex_get (lexer);
5847
5848       if (n_pcs >= allocated_pcs)
5849         pcs = x2nrealloc (pcs, &allocated_pcs, sizeof *pcs);
5850       pcs[n_pcs++] = pc;
5851     }
5852
5853   while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)
5854     {
5855       if (lex_match_id (lexer, "LABEL"))
5856         {
5857           lex_match (lexer, T_EQUALS);
5858           if (!lex_force_string (lexer))
5859             goto error;
5860
5861           for (size_t i = 0; i < n_pcs; i++)
5862             {
5863               free (pcs[i]->label);
5864               pcs[i]->label = ss_xstrdup (lex_tokss (lexer));
5865             }
5866
5867           lex_get (lexer);
5868         }
5869       else if (lex_match_id (lexer, "FORMAT"))
5870         {
5871           lex_match (lexer, T_EQUALS);
5872
5873           struct ctables_summary_spec_set sss;
5874           if (!ctables_parse_pproperties_format (lexer, &sss))
5875             goto error;
5876
5877           for (size_t i = 0; i < n_pcs; i++)
5878             {
5879               if (pcs[i]->specs)
5880                 ctables_summary_spec_set_uninit (pcs[i]->specs);
5881               else
5882                 pcs[i]->specs = xmalloc (sizeof *pcs[i]->specs);
5883               ctables_summary_spec_set_clone (pcs[i]->specs, &sss);
5884             }
5885           ctables_summary_spec_set_uninit (&sss);
5886         }
5887       else if (lex_match_id (lexer, "HIDESOURCECATS"))
5888         {
5889           lex_match (lexer, T_EQUALS);
5890           bool hide_source_cats;
5891           if (!parse_bool (lexer, &hide_source_cats))
5892             goto error;
5893           for (size_t i = 0; i < n_pcs; i++)
5894             pcs[i]->hide_source_cats = hide_source_cats;
5895         }
5896       else
5897         {
5898           lex_error_expecting (lexer, "LABEL", "FORMAT", "HIDESOURCECATS");
5899           goto error;
5900         }
5901     }
5902   free (pcs);
5903   return true;
5904
5905 error:
5906   free (pcs);
5907   return false;
5908 }
5909
5910 static void
5911 put_strftime (struct string *out, time_t now, const char *format)
5912 {
5913   const struct tm *tm = localtime (&now);
5914   char value[128];
5915   strftime (value, sizeof value, format, tm);
5916   ds_put_cstr (out, value);
5917 }
5918
5919 static bool
5920 skip_prefix (struct substring *s, struct substring prefix)
5921 {
5922   if (ss_starts_with (*s, prefix))
5923     {
5924       ss_advance (s, prefix.length);
5925       return true;
5926     }
5927   else
5928     return false;
5929 }
5930
5931 static void
5932 put_table_expression (struct string *out, struct lexer *lexer,
5933                       struct dictionary *dict, int expr_start, int expr_end)
5934 {
5935   size_t nest = 0;
5936   for (int ofs = expr_start; ofs < expr_end; ofs++)
5937     {
5938       const struct token *t = lex_ofs_token (lexer, ofs);
5939       if (t->type == T_LBRACK)
5940         nest++;
5941       else if (t->type == T_RBRACK && nest > 0)
5942         nest--;
5943       else if (nest > 0)
5944         {
5945           /* Nothing. */
5946         }
5947       else if (t->type == T_ID)
5948         {
5949           const struct variable *var
5950             = dict_lookup_var (dict, t->string.string);
5951           const char *label = var ? var_get_label (var) : NULL;
5952           ds_put_cstr (out, label ? label : t->string.string);
5953         }
5954       else
5955         {
5956           if (ofs != expr_start && t->type != T_RPAREN && ds_last (out) != ' ')
5957             ds_put_byte (out, ' ');
5958
5959           char *repr = lex_ofs_representation (lexer, ofs, ofs);
5960           ds_put_cstr (out, repr);
5961           free (repr);
5962
5963           if (ofs + 1 != expr_end && t->type != T_LPAREN)
5964             ds_put_byte (out, ' ');
5965         }
5966     }
5967 }
5968
5969 static void
5970 put_title_text (struct string *out, struct substring in, time_t now,
5971                 struct lexer *lexer, struct dictionary *dict,
5972                 int expr_start, int expr_end)
5973 {
5974   for (;;)
5975     {
5976       size_t chunk = ss_find_byte (in, ')');
5977       ds_put_substring (out, ss_head (in, chunk));
5978       ss_advance (&in, chunk);
5979       if (ss_is_empty (in))
5980         return;
5981
5982       if (skip_prefix (&in, ss_cstr (")DATE")))
5983         put_strftime (out, now, "%x");
5984       else if (skip_prefix (&in, ss_cstr (")TIME")))
5985         put_strftime (out, now, "%X");
5986       else if (skip_prefix (&in, ss_cstr (")TABLE")))
5987         put_table_expression (out, lexer, dict, expr_start, expr_end);
5988       else
5989         {
5990           ds_put_byte (out, ')');
5991           ss_advance (&in, 1);
5992         }
5993     }
5994 }
5995
5996 int
5997 cmd_ctables (struct lexer *lexer, struct dataset *ds)
5998 {
5999   struct casereader *input = NULL;
6000
6001   struct measure_guesser *mg = measure_guesser_create (ds);
6002   if (mg)
6003     {
6004       input = proc_open (ds);
6005       measure_guesser_run (mg, input);
6006       measure_guesser_destroy (mg);
6007     }
6008
6009   size_t n_vars = dict_get_n_vars (dataset_dict (ds));
6010   enum ctables_vlabel *vlabels = xnmalloc (n_vars, sizeof *vlabels);
6011   enum settings_value_show tvars = settings_get_show_variables ();
6012   for (size_t i = 0; i < n_vars; i++)
6013     vlabels[i] = (enum ctables_vlabel) tvars;
6014
6015   struct pivot_table_look *look = pivot_table_look_unshare (
6016     pivot_table_look_ref (pivot_table_look_get_default ()));
6017   look->omit_empty = false;
6018
6019   struct ctables *ct = xmalloc (sizeof *ct);
6020   *ct = (struct ctables) {
6021     .dict = dataset_dict (ds),
6022     .look = look,
6023     .ctables_formats = FMT_SETTINGS_INIT,
6024     .vlabels = vlabels,
6025     .postcomputes = HMAP_INITIALIZER (ct->postcomputes),
6026   };
6027
6028   time_t now = time (NULL);
6029
6030   struct ctf
6031     {
6032       enum fmt_type type;
6033       const char *dot_string;
6034       const char *comma_string;
6035     };
6036   static const struct ctf ctfs[4] = {
6037     { CTEF_NEGPAREN, "(,,,)",   "(...)" },
6038     { CTEF_NEQUAL,   "-,N=,,",  "-.N=.." },
6039     { CTEF_PAREN,    "-,(,),",  "-.(.)." },
6040     { CTEF_PCTPAREN, "-,(,%),", "-.(.%)." },
6041   };
6042   bool is_dot = settings_get_fmt_settings ()->decimal == '.';
6043   for (size_t i = 0; i < 4; i++)
6044     {
6045       const char *s = is_dot ? ctfs[i].dot_string : ctfs[i].comma_string;
6046       fmt_settings_set_cc (&ct->ctables_formats, ctfs[i].type,
6047                            fmt_number_style_from_string (s));
6048     }
6049
6050   if (!lex_force_match (lexer, T_SLASH))
6051     goto error;
6052
6053   while (!lex_match_id (lexer, "TABLE"))
6054     {
6055       if (lex_match_id (lexer, "FORMAT"))
6056         {
6057           double widths[2] = { SYSMIS, SYSMIS };
6058           double units_per_inch = 72.0;
6059
6060           int start_ofs = lex_ofs (lexer);
6061           while (lex_token (lexer) != T_SLASH)
6062             {
6063               if (lex_match_id (lexer, "MINCOLWIDTH"))
6064                 {
6065                   if (!parse_col_width (lexer, "MINCOLWIDTH", &widths[0]))
6066                     goto error;
6067                 }
6068               else if (lex_match_id (lexer, "MAXCOLWIDTH"))
6069                 {
6070                   if (!parse_col_width (lexer, "MAXCOLWIDTH", &widths[1]))
6071                     goto error;
6072                 }
6073               else if (lex_match_id (lexer, "UNITS"))
6074                 {
6075                   lex_match (lexer, T_EQUALS);
6076                   if (lex_match_id (lexer, "POINTS"))
6077                     units_per_inch = 72.0;
6078                   else if (lex_match_id (lexer, "INCHES"))
6079                     units_per_inch = 1.0;
6080                   else if (lex_match_id (lexer, "CM"))
6081                     units_per_inch = 2.54;
6082                   else
6083                     {
6084                       lex_error_expecting (lexer, "POINTS", "INCHES", "CM");
6085                       goto error;
6086                     }
6087                 }
6088               else if (lex_match_id (lexer, "EMPTY"))
6089                 {
6090                   free (ct->zero);
6091                   ct->zero = NULL;
6092
6093                   lex_match (lexer, T_EQUALS);
6094                   if (lex_match_id (lexer, "ZERO"))
6095                     {
6096                       /* Nothing to do. */
6097                     }
6098                   else if (lex_match_id (lexer, "BLANK"))
6099                     ct->zero = xstrdup ("");
6100                   else if (lex_force_string (lexer))
6101                     {
6102                       ct->zero = ss_xstrdup (lex_tokss (lexer));
6103                       lex_get (lexer);
6104                     }
6105                   else
6106                     goto error;
6107                 }
6108               else if (lex_match_id (lexer, "MISSING"))
6109                 {
6110                   lex_match (lexer, T_EQUALS);
6111                   if (!lex_force_string (lexer))
6112                     goto error;
6113
6114                   free (ct->missing);
6115                   ct->missing = (strcmp (lex_tokcstr (lexer), ".")
6116                                  ? ss_xstrdup (lex_tokss (lexer))
6117                                  : NULL);
6118                   lex_get (lexer);
6119                 }
6120               else
6121                 {
6122                   lex_error_expecting (lexer, "MINCOLWIDTH", "MAXCOLWIDTH",
6123                                        "UNITS", "EMPTY", "MISSING");
6124                   goto error;
6125                 }
6126             }
6127
6128           if (widths[0] != SYSMIS && widths[1] != SYSMIS
6129               && widths[0] > widths[1])
6130             {
6131               lex_ofs_error (lexer, start_ofs, lex_ofs (lexer) - 1,
6132                              _("MINCOLWIDTH must not be greater than "
6133                                "MAXCOLWIDTH."));
6134               goto error;
6135             }
6136
6137           for (size_t i = 0; i < 2; i++)
6138             if (widths[i] != SYSMIS)
6139               {
6140                 int *wr = ct->look->width_ranges[TABLE_HORZ];
6141                 wr[i] = widths[i] / units_per_inch * 96.0;
6142                 if (wr[0] > wr[1])
6143                   wr[!i] = wr[i];
6144               }
6145         }
6146       else if (lex_match_id (lexer, "VLABELS"))
6147         {
6148           if (!lex_force_match_id (lexer, "VARIABLES"))
6149             goto error;
6150           lex_match (lexer, T_EQUALS);
6151
6152           struct variable **vars;
6153           size_t n_vars;
6154           if (!parse_variables (lexer, dataset_dict (ds), &vars, &n_vars,
6155                                 PV_NO_SCRATCH))
6156             goto error;
6157
6158           if (!lex_force_match_id (lexer, "DISPLAY"))
6159             {
6160               free (vars);
6161               goto error;
6162             }
6163           lex_match (lexer, T_EQUALS);
6164
6165           enum ctables_vlabel vlabel;
6166           if (lex_match_id (lexer, "DEFAULT"))
6167             vlabel = (enum ctables_vlabel) settings_get_show_variables ();
6168           else if (lex_match_id (lexer, "NAME"))
6169             vlabel = CTVL_NAME;
6170           else if (lex_match_id (lexer, "LABEL"))
6171             vlabel = CTVL_LABEL;
6172           else if (lex_match_id (lexer, "BOTH"))
6173             vlabel = CTVL_BOTH;
6174           else if (lex_match_id (lexer, "NONE"))
6175             vlabel = CTVL_NONE;
6176           else
6177             {
6178               lex_error_expecting (lexer, "DEFAULT", "NAME", "LABEL",
6179                                    "BOTH", "NONE");
6180               free (vars);
6181               goto error;
6182             }
6183
6184           for (size_t i = 0; i < n_vars; i++)
6185             ct->vlabels[var_get_dict_index (vars[i])] = vlabel;
6186           free (vars);
6187         }
6188       else if (lex_match_id (lexer, "MRSETS"))
6189         {
6190           if (!lex_force_match_id (lexer, "COUNTDUPLICATES"))
6191             goto error;
6192           lex_match (lexer, T_EQUALS);
6193           if (!parse_bool (lexer, &ct->mrsets_count_duplicates))
6194             goto error;
6195         }
6196       else if (lex_match_id (lexer, "SMISSING"))
6197         {
6198           if (lex_match_id (lexer, "VARIABLE"))
6199             ct->smissing_listwise = false;
6200           else if (lex_match_id (lexer, "LISTWISE"))
6201             ct->smissing_listwise = true;
6202           else
6203             {
6204               lex_error_expecting (lexer, "VARIABLE", "LISTWISE");
6205               goto error;
6206             }
6207         }
6208       else if (lex_match_id (lexer, "PCOMPUTE"))
6209         {
6210           if (!ctables_parse_pcompute (lexer, dataset_dict (ds), ct))
6211             goto error;
6212         }
6213       else if (lex_match_id (lexer, "PPROPERTIES"))
6214         {
6215           if (!ctables_parse_pproperties (lexer, ct))
6216             goto error;
6217         }
6218       else if (lex_match_id (lexer, "WEIGHT"))
6219         {
6220           if (!lex_force_match_id (lexer, "VARIABLE"))
6221             goto error;
6222           lex_match (lexer, T_EQUALS);
6223           ct->e_weight = parse_variable (lexer, dataset_dict (ds));
6224           if (!ct->e_weight)
6225             goto error;
6226         }
6227       else if (lex_match_id (lexer, "HIDESMALLCOUNTS"))
6228         {
6229           if (lex_match_id (lexer, "COUNT"))
6230             {
6231               lex_match (lexer, T_EQUALS);
6232               if (!lex_force_int_range (lexer, "HIDESMALLCOUNTS COUNT",
6233                                         2, INT_MAX))
6234                 goto error;
6235               ct->hide_threshold = lex_integer (lexer);
6236               lex_get (lexer);
6237             }
6238           else if (ct->hide_threshold == 0)
6239             ct->hide_threshold = 5;
6240         }
6241       else
6242         {
6243           lex_error_expecting (lexer, "FORMAT", "VLABELS", "MRSETS",
6244                                "SMISSING", "PCOMPUTE", "PPROPERTIES",
6245                                "WEIGHT", "HIDESMALLCOUNTS", "TABLE");
6246           if (lex_match_id (lexer, "SLABELS")
6247               || lex_match_id (lexer, "CLABELS")
6248               || lex_match_id (lexer, "CRITERIA")
6249               || lex_match_id (lexer, "CATEGORIES")
6250               || lex_match_id (lexer, "TITLES")
6251               || lex_match_id (lexer, "SIGTEST")
6252               || lex_match_id (lexer, "COMPARETEST"))
6253             lex_next_msg (lexer, SN, -1, -1,
6254                           _("TABLE must appear before this subcommand."));
6255           goto error;
6256         }
6257
6258       if (!lex_force_match (lexer, T_SLASH))
6259         goto error;
6260     }
6261
6262   size_t allocated_tables = 0;
6263   do
6264     {
6265       if (ct->n_tables >= allocated_tables)
6266         ct->tables = x2nrealloc (ct->tables, &allocated_tables,
6267                                  sizeof *ct->tables);
6268
6269       struct ctables_category *cat = xmalloc (sizeof *cat);
6270       *cat = (struct ctables_category) {
6271         .type = CCT_VALUE,
6272         .include_missing = false,
6273         .sort_ascending = true,
6274       };
6275
6276       struct ctables_categories *c = xmalloc (sizeof *c);
6277       size_t n_vars = dict_get_n_vars (dataset_dict (ds));
6278       *c = (struct ctables_categories) {
6279         .n_refs = n_vars,
6280         .cats = cat,
6281         .n_cats = 1,
6282       };
6283
6284       struct ctables_categories **categories = xnmalloc (n_vars,
6285                                                          sizeof *categories);
6286       for (size_t i = 0; i < n_vars; i++)
6287         categories[i] = c;
6288
6289       bool *show_empty = xmalloc (n_vars);
6290       memset (show_empty, true, n_vars);
6291
6292       struct ctables_table *t = xmalloc (sizeof *t);
6293       *t = (struct ctables_table) {
6294         .ctables = ct,
6295         .slabels_axis = PIVOT_AXIS_COLUMN,
6296         .slabels_visible = true,
6297         .clabels_values_map = HMAP_INITIALIZER (t->clabels_values_map),
6298         .label_axis = {
6299           [PIVOT_AXIS_ROW] = PIVOT_AXIS_ROW,
6300           [PIVOT_AXIS_COLUMN] = PIVOT_AXIS_COLUMN,
6301           [PIVOT_AXIS_LAYER] = PIVOT_AXIS_LAYER,
6302         },
6303         .clabels_from_axis = PIVOT_AXIS_LAYER,
6304         .clabels_to_axis = PIVOT_AXIS_LAYER,
6305         .categories = categories,
6306         .n_categories = n_vars,
6307         .show_empty = show_empty,
6308         .cilevel = 95,
6309       };
6310       ct->tables[ct->n_tables++] = t;
6311
6312       lex_match (lexer, T_EQUALS);
6313       int expr_start = lex_ofs (lexer);
6314       if (!ctables_axis_parse (lexer, dataset_dict (ds),
6315                                &t->axes[PIVOT_AXIS_ROW]))
6316         goto error;
6317       if (lex_match (lexer, T_BY))
6318         {
6319           if (!ctables_axis_parse (lexer, dataset_dict (ds),
6320                                    &t->axes[PIVOT_AXIS_COLUMN]))
6321             goto error;
6322
6323           if (lex_match (lexer, T_BY))
6324             {
6325               if (!ctables_axis_parse (lexer, dataset_dict (ds),
6326                                        &t->axes[PIVOT_AXIS_LAYER]))
6327                 goto error;
6328             }
6329         }
6330       int expr_end = lex_ofs (lexer);
6331
6332       if (!t->axes[PIVOT_AXIS_ROW] && !t->axes[PIVOT_AXIS_COLUMN]
6333           && !t->axes[PIVOT_AXIS_LAYER])
6334         {
6335           lex_error (lexer, _("At least one variable must be specified."));
6336           goto error;
6337         }
6338
6339       const struct ctables_axis *scales[PIVOT_N_AXES];
6340       size_t n_scales = 0;
6341       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
6342         {
6343           scales[a] = find_scale (t->axes[a]);
6344           if (scales[a])
6345             n_scales++;
6346         }
6347       if (n_scales > 1)
6348         {
6349           msg (SE, _("Scale variables may appear only on one axis."));
6350           if (scales[PIVOT_AXIS_ROW])
6351             msg_at (SN, scales[PIVOT_AXIS_ROW]->loc,
6352                     _("This scale variable appears on the rows axis."));
6353           if (scales[PIVOT_AXIS_COLUMN])
6354             msg_at (SN, scales[PIVOT_AXIS_COLUMN]->loc,
6355                     _("This scale variable appears on the columns axis."));
6356           if (scales[PIVOT_AXIS_LAYER])
6357             msg_at (SN, scales[PIVOT_AXIS_LAYER]->loc,
6358                     _("This scale variable appears on the layer axis."));
6359           goto error;
6360         }
6361
6362       const struct ctables_axis *summaries[PIVOT_N_AXES];
6363       size_t n_summaries = 0;
6364       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
6365         {
6366           summaries[a] = (scales[a]
6367                           ? scales[a]
6368                           : find_categorical_summary_spec (t->axes[a]));
6369           if (summaries[a])
6370             n_summaries++;
6371         }
6372       if (n_summaries > 1)
6373         {
6374           msg (SE, _("Summaries may appear only on one axis."));
6375           for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
6376             if (summaries[a])
6377               {
6378                 msg_at (SN, summaries[a]->loc,
6379                         a == PIVOT_AXIS_ROW
6380                         ? _("This variable on the rows axis has a summary.")
6381                         : a == PIVOT_AXIS_COLUMN
6382                         ? _("This variable on the columns axis has a summary.")
6383                         : _("This variable on the layers axis has a summary."));
6384                 if (scales[a])
6385                   msg_at (SN, summaries[a]->loc,
6386                           _("This is a scale variable, so it always has a "
6387                             "summary even if the syntax does not explicitly "
6388                             "specify one."));
6389               }
6390           goto error;
6391         }
6392       for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
6393         if (n_summaries ? summaries[a] : t->axes[a])
6394           {
6395             t->summary_axis = a;
6396             break;
6397           }
6398
6399       if (lex_token (lexer) == T_ENDCMD)
6400         {
6401           if (!ctables_prepare_table (t, lexer))
6402             goto error;
6403           break;
6404         }
6405       if (!lex_force_match (lexer, T_SLASH))
6406         goto error;
6407
6408       while (!lex_match_id (lexer, "TABLE") && lex_token (lexer) != T_ENDCMD)
6409         {
6410           if (lex_match_id (lexer, "SLABELS"))
6411             {
6412               while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)
6413                 {
6414                   if (lex_match_id (lexer, "POSITION"))
6415                     {
6416                       lex_match (lexer, T_EQUALS);
6417                       if (lex_match_id (lexer, "COLUMN"))
6418                         t->slabels_axis = PIVOT_AXIS_COLUMN;
6419                       else if (lex_match_id (lexer, "ROW"))
6420                         t->slabels_axis = PIVOT_AXIS_ROW;
6421                       else if (lex_match_id (lexer, "LAYER"))
6422                         t->slabels_axis = PIVOT_AXIS_LAYER;
6423                       else
6424                         {
6425                           lex_error_expecting (lexer, "COLUMN", "ROW", "LAYER");
6426                           goto error;
6427                         }
6428                     }
6429                   else if (lex_match_id (lexer, "VISIBLE"))
6430                     {
6431                       lex_match (lexer, T_EQUALS);
6432                       if (!parse_bool (lexer, &t->slabels_visible))
6433                         goto error;
6434                     }
6435                   else
6436                     {
6437                       lex_error_expecting (lexer, "POSITION", "VISIBLE");
6438                       goto error;
6439                     }
6440                 }
6441             }
6442           else if (lex_match_id (lexer, "CLABELS"))
6443             {
6444               int start_ofs = lex_ofs (lexer) - 1;
6445               if (lex_match_id (lexer, "AUTO"))
6446                 {
6447                   t->label_axis[PIVOT_AXIS_ROW] = PIVOT_AXIS_ROW;
6448                   t->label_axis[PIVOT_AXIS_COLUMN] = PIVOT_AXIS_COLUMN;
6449                 }
6450               else if (lex_match_id (lexer, "ROWLABELS"))
6451                 {
6452                   lex_match (lexer, T_EQUALS);
6453                   if (lex_match_id (lexer, "OPPOSITE"))
6454                     t->label_axis[PIVOT_AXIS_ROW] = PIVOT_AXIS_COLUMN;
6455                   else if (lex_match_id (lexer, "LAYER"))
6456                     t->label_axis[PIVOT_AXIS_ROW] = PIVOT_AXIS_LAYER;
6457                   else
6458                     {
6459                       lex_error_expecting (lexer, "OPPOSITE", "LAYER");
6460                       goto error;
6461                     }
6462                 }
6463               else if (lex_match_id (lexer, "COLLABELS"))
6464                 {
6465                   lex_match (lexer, T_EQUALS);
6466                   if (lex_match_id (lexer, "OPPOSITE"))
6467                     t->label_axis[PIVOT_AXIS_COLUMN] = PIVOT_AXIS_ROW;
6468                   else if (lex_match_id (lexer, "LAYER"))
6469                     t->label_axis[PIVOT_AXIS_COLUMN] = PIVOT_AXIS_LAYER;
6470                   else
6471                     {
6472                       lex_error_expecting (lexer, "OPPOSITE", "LAYER");
6473                       goto error;
6474                     }
6475                 }
6476               else
6477                 {
6478                   lex_error_expecting (lexer, "AUTO", "ROWLABELS",
6479                                        "COLLABELS");
6480                   goto error;
6481                 }
6482               int end_ofs = lex_ofs (lexer) - 1;
6483
6484               if (t->label_axis[PIVOT_AXIS_ROW] != PIVOT_AXIS_ROW
6485                   && t->label_axis[PIVOT_AXIS_COLUMN] != PIVOT_AXIS_COLUMN)
6486                 {
6487                   msg (SE, _("ROWLABELS and COLLABELS may not both be "
6488                              "specified."));
6489
6490                   lex_ofs_msg (lexer, SN, t->clabels_start_ofs,
6491                                t->clabels_end_ofs,
6492                                _("This is the first specification."));
6493                   lex_ofs_msg (lexer, SN, start_ofs, end_ofs,
6494                                _("This is the second specification."));
6495                   goto error;
6496                 }
6497
6498               t->clabels_start_ofs = start_ofs;
6499               t->clabels_end_ofs = end_ofs;
6500             }
6501           else if (lex_match_id (lexer, "CRITERIA"))
6502             {
6503               if (!lex_force_match_id (lexer, "CILEVEL"))
6504                 goto error;
6505               lex_match (lexer, T_EQUALS);
6506
6507               if (!lex_force_num_range_halfopen (lexer, "CILEVEL", 0, 100))
6508                 goto error;
6509               t->cilevel = lex_number (lexer);
6510               lex_get (lexer);
6511             }
6512           else if (lex_match_id (lexer, "CATEGORIES"))
6513             {
6514               if (!ctables_table_parse_categories (lexer, dataset_dict (ds),
6515                                                    ct, t))
6516                 goto error;
6517             }
6518           else if (lex_match_id (lexer, "TITLES"))
6519             {
6520               do
6521                 {
6522                   char **textp;
6523                   if (lex_match_id (lexer, "CAPTIONS"))
6524                     textp = &t->caption;
6525                   else if (lex_match_id (lexer, "CORNERS"))
6526                     textp = &t->corner;
6527                   else if (lex_match_id (lexer, "TITLES"))
6528                     textp = &t->title;
6529                   else
6530                     {
6531                       lex_error_expecting (lexer, "CAPTION", "CORNER", "TITLE");
6532                       goto error;
6533                     }
6534                   lex_match (lexer, T_EQUALS);
6535
6536                   struct string s = DS_EMPTY_INITIALIZER;
6537                   while (lex_is_string (lexer))
6538                     {
6539                       if (!ds_is_empty (&s))
6540                         ds_put_byte (&s, '\n');
6541                       put_title_text (&s, lex_tokss (lexer), now,
6542                                       lexer, dataset_dict (ds),
6543                                       expr_start, expr_end);
6544                       lex_get (lexer);
6545                     }
6546                   free (*textp);
6547                   *textp = ds_steal_cstr (&s);
6548                 }
6549               while (lex_token (lexer) != T_SLASH
6550                      && lex_token (lexer) != T_ENDCMD);
6551             }
6552           else if (lex_match_id (lexer, "SIGTEST"))
6553             {
6554               int start_ofs = lex_ofs (lexer) - 1;
6555               if (!t->chisq)
6556                 {
6557                   t->chisq = xmalloc (sizeof *t->chisq);
6558                   *t->chisq = (struct ctables_chisq) {
6559                     .alpha = .05,
6560                     .include_mrsets = true,
6561                     .all_visible = true,
6562                   };
6563                 }
6564
6565               do
6566                 {
6567                   if (lex_match_id (lexer, "TYPE"))
6568                     {
6569                       lex_match (lexer, T_EQUALS);
6570                       if (!lex_force_match_id (lexer, "CHISQUARE"))
6571                         goto error;
6572                     }
6573                   else if (lex_match_id (lexer, "ALPHA"))
6574                     {
6575                       lex_match (lexer, T_EQUALS);
6576                       if (!lex_force_num_range_halfopen (lexer, "ALPHA", 0, 1))
6577                         goto error;
6578                       t->chisq->alpha = lex_number (lexer);
6579                       lex_get (lexer);
6580                     }
6581                   else if (lex_match_id (lexer, "INCLUDEMRSETS"))
6582                     {
6583                       lex_match (lexer, T_EQUALS);
6584                       if (!parse_bool (lexer, &t->chisq->include_mrsets))
6585                         goto error;
6586                     }
6587                   else if (lex_match_id (lexer, "CATEGORIES"))
6588                     {
6589                       lex_match (lexer, T_EQUALS);
6590                       if (lex_match_id (lexer, "ALLVISIBLE"))
6591                         t->chisq->all_visible = true;
6592                       else if (lex_match_id (lexer, "SUBTOTALS"))
6593                         t->chisq->all_visible = false;
6594                       else
6595                         {
6596                           lex_error_expecting (lexer,
6597                                                "ALLVISIBLE", "SUBTOTALS");
6598                           goto error;
6599                         }
6600                     }
6601                   else
6602                     {
6603                       lex_error_expecting (lexer, "TYPE", "ALPHA",
6604                                            "INCLUDEMRSETS", "CATEGORIES");
6605                       goto error;
6606                     }
6607                 }
6608               while (lex_token (lexer) != T_SLASH
6609                      && lex_token (lexer) != T_ENDCMD);
6610
6611               lex_ofs_error (lexer, start_ofs, lex_ofs (lexer) - 1,
6612                              _("Support for SIGTEST not yet implemented."));
6613               goto error;
6614             }
6615           else if (lex_match_id (lexer, "COMPARETEST"))
6616             {
6617               int start_ofs = lex_ofs (lexer) - 1;
6618               if (!t->pairwise)
6619                 {
6620                   t->pairwise = xmalloc (sizeof *t->pairwise);
6621                   *t->pairwise = (struct ctables_pairwise) {
6622                     .type = PROP,
6623                     .alpha = { .05, .05 },
6624                     .adjust = BONFERRONI,
6625                     .include_mrsets = true,
6626                     .meansvariance_allcats = true,
6627                     .all_visible = true,
6628                     .merge = false,
6629                     .apa_style = true,
6630                     .show_sig = false,
6631                   };
6632                 }
6633
6634               do
6635                 {
6636                   if (lex_match_id (lexer, "TYPE"))
6637                     {
6638                       lex_match (lexer, T_EQUALS);
6639                       if (lex_match_id (lexer, "PROP"))
6640                         t->pairwise->type = PROP;
6641                       else if (lex_match_id (lexer, "MEAN"))
6642                         t->pairwise->type = MEAN;
6643                       else
6644                         {
6645                           lex_error_expecting (lexer, "PROP", "MEAN");
6646                           goto error;
6647                         }
6648                     }
6649                   else if (lex_match_id (lexer, "ALPHA"))
6650                     {
6651                       lex_match (lexer, T_EQUALS);
6652
6653                       if (!lex_force_num_range_open (lexer, "ALPHA", 0, 1))
6654                         goto error;
6655                       double a0 = lex_number (lexer);
6656                       lex_get (lexer);
6657
6658                       lex_match (lexer, T_COMMA);
6659                       if (lex_is_number (lexer))
6660                         {
6661                           if (!lex_force_num_range_open (lexer, "ALPHA", 0, 1))
6662                             goto error;
6663                           double a1 = lex_number (lexer);
6664                           lex_get (lexer);
6665
6666                           t->pairwise->alpha[0] = MIN (a0, a1);
6667                           t->pairwise->alpha[1] = MAX (a0, a1);
6668                         }
6669                       else
6670                         t->pairwise->alpha[0] = t->pairwise->alpha[1] = a0;
6671                     }
6672                   else if (lex_match_id (lexer, "ADJUST"))
6673                     {
6674                       lex_match (lexer, T_EQUALS);
6675                       if (lex_match_id (lexer, "BONFERRONI"))
6676                         t->pairwise->adjust = BONFERRONI;
6677                       else if (lex_match_id (lexer, "BH"))
6678                         t->pairwise->adjust = BH;
6679                       else if (lex_match_id (lexer, "NONE"))
6680                         t->pairwise->adjust = 0;
6681                       else
6682                         {
6683                           lex_error_expecting (lexer, "BONFERRONI", "BH",
6684                                                "NONE");
6685                           goto error;
6686                         }
6687                     }
6688                   else if (lex_match_id (lexer, "INCLUDEMRSETS"))
6689                     {
6690                       lex_match (lexer, T_EQUALS);
6691                       if (!parse_bool (lexer, &t->pairwise->include_mrsets))
6692                         goto error;
6693                     }
6694                   else if (lex_match_id (lexer, "MEANSVARIANCE"))
6695                     {
6696                       lex_match (lexer, T_EQUALS);
6697                       if (lex_match_id (lexer, "ALLCATS"))
6698                         t->pairwise->meansvariance_allcats = true;
6699                       else if (lex_match_id (lexer, "TESTEDCATS"))
6700                         t->pairwise->meansvariance_allcats = false;
6701                       else
6702                         {
6703                           lex_error_expecting (lexer, "ALLCATS", "TESTEDCATS");
6704                           goto error;
6705                         }
6706                     }
6707                   else if (lex_match_id (lexer, "CATEGORIES"))
6708                     {
6709                       lex_match (lexer, T_EQUALS);
6710                       if (lex_match_id (lexer, "ALLVISIBLE"))
6711                         t->pairwise->all_visible = true;
6712                       else if (lex_match_id (lexer, "SUBTOTALS"))
6713                         t->pairwise->all_visible = false;
6714                       else
6715                         {
6716                           lex_error_expecting (lexer, "ALLVISIBLE",
6717                                                "SUBTOTALS");
6718                           goto error;
6719                         }
6720                     }
6721                   else if (lex_match_id (lexer, "MERGE"))
6722                     {
6723                       lex_match (lexer, T_EQUALS);
6724                       if (!parse_bool (lexer, &t->pairwise->merge))
6725                         goto error;
6726                     }
6727                   else if (lex_match_id (lexer, "STYLE"))
6728                     {
6729                       lex_match (lexer, T_EQUALS);
6730                       if (lex_match_id (lexer, "APA"))
6731                         t->pairwise->apa_style = true;
6732                       else if (lex_match_id (lexer, "SIMPLE"))
6733                         t->pairwise->apa_style = false;
6734                       else
6735                         {
6736                           lex_error_expecting (lexer, "APA", "SIMPLE");
6737                           goto error;
6738                         }
6739                     }
6740                   else if (lex_match_id (lexer, "SHOWSIG"))
6741                     {
6742                       lex_match (lexer, T_EQUALS);
6743                       if (!parse_bool (lexer, &t->pairwise->show_sig))
6744                         goto error;
6745                     }
6746                   else
6747                     {
6748                       lex_error_expecting (lexer, "TYPE", "ALPHA", "ADJUST",
6749                                            "INCLUDEMRSETS", "MEANSVARIANCE",
6750                                            "CATEGORIES", "MERGE", "STYLE",
6751                                            "SHOWSIG");
6752                       goto error;
6753                     }
6754                 }
6755               while (lex_token (lexer) != T_SLASH
6756                      && lex_token (lexer) != T_ENDCMD);
6757
6758               lex_ofs_error (lexer, start_ofs, lex_ofs (lexer) - 1,
6759                              _("Support for COMPARETEST not yet implemented."));
6760               goto error;
6761             }
6762           else
6763             {
6764               lex_error_expecting (lexer, "TABLE", "SLABELS", "CLABELS",
6765                                    "CRITERIA", "CATEGORIES", "TITLES",
6766                                    "SIGTEST", "COMPARETEST");
6767               if (lex_match_id (lexer, "FORMAT")
6768                   || lex_match_id (lexer, "VLABELS")
6769                   || lex_match_id (lexer, "MRSETS")
6770                   || lex_match_id (lexer, "SMISSING")
6771                   || lex_match_id (lexer, "PCOMPUTE")
6772                   || lex_match_id (lexer, "PPROPERTIES")
6773                   || lex_match_id (lexer, "WEIGHT")
6774                   || lex_match_id (lexer, "HIDESMALLCOUNTS"))
6775                 lex_next_msg (lexer, SN, -1, -1,
6776                               _("This subcommand must appear before TABLE."));
6777               goto error;
6778             }
6779
6780           if (!lex_match (lexer, T_SLASH))
6781             break;
6782         }
6783
6784       if (t->label_axis[PIVOT_AXIS_ROW] != PIVOT_AXIS_ROW)
6785         t->clabels_from_axis = PIVOT_AXIS_ROW;
6786       else if (t->label_axis[PIVOT_AXIS_COLUMN] != PIVOT_AXIS_COLUMN)
6787         t->clabels_from_axis = PIVOT_AXIS_COLUMN;
6788       t->clabels_to_axis = t->label_axis[t->clabels_from_axis];
6789
6790       if (!ctables_prepare_table (t, lexer))
6791         goto error;
6792     }
6793   while (lex_token (lexer) != T_ENDCMD);
6794
6795   if (!input)
6796     input = proc_open (ds);
6797   bool ok = ctables_execute (ds, input, ct);
6798   ok = proc_commit (ds) && ok;
6799
6800   ctables_destroy (ct);
6801   return ok ? CMD_SUCCESS : CMD_FAILURE;
6802
6803 error:
6804   if (input)
6805     proc_commit (ds);
6806   ctables_destroy (ct);
6807   return CMD_FAILURE;
6808 }
6809