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