src/language/stats/aggregate.c

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