ctables syntax diagram
[pspp] / src / language / stats / ctables.c
index 9b51538a4c877a872be66b56ea30313719e562bc..51493b0012a3c268310ea085c15fe150eb628d38 100644 (file)
@@ -17,6 +17,7 @@
 #include <config.h>
 
 #include <math.h>
+#include <errno.h>
 
 #include "data/casereader.h"
 #include "data/casewriter.h"
@@ -198,6 +199,7 @@ struct ctables_cell
     struct ctables_domain *domains[N_CTDTS];
 
     bool hide;
+    bool postcompute;
     enum ctables_summary_variant sv;
 
     struct ctables_cell_axis
@@ -356,7 +358,7 @@ struct ctables_value
     int leaf;
   };
 
-struct ctables_section_value
+struct ctables_occurrence
   {
     struct hmap_node node;
     union value value;
@@ -1533,7 +1535,7 @@ ctables_recursive_check_postcompute (const struct ctables_pcexpr *e,
             msg_at (SE, pc_cat->location,
                     _("Computed category &%s references a category not included "
                       "in the category list."),
-                    cat->pc->name);
+                    pc_cat->pc->name);
             msg_at (SN, e->location, _("This is the missing category."));
             msg_at (SN, cats_location,
                     _("To fix the problem, add the missing category to the "
@@ -2727,8 +2729,6 @@ static struct ctables_cell *
 ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
                        const struct ctables_category *cats[PIVOT_N_AXES][10])
 {
-  const struct ctables_nest *ss = s->nests[s->table->summary_axis];
-
   size_t hash = 0;
   enum ctables_summary_variant sv = CSV_CELL;
   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
@@ -2739,7 +2739,8 @@ ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
           {
             hash = hash_pointer (cats[a][i], hash);
             if (cats[a][i]->type != CCT_TOTAL
-                && cats[a][i]->type != CCT_SUBTOTAL)
+                && cats[a][i]->type != CCT_SUBTOTAL
+                && cats[a][i]->type != CCT_POSTCOMPUTE)
               hash = value_hash (case_data (c, nest->vars[i]),
                                  var_get_width (nest->vars[i]), hash);
             else
@@ -2758,6 +2759,7 @@ ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
                 && (cats[a][i] != cell->axes[a].cvs[i].category
                     || (cats[a][i]->type != CCT_TOTAL
                         && cats[a][i]->type != CCT_SUBTOTAL
+                        && cats[a][i]->type != CCT_POSTCOMPUTE
                         && !value_equal (case_data (c, nest->vars[i]),
                                          &cell->axes[a].cvs[i].value,
                                          var_get_width (nest->vars[i])))))
@@ -2773,6 +2775,7 @@ ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
   cell->hide = false;
   cell->sv = sv;
   cell->contributes_to_domains = true;
+  cell->postcompute = false;
   for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
     {
       const struct ctables_nest *nest = s->nests[a];
@@ -2788,8 +2791,12 @@ ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
               if (cat->hide || (subtotal && subtotal->hide_subcategories))
                 cell->hide = true;
 
-              if (cat->type == CCT_TOTAL || cat->type == CCT_SUBTOTAL)
+              if (cat->type == CCT_TOTAL
+                  || cat->type == CCT_SUBTOTAL
+                  || cat->type == CCT_POSTCOMPUTE)
                 cell->contributes_to_domains = false;
+              if (cat->type == CCT_POSTCOMPUTE)
+                cell->postcompute = true;
             }
 
           cell->axes[a].cvs[i].category = cat;
@@ -2798,6 +2805,7 @@ ctables_cell_insert__ (struct ctables_section *s, const struct ccase *c,
         }
     }
 
+  const struct ctables_nest *ss = s->nests[s->table->summary_axis];
   const struct ctables_summary_spec_set *specs = &ss->specs[cell->sv];
   cell->summaries = xmalloc (specs->n * sizeof *cell->summaries);
   for (size_t i = 0; i < specs->n; i++)
@@ -2896,15 +2904,15 @@ ctables_add_occurrence (const struct variable *var,
   int width = var_get_width (var);
   unsigned int hash = value_hash (value, width, 0);
 
-  struct ctables_section_value *sv;
-  HMAP_FOR_EACH_WITH_HASH (sv, struct ctables_section_value, node, hash,
+  struct ctables_occurrence *o;
+  HMAP_FOR_EACH_WITH_HASH (o, struct ctables_occurrence, node, hash,
                            occurrences)
-    if (value_equal (value, &sv->value, width))
+    if (value_equal (value, &o->value, width))
       return;
 
-  sv = xmalloc (sizeof *sv);
-  value_clone (&sv->value, value, width);
-  hmap_insert (occurrences, &sv->node, hash);
+  o = xmalloc (sizeof *o);
+  value_clone (&o->value, value, width);
+  hmap_insert (occurrences, &o->node, hash);
 }
 
 static void
@@ -2977,6 +2985,8 @@ ctables_category_create_label (const struct ctables_category *cat,
 {
   return (cat->type == CCT_TOTAL || cat->type == CCT_SUBTOTAL
           ? pivot_value_new_user_text (cat->total_label, SIZE_MAX)
+          : cat->type == CCT_POSTCOMPUTE && cat->pc->label
+          ? pivot_value_new_user_text (cat->pc->label, SIZE_MAX)
           : pivot_value_new_var_value (var, value));
 }
 
@@ -3031,6 +3041,241 @@ ctables_table_add_section (struct ctables_table *t, enum pivot_axis_type a,
     }
 }
 
+static double
+ctpo_add (double a, double b)
+{
+  return a + b;
+}
+
+static double
+ctpo_sub (double a, double b)
+{
+  return a - b;
+}
+
+static double
+ctpo_mul (double a, double b)
+{
+  return a * b;
+}
+
+static double
+ctpo_div (double a, double b)
+{
+  return b ? a / b : SYSMIS;
+}
+
+static double
+ctpo_pow (double a, double b)
+{
+  int save_errno = errno;
+  errno = 0;
+  double result = pow (a, b);
+  if (errno)
+    result = SYSMIS;
+  errno = save_errno;
+  return result;
+}
+
+static double
+ctpo_neg (double a, double b UNUSED)
+{
+  return -a;
+}
+
+struct ctables_pcexpr_evaluate_ctx
+  {
+    const struct ctables_cell *cell;
+    const struct ctables_section *section;
+    const struct ctables_categories *cats;
+    enum pivot_axis_type pc_a;
+    size_t pc_a_idx;
+  };
+
+static double ctables_pcexpr_evaluate (
+  const struct ctables_pcexpr_evaluate_ctx *, const struct ctables_pcexpr *);
+
+static double
+ctables_pcexpr_evaluate_nonterminal (
+  const struct ctables_pcexpr_evaluate_ctx *ctx,
+  const struct ctables_pcexpr *e, size_t n_args,
+  double evaluate (double, double))
+{
+  double args[2] = { 0, 0 };
+  for (size_t i = 0; i < n_args; i++)
+    {
+      args[i] = ctables_pcexpr_evaluate (ctx, e->subs[i]);
+      if (!isfinite (args[i]) || args[i] == SYSMIS)
+        return SYSMIS;
+    }
+  return evaluate (args[0], args[1]);
+}
+
+static double
+ctables_pcexpr_evaluate_category (const struct ctables_pcexpr_evaluate_ctx *ctx,
+                                  const struct ctables_cell_value *pc_cv)
+{
+  const struct ctables_section *s = ctx->section;
+
+  size_t hash = 0;
+  for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
+    {
+      const struct ctables_nest *nest = s->nests[a];
+      for (size_t i = 0; i < nest->n; i++)
+        if (i != nest->scale_idx)
+          {
+            const struct ctables_cell_value *cv
+              = (a == ctx->pc_a && i == ctx->pc_a_idx ? pc_cv
+                 : &ctx->cell->axes[a].cvs[i]);
+            hash = hash_pointer (cv->category, hash);
+            if (cv->category->type != CCT_TOTAL
+                && cv->category->type != CCT_SUBTOTAL
+                && cv->category->type != CCT_POSTCOMPUTE)
+              hash = value_hash (&cv->value,
+                                 var_get_width (nest->vars[i]), hash);
+          }
+    }
+
+  struct ctables_cell *tc;
+  HMAP_FOR_EACH_WITH_HASH (tc, struct ctables_cell, node, hash, &s->cells)
+    {
+      for (enum pivot_axis_type a = 0; a < PIVOT_N_AXES; a++)
+        {
+          const struct ctables_nest *nest = s->nests[a];
+          for (size_t i = 0; i < nest->n; i++)
+            if (i != nest->scale_idx)
+              {
+                const struct ctables_cell_value *p_cv
+                  = (a == ctx->pc_a && i == ctx->pc_a_idx ? pc_cv
+                     : &ctx->cell->axes[a].cvs[i]);
+                const struct ctables_cell_value *t_cv = &tc->axes[a].cvs[i];
+                if (p_cv->category != t_cv->category
+                    || (p_cv->category->type != CCT_TOTAL
+                        && p_cv->category->type != CCT_SUBTOTAL
+                        && p_cv->category->type != CCT_POSTCOMPUTE
+                        && !value_equal (&p_cv->value,
+                                         &t_cv->value,
+                                         var_get_width (nest->vars[i]))))
+                  goto not_equal;
+              }
+        }
+
+      goto found;
+
+    not_equal: ;
+    }
+  return 0;
+
+found: ;
+  const struct ctables_table *t = s->table;
+  const struct ctables_nest *specs_nest = s->nests[t->summary_axis];
+  const struct ctables_summary_spec_set *specs = &specs_nest->specs[tc->sv];
+  size_t j = 0 /* XXX */;
+  return ctables_summary_value (tc, &tc->summaries[j], &specs->specs[j]);
+}
+
+static double
+ctables_pcexpr_evaluate (const struct ctables_pcexpr_evaluate_ctx *ctx,
+                         const struct ctables_pcexpr *e)
+{
+  switch (e->op)
+    {
+    case CTPO_CONSTANT:
+      return e->number;
+
+    case CTPO_CAT_RANGE:
+      {
+        struct ctables_cell_value cv = {
+          .category = ctables_find_category_for_postcompute (ctx->cats, e)
+        };
+        assert (cv.category != NULL);
+
+        struct hmap *occurrences = &ctx->section->occurrences[ctx->pc_a][ctx->pc_a_idx];
+        const struct ctables_occurrence *o;
+
+        double sum = 0.0;
+        const struct variable *var = ctx->section->nests[ctx->pc_a]->vars[ctx->pc_a_idx];
+        HMAP_FOR_EACH (o, struct ctables_occurrence, node, occurrences)
+          if (ctables_categories_match (ctx->cats, &o->value, var) == cv.category)
+            {
+              cv.value = o->value;
+              sum += ctables_pcexpr_evaluate_category (ctx, &cv);
+            }
+        return sum;
+      }
+
+    case CTPO_CAT_NUMBER:
+    case CTPO_CAT_STRING:
+    case CTPO_CAT_MISSING:
+    case CTPO_CAT_OTHERNM:
+    case CTPO_CAT_SUBTOTAL:
+    case CTPO_CAT_TOTAL:
+      {
+        struct ctables_cell_value cv = {
+          .category = ctables_find_category_for_postcompute (ctx->cats, e),
+          .value = { .f = e->number },
+        };
+        assert (cv.category != NULL);
+        return ctables_pcexpr_evaluate_category (ctx, &cv);
+      }
+
+    case CTPO_ADD:
+      return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_add);
+
+    case CTPO_SUB:
+      return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_sub);
+
+    case CTPO_MUL:
+      return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_mul);
+
+    case CTPO_DIV:
+      return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_div);
+
+    case CTPO_POW:
+      return ctables_pcexpr_evaluate_nonterminal (ctx, e, 2, ctpo_pow);
+
+    case CTPO_NEG:
+      return ctables_pcexpr_evaluate_nonterminal (ctx, e, 1, ctpo_neg);
+    }
+
+  NOT_REACHED ();
+}
+
+static double
+ctables_cell_calculate_postcompute (const struct ctables_section *s,
+                                    const struct ctables_cell *cell)
+{
+  enum pivot_axis_type pc_a;
+  size_t pc_a_idx;
+  const struct ctables_postcompute *pc;
+  for (pc_a = 0; ; pc_a++)
+    {
+      assert (pc_a < PIVOT_N_AXES);
+      for (pc_a_idx = 0; pc_a_idx < s->nests[pc_a]->n; pc_a_idx++)
+        {
+          const struct ctables_cell_value *cv = &cell->axes[pc_a].cvs[pc_a_idx];
+          if (cv->category->type == CCT_POSTCOMPUTE)
+            {
+              pc = cv->category->pc;
+              goto found;
+            }
+        }
+    }
+found: ;
+
+  const struct variable *var = s->nests[pc_a]->vars[pc_a_idx];
+  const struct ctables_categories *cats = s->table->categories[
+    var_get_dict_index (var)];
+  struct ctables_pcexpr_evaluate_ctx ctx = {
+    .cell = cell,
+    .section = s,
+    .cats = cats,
+    .pc_a = pc_a,
+    .pc_a_idx = pc_a_idx,
+  };
+  return ctables_pcexpr_evaluate (&ctx, pc->expr);
+}
+
 static void
 ctables_table_output (struct ctables *ct, struct ctables_table *t)
 {
@@ -3221,6 +3466,7 @@ ctables_table_output (struct ctables *ct, struct ctables_table *t)
                             break;
                           else if (c->type != CCT_SUBTOTAL
                                    && c->type != CCT_TOTAL
+                                   && c->type != CCT_POSTCOMPUTE
                                    && !value_equal (&prev->axes[a].cvs[var_idx].value,
                                                     &cell->axes[a].cvs[var_idx].value,
                                                     var_get_type (nest->vars[var_idx])))
@@ -3314,7 +3560,9 @@ ctables_table_output (struct ctables *ct, struct ctables_table *t)
                     dindexes[n_dindexes++] = leaf;
                   }
 
-              double d = ctables_summary_value (cell, &cell->summaries[j], &specs->specs[j]);
+              double d = (cell->postcompute
+                          ? ctables_cell_calculate_postcompute (s, cell)
+                          : ctables_summary_value (cell, &cell->summaries[j], &specs->specs[j]));
               struct pivot_value *value = pivot_value_new_number (d);
               value->numeric.format = specs->specs[j].format;
               pivot_table_put (pt, dindexes, n_dindexes, value);
@@ -3708,19 +3956,30 @@ ctables_section_recurse_add_empty_categories (
   else
     {
       const struct variable *var = s->nests[a]->vars[a_idx];
+      const struct ctables_categories *categories = s->table->categories[
+        var_get_dict_index (var)];
       int width = var_get_width (var);
       const struct hmap *occurrences = &s->occurrences[a][a_idx];
-      const struct ctables_section_value *sv;
-      HMAP_FOR_EACH (sv, struct ctables_section_value, node, occurrences)
+      const struct ctables_occurrence *o;
+      HMAP_FOR_EACH (o, struct ctables_occurrence, node, occurrences)
         {
           union value *value = case_data_rw (c, var);
           value_destroy (value, width);
-          value_clone (value, &sv->value, width);
-          cats[a][a_idx] = ctables_categories_match (
-            s->table->categories[var_get_dict_index (var)], value, var);
+          value_clone (value, &o->value, width);
+          cats[a][a_idx] = ctables_categories_match (categories, value, var);
           assert (cats[a][a_idx] != NULL);
           ctables_section_recurse_add_empty_categories (s, cats, c, a, a_idx + 1);
         }
+
+      for (size_t i = 0; i < categories->n_cats; i++)
+        {
+          const struct ctables_category *cat = &categories->cats[i];
+          if (cat->type == CCT_POSTCOMPUTE)
+            {
+              cats[a][a_idx] = cat;
+              ctables_section_recurse_add_empty_categories (s, cats, c, a, a_idx + 1);
+            }
+        }
     }
 }
 
@@ -4146,7 +4405,7 @@ ctables_find_postcompute (struct ctables *ct, const char *name)
 static bool
 ctables_parse_pcompute (struct lexer *lexer, struct ctables *ct)
 {
-  int start_ofs = lex_ofs (lexer) - 1;
+  int pcompute_start = lex_ofs (lexer) - 1;
 
   if (!lex_force_match (lexer, T_AND) || !lex_force_id (lexer))
     return false;
@@ -4162,15 +4421,18 @@ ctables_parse_pcompute (struct lexer *lexer, struct ctables *ct)
       return false;
     }
 
+  int expr_start = lex_ofs (lexer);
   struct ctables_pcexpr *expr = parse_add (lexer);
+  int expr_end = lex_ofs (lexer) - 1;
   if (!expr || !lex_force_match (lexer, T_RPAREN))
     {
       free (name);
       return false;
     }
+  int pcompute_end = lex_ofs (lexer) - 1;
 
-  struct msg_location *location = lex_ofs_location (lexer, start_ofs,
-                                                    lex_ofs (lexer) - 1);
+  struct msg_location *location = lex_ofs_location (lexer, pcompute_start,
+                                                    pcompute_end);
 
   struct ctables_postcompute *pc = ctables_find_postcompute (ct, name);
   if (pc)
@@ -4193,6 +4455,8 @@ ctables_parse_pcompute (struct lexer *lexer, struct ctables *ct)
     }
   pc->expr = expr;
   pc->location = location;
+  if (!pc->label)
+    pc->label = lex_ofs_representation (lexer, expr_start, expr_end);
   return true;
 }