pintos-os.org Git - pspp/blob - src/language/stats/aggregate.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2006, 2008, 2009, 2010 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 <stdlib.h>
  20
  21 #include <data/any-writer.h>
  22 #include <data/case.h>
  23 #include <data/casegrouper.h>
  24 #include <data/casereader.h>
  25 #include <data/casewriter.h>
  26 #include <data/dictionary.h>
  27 #include <data/file-handle-def.h>
  28 #include <data/format.h>
  29 #include <data/procedure.h>
  30 #include <data/settings.h>
  31 #include <data/subcase.h>
  32 #include <data/sys-file-writer.h>
  33 #include <data/variable.h>
  34 #include <language/command.h>
  35 #include <language/data-io/file-handle.h>
  36 #include <language/lexer/lexer.h>
  37 #include <language/lexer/variable-parser.h>
  38 #include <language/stats/sort-criteria.h>
  39 #include <libpspp/assertion.h>
  40 #include <libpspp/message.h>
  41 #include <libpspp/misc.h>
  42 #include <libpspp/pool.h>
  43 #include <libpspp/str.h>
  44 #include <math/moments.h>
  45 #include <math/sort.h>
  46 #include <math/statistic.h>
  47 #include <math/percentiles.h>
  48
  49 #include "aggregate.h"
  50
  51 #include "minmax.h"
  52 #include "xalloc.h"
  53
  54 #include "gettext.h"
  55 #define _(msgid) gettext (msgid)
  56 #define N_(msgid) msgid
  57
  58 /* Argument for AGGREGATE function. */
  59 union agr_argument
  60   {
  61     double f;                           /* Numeric. */
  62     char *c;                            /* Short or long string. */
  63   };
  64
  65 /* Specifies how to make an aggregate variable. */
  66 struct agr_var
  67   {
  68     struct agr_var *next;               /* Next in list. */
  69
  70     /* Collected during parsing. */
  71     const struct variable *src; /* Source variable. */
  72     struct variable *dest;      /* Target variable. */
  73     int function;               /* Function. */
  74     enum mv_class exclude;      /* Classes of missing values to exclude. */
  75     union agr_argument arg[2];  /* Arguments. */
  76
  77     /* Accumulated during AGGREGATE execution. */
  78     double dbl[3];
  79     int int1, int2;
  80     char *string;
  81     bool saw_missing;
  82     struct moments1 *moments;
  83     double cc;
  84
  85     struct variable *subject;
  86     struct variable *weight;
  87     struct casewriter *writer;
  88   };
  89
  90 /* Aggregation functions. */
  91 enum
  92   {
  93     SUM, MEAN, MEDIAN, SD, MAX, MIN, PGT, PLT, PIN, POUT, FGT, FLT, FIN,
  94     FOUT, N, NU, NMISS, NUMISS, FIRST, LAST,
  95
  96     FUNC = 0x1f, /* Function mask. */
  97     FSTRING = 1<<5, /* String function bit. */
  98   };
  99
 100
 101 /* Attributes of aggregation functions. */
 102 const struct agr_func agr_func_tab[] =
 103   {
 104     {"SUM",     N_("Sum of values"), AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
 105     {"MEAN",    N_("Mean average"), AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
 106     {"MEDIAN",  N_("Median average"), AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
 107     {"SD",      N_("Standard deviation"), AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
 108     {"MAX",     N_("Maximum value"), AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 109     {"MIN",     N_("Minimum value"), AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 110     {"PGT",     N_("Percentage greater than"), AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 1}},
 111     {"PLT",     N_("Percentage less than"), AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 1}},
 112     {"PIN",     N_("Percentage included in range"), AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 1}},
 113     {"POUT",    N_("Percentage excluded from range"), AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 1}},
 114     {"FGT",     N_("Fraction greater than"), AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 3}},
 115     {"FLT",     N_("Fraction less than"), AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 3}},
 116     {"FIN",     N_("Fraction included in range"), AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 3}},
 117     {"FOUT",    N_("Fraction excluded from range"), AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 3}},
 118     {"N",       N_("Number of cases"), AGR_SV_NO, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 119     {"NU",      N_("Number of cases (unweighted)"), AGR_SV_OPT, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 120     {"NMISS",   N_("Number of missing values"), AGR_SV_YES, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 121     {"NUMISS",  N_("Number of missing values (unweighted)"), AGR_SV_YES, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 122     {"FIRST",   N_("First non-missing value"), AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 123     {"LAST",    N_("Last non-missing value"), AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 124     {NULL,      NULL, AGR_SV_NO, 0, -1,          {-1, -1, -1}},
 125   };
 126
 127 /* Missing value types. */
 128 enum missing_treatment
 129   {
 130     ITEMWISE,           /* Missing values item by item. */
 131     COLUMNWISE          /* Missing values column by column. */
 132   };
 133
 134 /* An entire AGGREGATE procedure. */
 135 struct agr_proc
 136   {
 137     /* Break variables. */
 138     struct subcase sort;                /* Sort criteria (break variables). */
 139     const struct variable **break_vars;       /* Break variables. */
 140     size_t break_var_cnt;               /* Number of break variables. */
 141
 142     enum missing_treatment missing;     /* How to treat missing values. */
 143     struct agr_var *agr_vars;           /* First aggregate variable. */
 144     struct dictionary *dict;            /* Aggregate dictionary. */
 145     const struct dictionary *src_dict;  /* Dict of the source */
 146     int case_cnt;                       /* Counts aggregated cases. */
 147
 148     bool add_variables;                 /* True iff the aggregated variables should
 149                                            be appended to the existing dictionary */
 150   };
 151
 152 static void initialize_aggregate_info (struct agr_proc *);
 153
 154 static void accumulate_aggregate_info (struct agr_proc *,
 155                                        const struct ccase *);
 156 /* Prototypes. */
 157 static bool parse_aggregate_functions (struct lexer *, const struct dictionary *,
 158                                        struct agr_proc *);
 159 static void agr_destroy (struct agr_proc *);
 160 static void dump_aggregate_info (const struct agr_proc *agr,
 161                                  struct casewriter *output,
 162                                  const struct ccase *break_case);
 163 \f
 164 /* Parsing. */
 165
 166 /* Parses and executes the AGGREGATE procedure. */
 167 int
 168 cmd_aggregate (struct lexer *lexer, struct dataset *ds)
 169 {
 170   struct dictionary *dict = dataset_dict (ds);
 171   struct agr_proc agr;
 172   struct file_handle *out_file = NULL;
 173   struct casereader *input = NULL, *group;
 174   struct casegrouper *grouper;
 175   struct casewriter *output = NULL;
 176
 177   bool copy_documents = false;
 178   bool presorted = false;
 179   bool saw_direction;
 180   bool ok;
 181
 182   memset(&agr, 0 , sizeof (agr));
 183   agr.missing = ITEMWISE;
 184   agr.src_dict = dict;
 185   subcase_init_empty (&agr.sort);
 186
 187   /* OUTFILE subcommand must be first. */
 188   lex_match (lexer, '/');
 189   if (!lex_force_match_id (lexer, "OUTFILE"))
 190     goto error;
 191   lex_match (lexer, '=');
 192   if (!lex_match (lexer, '*'))
 193     {
 194       out_file = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
 195       if (out_file == NULL)
 196         goto error;
 197     }
 198
 199   if (out_file == NULL && lex_match_id (lexer, "MODE"))
 200     {
 201       lex_match (lexer, '=');
 202       if (lex_match_id (lexer, "ADDVARIABLES"))
 203         {
 204           agr.add_variables = true;
 205
 206           /* presorted is assumed in ADDVARIABLES mode */
 207           presorted = true;
 208         }
 209       else if (lex_match_id (lexer, "REPLACE"))
 210         {
 211           agr.add_variables = false;
 212         }
 213       else
 214         goto error;
 215     }
 216
 217   if ( agr.add_variables )
 218     agr.dict = dict_clone (dict);
 219   else
 220     agr.dict = dict_create ();
 221
 222   dict_set_label (agr.dict, dict_get_label (dict));
 223   dict_set_documents (agr.dict, dict_get_documents (dict));
 224
 225   /* Read most of the subcommands. */
 226   for (;;)
 227     {
 228       lex_match (lexer, '/');
 229
 230       if (lex_match_id (lexer, "MISSING"))
 231         {
 232           lex_match (lexer, '=');
 233           if (!lex_match_id (lexer, "COLUMNWISE"))
 234             {
 235               lex_error (lexer, _("while expecting COLUMNWISE"));
 236               goto error;
 237             }
 238           agr.missing = COLUMNWISE;
 239         }
 240       else if (lex_match_id (lexer, "DOCUMENT"))
 241         copy_documents = true;
 242       else if (lex_match_id (lexer, "PRESORTED"))
 243         presorted = true;
 244       else if (lex_match_id (lexer, "BREAK"))
 245         {
 246           int i;
 247
 248           lex_match (lexer, '=');
 249           if (!parse_sort_criteria (lexer, dict, &agr.sort, &agr.break_vars,
 250                                     &saw_direction))
 251             goto error;
 252           agr.break_var_cnt = subcase_get_n_fields (&agr.sort);
 253
 254           if  (! agr.add_variables)
 255             for (i = 0; i < agr.break_var_cnt; i++)
 256               dict_clone_var_assert (agr.dict, agr.break_vars[i]);
 257
 258           /* BREAK must follow the options. */
 259           break;
 260         }
 261       else
 262         {
 263           lex_error (lexer, _("expecting BREAK"));
 264           goto error;
 265         }
 266     }
 267   if (presorted && saw_direction)
 268     msg (SW, _("When PRESORTED is specified, specifying sorting directions "
 269                "with (A) or (D) has no effect.  Output data will be sorted "
 270                "the same way as the input data."));
 271
 272   /* Read in the aggregate functions. */
 273   lex_match (lexer, '/');
 274   if (!parse_aggregate_functions (lexer, dict, &agr))
 275     goto error;
 276
 277   /* Delete documents. */
 278   if (!copy_documents)
 279     dict_clear_documents (agr.dict);
 280
 281   /* Cancel SPLIT FILE. */
 282   dict_set_split_vars (agr.dict, NULL, 0);
 283
 284   /* Initialize. */
 285   agr.case_cnt = 0;
 286
 287   if (out_file == NULL)
 288     {
 289       /* The active file will be replaced by the aggregated data,
 290          so TEMPORARY is moot. */
 291       proc_cancel_temporary_transformations (ds);
 292       proc_discard_output (ds);
 293       output = autopaging_writer_create (dict_get_proto (agr.dict));
 294     }
 295   else
 296     {
 297       output = any_writer_open (out_file, agr.dict);
 298       if (output == NULL)
 299         goto error;
 300     }
 301
 302   input = proc_open (ds);
 303   if (!subcase_is_empty (&agr.sort) && !presorted)
 304     {
 305       input = sort_execute (input, &agr.sort);
 306       subcase_clear (&agr.sort);
 307     }
 308
 309   for (grouper = casegrouper_create_vars (input, agr.break_vars,
 310                                           agr.break_var_cnt);
 311        casegrouper_get_next_group (grouper, &group);
 312        casereader_destroy (group))
 313     {
 314       struct casereader *placeholder = NULL;
 315       struct ccase *c = casereader_peek (group, 0);
 316
 317       if (c == NULL)
 318         {
 319           casereader_destroy (group);
 320           continue;
 321         }
 322
 323       initialize_aggregate_info (&agr);
 324
 325       if ( agr.add_variables )
 326         placeholder = casereader_clone (group);
 327
 328       {
 329         struct ccase *cg;
 330         for (; (cg = casereader_read (group)) != NULL; case_unref (cg))
 331           accumulate_aggregate_info (&agr, cg);
 332       }
 333
 334
 335       if  (agr.add_variables)
 336         {
 337           struct ccase *cg;
 338           for (; (cg = casereader_read (placeholder)) != NULL; case_unref (cg))
 339             dump_aggregate_info (&agr, output, cg);
 340
 341           casereader_destroy (placeholder);
 342         }
 343       else
 344         {
 345           dump_aggregate_info (&agr, output, c);
 346           case_unref (c);
 347         }
 348     }
 349   if (!casegrouper_destroy (grouper))
 350     goto error;
 351
 352   if (!proc_commit (ds))
 353     {
 354       input = NULL;
 355       goto error;
 356     }
 357   input = NULL;
 358
 359   if (out_file == NULL)
 360     {
 361       struct casereader *next_input = casewriter_make_reader (output);
 362       if (next_input == NULL)
 363         goto error;
 364
 365       proc_set_active_file (ds, next_input, agr.dict);
 366       agr.dict = NULL;
 367     }
 368   else
 369     {
 370       ok = casewriter_destroy (output);
 371       output = NULL;
 372       if (!ok)
 373         goto error;
 374     }
 375
 376   agr_destroy (&agr);
 377   fh_unref (out_file);
 378   return CMD_SUCCESS;
 379
 380 error:
 381   if (input != NULL)
 382     proc_commit (ds);
 383   casewriter_destroy (output);
 384   agr_destroy (&agr);
 385   fh_unref (out_file);
 386   return CMD_CASCADING_FAILURE;
 387 }
 388
 389 /* Parse all the aggregate functions. */
 390 static bool
 391 parse_aggregate_functions (struct lexer *lexer, const struct dictionary *dict,
 392                            struct agr_proc *agr)
 393 {
 394   struct agr_var *tail; /* Tail of linked list starting at agr->vars. */
 395
 396   /* Parse everything. */
 397   tail = NULL;
 398   for (;;)
 399     {
 400       char **dest;
 401       char **dest_label;
 402       size_t n_dest;
 403       struct string function_name;
 404
 405       enum mv_class exclude;
 406       const struct agr_func *function;
 407       int func_index;
 408
 409       union agr_argument arg[2];
 410
 411       const struct variable **src;
 412       size_t n_src;
 413
 414       size_t i;
 415
 416       dest = NULL;
 417       dest_label = NULL;
 418       n_dest = 0;
 419       src = NULL;
 420       function = NULL;
 421       n_src = 0;
 422       arg[0].c = NULL;
 423       arg[1].c = NULL;
 424       ds_init_empty (&function_name);
 425
 426       /* Parse the list of target variables. */
 427       while (!lex_match (lexer, '='))
 428         {
 429           size_t n_dest_prev = n_dest;
 430
 431           if (!parse_DATA_LIST_vars (lexer, &dest, &n_dest,
 432                                      (PV_APPEND | PV_SINGLE | PV_NO_SCRATCH
 433                                       | PV_NO_DUPLICATE)))
 434             goto error;
 435
 436           /* Assign empty labels. */
 437           {
 438             int j;
 439
 440             dest_label = xnrealloc (dest_label, n_dest, sizeof *dest_label);
 441             for (j = n_dest_prev; j < n_dest; j++)
 442               dest_label[j] = NULL;
 443           }
 444
 445
 446
 447           if (lex_token (lexer) == T_STRING)
 448             {
 449               struct string label;
 450               ds_init_string (&label, lex_tokstr (lexer));
 451
 452               ds_truncate (&label, 255);
 453               dest_label[n_dest - 1] = ds_xstrdup (&label);
 454               lex_get (lexer);
 455               ds_destroy (&label);
 456             }
 457         }
 458
 459       /* Get the name of the aggregation function. */
 460       if (lex_token (lexer) != T_ID)
 461         {
 462           lex_error (lexer, _("expecting aggregation function"));
 463           goto error;
 464         }
 465
 466       exclude = MV_ANY;
 467
 468       ds_assign_string (&function_name, lex_tokstr (lexer));
 469
 470       ds_chomp (&function_name, '.');
 471
 472       if (lex_tokid(lexer)[strlen (lex_tokid (lexer)) - 1] == '.')
 473         exclude = MV_SYSTEM;
 474
 475       for (function = agr_func_tab; function->name; function++)
 476         if (!strcasecmp (function->name, ds_cstr (&function_name)))
 477           break;
 478       if (NULL == function->name)
 479         {
 480           msg (SE, _("Unknown aggregation function %s."),
 481                ds_cstr (&function_name));
 482           goto error;
 483         }
 484       ds_destroy (&function_name);
 485       func_index = function - agr_func_tab;
 486       lex_get (lexer);
 487
 488       /* Check for leading lparen. */
 489       if (!lex_match (lexer, '('))
 490         {
 491           if (function->src_vars == AGR_SV_YES)
 492             {
 493               lex_error (lexer, _("expecting `('"));
 494               goto error;
 495             }
 496         }
 497       else
 498         {
 499           /* Parse list of source variables. */
 500           {
 501             int pv_opts = PV_NO_SCRATCH;
 502
 503             if (func_index == SUM || func_index == MEAN || func_index == SD)
 504               pv_opts |= PV_NUMERIC;
 505             else if (function->n_args)
 506               pv_opts |= PV_SAME_TYPE;
 507
 508             if (!parse_variables_const (lexer, dict, &src, &n_src, pv_opts))
 509               goto error;
 510           }
 511
 512           /* Parse function arguments, for those functions that
 513              require arguments. */
 514           if (function->n_args != 0)
 515             for (i = 0; i < function->n_args; i++)
 516               {
 517                 int type;
 518
 519                 lex_match (lexer, ',');
 520                 if (lex_token (lexer) == T_STRING)
 521                   {
 522                     arg[i].c = ds_xstrdup (lex_tokstr (lexer));
 523                     type = VAL_STRING;
 524                   }
 525                 else if (lex_is_number (lexer))
 526                   {
 527                     arg[i].f = lex_tokval (lexer);
 528                     type = VAL_NUMERIC;
 529                   }
 530                 else
 531                   {
 532                     msg (SE, _("Missing argument %zu to %s."),
 533                          i + 1, function->name);
 534                     goto error;
 535                   }
 536
 537                 lex_get (lexer);
 538
 539                 if (type != var_get_type (src[0]))
 540                   {
 541                     msg (SE, _("Arguments to %s must be of same type as "
 542                                "source variables."),
 543                          function->name);
 544                     goto error;
 545                   }
 546               }
 547
 548           /* Trailing rparen. */
 549           if (!lex_match (lexer, ')'))
 550             {
 551               lex_error (lexer, _("expecting `)'"));
 552               goto error;
 553             }
 554
 555           /* Now check that the number of source variables match
 556              the number of target variables.  If we check earlier
 557              than this, the user can get very misleading error
 558              message, i.e. `AGGREGATE x=SUM(y t).' will get this
 559              error message when a proper message would be more
 560              like `unknown variable t'. */
 561           if (n_src != n_dest)
 562             {
 563               msg (SE, _("Number of source variables (%zu) does not match "
 564                          "number of target variables (%zu)."),
 565                     n_src, n_dest);
 566               goto error;
 567             }
 568
 569           if ((func_index == PIN || func_index == POUT
 570               || func_index == FIN || func_index == FOUT)
 571               && (var_is_numeric (src[0])
 572                   ? arg[0].f > arg[1].f
 573                   : str_compare_rpad (arg[0].c, arg[1].c) > 0))
 574             {
 575               union agr_argument t = arg[0];
 576               arg[0] = arg[1];
 577               arg[1] = t;
 578
 579               msg (SW, _("The value arguments passed to the %s function "
 580                          "are out-of-order.  They will be treated as if "
 581                          "they had been specified in the correct order."),
 582                    function->name);
 583             }
 584         }
 585
 586       /* Finally add these to the linked list of aggregation
 587          variables. */
 588       for (i = 0; i < n_dest; i++)
 589         {
 590           struct agr_var *v = xzalloc (sizeof *v);
 591
 592           /* Add variable to chain. */
 593           if (agr->agr_vars != NULL)
 594             tail->next = v;
 595           else
 596             agr->agr_vars = v;
 597           tail = v;
 598           tail->next = NULL;
 599           v->moments = NULL;
 600
 601           /* Create the target variable in the aggregate
 602              dictionary. */
 603           {
 604             struct variable *destvar;
 605
 606             v->function = func_index;
 607
 608             if (src)
 609               {
 610                 v->src = src[i];
 611
 612                 if (var_is_alpha (src[i]))
 613                   {
 614                     v->function |= FSTRING;
 615                     v->string = xmalloc (var_get_width (src[i]));
 616                   }
 617
 618                 if (function->alpha_type == VAL_STRING)
 619                   destvar = dict_clone_var_as (agr->dict, v->src, dest[i]);
 620                 else
 621                   {
 622                     assert (var_is_numeric (v->src)
 623                             || function->alpha_type == VAL_NUMERIC);
 624                     destvar = dict_create_var (agr->dict, dest[i], 0);
 625                     if (destvar != NULL)
 626                       {
 627                         struct fmt_spec f;
 628                         if ((func_index == N || func_index == NMISS)
 629                             && dict_get_weight (dict) != NULL)
 630                           f = fmt_for_output (FMT_F, 8, 2);
 631                         else
 632                           f = function->format;
 633                         var_set_both_formats (destvar, &f);
 634                       }
 635                   }
 636               } else {
 637                 struct fmt_spec f;
 638                 v->src = NULL;
 639                 destvar = dict_create_var (agr->dict, dest[i], 0);
 640                 if (func_index == N && dict_get_weight (dict) != NULL)
 641                   f = fmt_for_output (FMT_F, 8, 2);
 642                 else
 643                   f = function->format;
 644                 var_set_both_formats (destvar, &f);
 645               }
 646
 647             if (!destvar)
 648               {
 649                 msg (SE, _("Variable name %s is not unique within the "
 650                            "aggregate file dictionary, which contains "
 651                            "the aggregate variables and the break "
 652                            "variables."),
 653                      dest[i]);
 654                 goto error;
 655               }
 656
 657             free (dest[i]);
 658             if (dest_label[i])
 659               var_set_label (destvar, dest_label[i]);
 660
 661             v->dest = destvar;
 662           }
 663
 664           v->exclude = exclude;
 665
 666           if (v->src != NULL)
 667             {
 668               int j;
 669
 670               if (var_is_numeric (v->src))
 671                 for (j = 0; j < function->n_args; j++)
 672                   v->arg[j].f = arg[j].f;
 673               else
 674                 for (j = 0; j < function->n_args; j++)
 675                   v->arg[j].c = xstrdup (arg[j].c);
 676             }
 677         }
 678
 679       if (src != NULL && var_is_alpha (src[0]))
 680         for (i = 0; i < function->n_args; i++)
 681           {
 682             free (arg[i].c);
 683             arg[i].c = NULL;
 684           }
 685
 686       free (src);
 687       free (dest);
 688       free (dest_label);
 689
 690       if (!lex_match (lexer, '/'))
 691         {
 692           if (lex_token (lexer) == '.')
 693             return true;
 694
 695           lex_error (lexer, "expecting end of command");
 696           return false;
 697         }
 698       continue;
 699
 700     error:
 701       ds_destroy (&function_name);
 702       for (i = 0; i < n_dest; i++)
 703         {
 704           free (dest[i]);
 705           free (dest_label[i]);
 706         }
 707       free (dest);
 708       free (dest_label);
 709       free (arg[0].c);
 710       free (arg[1].c);
 711       if (src && n_src && var_is_alpha (src[0]))
 712         for (i = 0; i < function->n_args; i++)
 713           {
 714             free (arg[i].c);
 715             arg[i].c = NULL;
 716           }
 717       free (src);
 718
 719       return false;
 720     }
 721 }
 722
 723 /* Destroys AGR. */
 724 static void
 725 agr_destroy (struct agr_proc *agr)
 726 {
 727   struct agr_var *iter, *next;
 728
 729   subcase_destroy (&agr->sort);
 730   free (agr->break_vars);
 731   for (iter = agr->agr_vars; iter; iter = next)
 732     {
 733       next = iter->next;
 734
 735       if (iter->function & FSTRING)
 736         {
 737           size_t n_args;
 738           size_t i;
 739
 740           n_args = agr_func_tab[iter->function & FUNC].n_args;
 741           for (i = 0; i < n_args; i++)
 742             free (iter->arg[i].c);
 743           free (iter->string);
 744         }
 745       else if (iter->function == SD)
 746         moments1_destroy (iter->moments);
 747
 748       dict_destroy_internal_var (iter->subject);
 749       dict_destroy_internal_var (iter->weight);
 750
 751       free (iter);
 752     }
 753   if (agr->dict != NULL)
 754     dict_destroy (agr->dict);
 755 }
 756 \f
 757 /* Execution. */
 758
 759 /* Accumulates aggregation data from the case INPUT. */
 760 static void
 761 accumulate_aggregate_info (struct agr_proc *agr, const struct ccase *input)
 762 {
 763   struct agr_var *iter;
 764   double weight;
 765   bool bad_warn = true;
 766
 767   weight = dict_get_case_weight (agr->src_dict, input, &bad_warn);
 768
 769   for (iter = agr->agr_vars; iter; iter = iter->next)
 770     if (iter->src)
 771       {
 772         const union value *v = case_data (input, iter->src);
 773         int src_width = var_get_width (iter->src);
 774
 775         if (var_is_value_missing (iter->src, v, iter->exclude))
 776           {
 777             switch (iter->function)
 778               {
 779               case NMISS:
 780               case NMISS | FSTRING:
 781                 iter->dbl[0] += weight;
 782                 break;
 783               case NUMISS:
 784               case NUMISS | FSTRING:
 785                 iter->int1++;
 786                 break;
 787               }
 788             iter->saw_missing = true;
 789             continue;
 790           }
 791
 792         /* This is horrible.  There are too many possibilities. */
 793         switch (iter->function)
 794           {
 795           case SUM:
 796             iter->dbl[0] += v->f * weight;
 797             iter->int1 = 1;
 798             break;
 799           case MEAN:
 800             iter->dbl[0] += v->f * weight;
 801             iter->dbl[1] += weight;
 802             break;
 803           case MEDIAN:
 804             {
 805               double wv ;
 806               struct ccase *cout;
 807
 808               cout = case_create (casewriter_get_proto (iter->writer));
 809
 810               case_data_rw (cout, iter->subject)->f
 811                 = case_data (input, iter->src)->f;
 812
 813               wv = dict_get_case_weight (agr->src_dict, input, NULL);
 814
 815               case_data_rw (cout, iter->weight)->f = wv;
 816
 817               iter->cc += wv;
 818
 819               casewriter_write (iter->writer, cout);
 820             }
 821             break;
 822           case SD:
 823             moments1_add (iter->moments, v->f, weight);
 824             break;
 825           case MAX:
 826             iter->dbl[0] = MAX (iter->dbl[0], v->f);
 827             iter->int1 = 1;
 828             break;
 829           case MAX | FSTRING:
 830             if (memcmp (iter->string, value_str (v, src_width), src_width) < 0)
 831               memcpy (iter->string, value_str (v, src_width), src_width);
 832             iter->int1 = 1;
 833             break;
 834           case MIN:
 835             iter->dbl[0] = MIN (iter->dbl[0], v->f);
 836             iter->int1 = 1;
 837             break;
 838           case MIN | FSTRING:
 839             if (memcmp (iter->string, value_str (v, src_width), src_width) > 0)
 840               memcpy (iter->string, value_str (v, src_width), src_width);
 841             iter->int1 = 1;
 842             break;
 843           case FGT:
 844           case PGT:
 845             if (v->f > iter->arg[0].f)
 846               iter->dbl[0] += weight;
 847             iter->dbl[1] += weight;
 848             break;
 849           case FGT | FSTRING:
 850           case PGT | FSTRING:
 851             if (memcmp (iter->arg[0].c,
 852                         value_str (v, src_width), src_width) < 0)
 853               iter->dbl[0] += weight;
 854             iter->dbl[1] += weight;
 855             break;
 856           case FLT:
 857           case PLT:
 858             if (v->f < iter->arg[0].f)
 859               iter->dbl[0] += weight;
 860             iter->dbl[1] += weight;
 861             break;
 862           case FLT | FSTRING:
 863           case PLT | FSTRING:
 864             if (memcmp (iter->arg[0].c,
 865                         value_str (v, src_width), src_width) > 0)
 866               iter->dbl[0] += weight;
 867             iter->dbl[1] += weight;
 868             break;
 869           case FIN:
 870           case PIN:
 871             if (iter->arg[0].f <= v->f && v->f <= iter->arg[1].f)
 872               iter->dbl[0] += weight;
 873             iter->dbl[1] += weight;
 874             break;
 875           case FIN | FSTRING:
 876           case PIN | FSTRING:
 877             if (memcmp (iter->arg[0].c,
 878                         value_str (v, src_width), src_width) <= 0
 879                 && memcmp (iter->arg[1].c,
 880                            value_str (v, src_width), src_width) >= 0)
 881               iter->dbl[0] += weight;
 882             iter->dbl[1] += weight;
 883             break;
 884           case FOUT:
 885           case POUT:
 886             if (iter->arg[0].f > v->f || v->f > iter->arg[1].f)
 887               iter->dbl[0] += weight;
 888             iter->dbl[1] += weight;
 889             break;
 890           case FOUT | FSTRING:
 891           case POUT | FSTRING:
 892             if (memcmp (iter->arg[0].c,
 893                         value_str (v, src_width), src_width) > 0
 894                 || memcmp (iter->arg[1].c,
 895                            value_str (v, src_width), src_width) < 0)
 896               iter->dbl[0] += weight;
 897             iter->dbl[1] += weight;
 898             break;
 899           case N:
 900           case N | FSTRING:
 901             iter->dbl[0] += weight;
 902             break;
 903           case NU:
 904           case NU | FSTRING:
 905             iter->int1++;
 906             break;
 907           case FIRST:
 908             if (iter->int1 == 0)
 909               {
 910                 iter->dbl[0] = v->f;
 911                 iter->int1 = 1;
 912               }
 913             break;
 914           case FIRST | FSTRING:
 915             if (iter->int1 == 0)
 916               {
 917                 memcpy (iter->string, value_str (v, src_width), src_width);
 918                 iter->int1 = 1;
 919               }
 920             break;
 921           case LAST:
 922             iter->dbl[0] = v->f;
 923             iter->int1 = 1;
 924             break;
 925           case LAST | FSTRING:
 926             memcpy (iter->string, value_str (v, src_width), src_width);
 927             iter->int1 = 1;
 928             break;
 929           case NMISS:
 930           case NMISS | FSTRING:
 931           case NUMISS:
 932           case NUMISS | FSTRING:
 933             /* Our value is not missing or it would have been
 934                caught earlier.  Nothing to do. */
 935             break;
 936           default:
 937             NOT_REACHED ();
 938           }
 939       } else {
 940       switch (iter->function)
 941         {
 942         case N:
 943           iter->dbl[0] += weight;
 944           break;
 945         case NU:
 946           iter->int1++;
 947           break;
 948         default:
 949           NOT_REACHED ();
 950         }
 951     }
 952 }
 953
 954 /* Writes an aggregated record to OUTPUT. */
 955 static void
 956 dump_aggregate_info (const struct agr_proc *agr, struct casewriter *output, const struct ccase *break_case)
 957 {
 958   struct ccase *c = case_create (dict_get_proto (agr->dict));
 959
 960   if ( agr->add_variables)
 961     {
 962       case_copy (c, 0, break_case, 0, dict_get_var_cnt (agr->src_dict));
 963     }
 964   else
 965     {
 966       int value_idx = 0;
 967       int i;
 968
 969       for (i = 0; i < agr->break_var_cnt; i++)
 970         {
 971           const struct variable *v = agr->break_vars[i];
 972           value_copy (case_data_rw_idx (c, value_idx),
 973                       case_data (break_case, v),
 974                       var_get_width (v));
 975           value_idx++;
 976         }
 977     }
 978
 979   {
 980     struct agr_var *i;
 981
 982     for (i = agr->agr_vars; i; i = i->next)
 983       {
 984         union value *v = case_data_rw (c, i->dest);
 985         int width = var_get_width (i->dest);
 986
 987         if (agr->missing == COLUMNWISE && i->saw_missing
 988             && (i->function & FUNC) != N && (i->function & FUNC) != NU
 989             && (i->function & FUNC) != NMISS && (i->function & FUNC) != NUMISS)
 990           {
 991             value_set_missing (v, width);
 992             casewriter_destroy (i->writer);
 993             continue;
 994           }
 995
 996         switch (i->function)
 997           {
 998           case SUM:
 999             v->f = i->int1 ? i->dbl[0] : SYSMIS;
1000             break;
1001           case MEAN:
1002             v->f = i->dbl[1] != 0.0 ? i->dbl[0] / i->dbl[1] : SYSMIS;
1003             break;
1004           case MEDIAN:
1005             {
1006               if ( i->writer)
1007                 {
1008                   struct percentile *median = percentile_create (0.5, i->cc);
1009                   struct order_stats *os = &median->parent;
1010                   struct casereader *sorted_reader = casewriter_make_reader (i->writer);
1011                   i->writer = NULL;
1012
1013                   order_stats_accumulate (&os, 1,
1014                                           sorted_reader,
1015                                           i->weight,
1016                                           i->subject,
1017                                           i->exclude);
1018                   i->dbl[0] = percentile_calculate (median, PC_HAVERAGE);
1019                   statistic_destroy (&median->parent.parent);
1020                 }
1021               v->f = i->dbl[0];
1022             }
1023             break;
1024           case SD:
1025             {
1026               double variance;
1027
1028               /* FIXME: we should use two passes. */
1029               moments1_calculate (i->moments, NULL, NULL, &variance,
1030                                  NULL, NULL);
1031               if (variance != SYSMIS)
1032                 v->f = sqrt (variance);
1033               else
1034                 v->f = SYSMIS;
1035             }
1036             break;
1037           case MAX:
1038           case MIN:
1039             v->f = i->int1 ? i->dbl[0] : SYSMIS;
1040             break;
1041           case MAX | FSTRING:
1042           case MIN | FSTRING:
1043             if (i->int1)
1044               memcpy (value_str_rw (v, width), i->string, width);
1045             else
1046               value_set_missing (v, width);
1047             break;
1048           case FGT:
1049           case FGT | FSTRING:
1050           case FLT:
1051           case FLT | FSTRING:
1052           case FIN:
1053           case FIN | FSTRING:
1054           case FOUT:
1055           case FOUT | FSTRING:
1056             v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] : SYSMIS;
1057             break;
1058           case PGT:
1059           case PGT | FSTRING:
1060           case PLT:
1061           case PLT | FSTRING:
1062           case PIN:
1063           case PIN | FSTRING:
1064           case POUT:
1065           case POUT | FSTRING:
1066             v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] * 100.0 : SYSMIS;
1067             break;
1068           case N:
1069           case N | FSTRING:
1070               v->f = i->dbl[0];
1071             break;
1072           case NU:
1073           case NU | FSTRING:
1074             v->f = i->int1;
1075             break;
1076           case FIRST:
1077           case LAST:
1078             v->f = i->int1 ? i->dbl[0] : SYSMIS;
1079             break;
1080           case FIRST | FSTRING:
1081           case LAST | FSTRING:
1082             if (i->int1)
1083               memcpy (value_str_rw (v, width), i->string, width);
1084             else
1085               value_set_missing (v, width);
1086             break;
1087           case NMISS:
1088           case NMISS | FSTRING:
1089             v->f = i->dbl[0];
1090             break;
1091           case NUMISS:
1092           case NUMISS | FSTRING:
1093             v->f = i->int1;
1094             break;
1095           default:
1096             NOT_REACHED ();
1097           }
1098       }
1099   }
1100
1101   casewriter_write (output, c);
1102 }
1103
1104 /* Resets the state for all the aggregate functions. */
1105 static void
1106 initialize_aggregate_info (struct agr_proc *agr)
1107 {
1108   struct agr_var *iter;
1109
1110   for (iter = agr->agr_vars; iter; iter = iter->next)
1111     {
1112       iter->saw_missing = false;
1113       iter->dbl[0] = iter->dbl[1] = iter->dbl[2] = 0.0;
1114       iter->int1 = iter->int2 = 0;
1115       switch (iter->function)
1116         {
1117         case MIN:
1118           iter->dbl[0] = DBL_MAX;
1119           break;
1120         case MIN | FSTRING:
1121           memset (iter->string, 255, var_get_width (iter->src));
1122           break;
1123         case MAX:
1124           iter->dbl[0] = -DBL_MAX;
1125           break;
1126         case MAX | FSTRING:
1127           memset (iter->string, 0, var_get_width (iter->src));
1128           break;
1129         case MEDIAN:
1130           {
1131             struct caseproto *proto;
1132             struct subcase ordering;
1133
1134             proto = caseproto_create ();
1135             proto = caseproto_add_width (proto, 0);
1136             proto = caseproto_add_width (proto, 0);
1137
1138             if ( ! iter->subject)
1139               iter->subject = dict_create_internal_var (0, 0);
1140
1141             if ( ! iter->weight)
1142               iter->weight = dict_create_internal_var (1, 0);
1143
1144             subcase_init_var (&ordering, iter->subject, SC_ASCEND);
1145             iter->writer = sort_create_writer (&ordering, proto);
1146             subcase_destroy (&ordering);
1147             caseproto_unref (proto);
1148
1149             iter->cc = 0;
1150           }
1151           break;
1152         case SD:
1153           if (iter->moments == NULL)
1154             iter->moments = moments1_create (MOMENT_VARIANCE);
1155           else
1156             moments1_clear (iter->moments);
1157           break;
1158         default:
1159           break;
1160         }
1161     }
1162 }