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, 2011, 2012 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/dataset.h"
  29 #include "data/dictionary.h"
  30 #include "data/file-handle-def.h"
  31 #include "data/format.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/i18n.h"
  43 #include "libpspp/message.h"
  44 #include "libpspp/misc.h"
  45 #include "libpspp/pool.h"
  46 #include "libpspp/str.h"
  47 #include "math/moments.h"
  48 #include "math/percentiles.h"
  49 #include "math/sort.h"
  50 #include "math/statistic.h"
  51
  52 #include "gl/c-strcase.h"
  53 #include "gl/minmax.h"
  54 #include "gl/xalloc.h"
  55
  56 #include "gettext.h"
  57 #define _(msgid) gettext (msgid)
  58 #define N_(msgid) msgid
  59
  60 /* Argument for AGGREGATE function. */
  61 union agr_argument
  62   {
  63     double f;                           /* Numeric. */
  64     char *c;                            /* Short or long string. */
  65   };
  66
  67 /* Specifies how to make an aggregate variable. */
  68 struct agr_var
  69   {
  70     struct agr_var *next;               /* Next in list. */
  71
  72     /* Collected during parsing. */
  73     const struct variable *src; /* Source variable. */
  74     struct variable *dest;      /* Target variable. */
  75     int function;               /* Function. */
  76     enum mv_class exclude;      /* Classes of missing values to exclude. */
  77     union agr_argument arg[2];  /* Arguments. */
  78
  79     /* Accumulated during AGGREGATE execution. */
  80     double dbl[3];
  81     int int1, int2;
  82     char *string;
  83     bool saw_missing;
  84     struct moments1 *moments;
  85     double cc;
  86
  87     struct variable *subject;
  88     struct variable *weight;
  89     struct casewriter *writer;
  90   };
  91
  92
  93 /* Attributes of aggregation functions. */
  94 const struct agr_func agr_func_tab[] =
  95   {
  96     {"SUM",     N_("Sum of values"),                         AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
  97     {"MEAN",    N_("Mean average"),                          AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
  98     {"MEDIAN",  N_("Median average"),                        AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
  99     {"SD",      N_("Standard deviation"),                    AGR_SV_YES, 0, -1,          {FMT_F, 8, 2}},
 100     {"MAX",     N_("Maximum value"),                         AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 101     {"MIN",     N_("Minimum value"),                         AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 102     {"PGT",     N_("Percentage greater than"),               AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 1}},
 103     {"PLT",     N_("Percentage less than"),                  AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 1}},
 104     {"PIN",     N_("Percentage included in range"),          AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 1}},
 105     {"POUT",    N_("Percentage excluded from range"),        AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 1}},
 106     {"FGT",     N_("Fraction greater than"),                 AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 3}},
 107     {"FLT",     N_("Fraction less than"),                    AGR_SV_YES, 1, VAL_NUMERIC, {FMT_F, 5, 3}},
 108     {"FIN",     N_("Fraction included in range"),            AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 3}},
 109     {"FOUT",    N_("Fraction excluded from range"),          AGR_SV_YES, 2, VAL_NUMERIC, {FMT_F, 5, 3}},
 110     {"N",       N_("Number of cases"),                       AGR_SV_NO,  0, VAL_NUMERIC, {FMT_F, 7, 0}},
 111     {"NU",      N_("Number of cases (unweighted)"),          AGR_SV_OPT, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 112     {"NMISS",   N_("Number of missing values"),              AGR_SV_YES, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 113     {"NUMISS",  N_("Number of missing values (unweighted)"), AGR_SV_YES, 0, VAL_NUMERIC, {FMT_F, 7, 0}},
 114     {"FIRST",   N_("First non-missing value"),               AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 115     {"LAST",    N_("Last non-missing value"),                AGR_SV_YES, 0, VAL_STRING,  {-1, -1, -1}},
 116     {NULL,      NULL,                                        AGR_SV_NO,  0, -1,          {-1, -1, -1}},
 117   };
 118
 119 /* Missing value types. */
 120 enum missing_treatment
 121   {
 122     ITEMWISE,           /* Missing values item by item. */
 123     COLUMNWISE          /* Missing values column by column. */
 124   };
 125
 126 /* An entire AGGREGATE procedure. */
 127 struct agr_proc
 128   {
 129     /* Break variables. */
 130     struct subcase sort;                /* Sort criteria (break variables). */
 131     const struct variable **break_vars;       /* Break variables. */
 132     size_t break_var_cnt;               /* Number of break variables. */
 133
 134     enum missing_treatment missing;     /* How to treat missing values. */
 135     struct agr_var *agr_vars;           /* First aggregate variable. */
 136     struct dictionary *dict;            /* Aggregate dictionary. */
 137     const struct dictionary *src_dict;  /* Dict of the source */
 138     int case_cnt;                       /* Counts aggregated cases. */
 139
 140     bool add_variables;                 /* True iff the aggregated variables should
 141                                            be appended to the existing dictionary */
 142   };
 143
 144 static void initialize_aggregate_info (struct agr_proc *);
 145
 146 static void accumulate_aggregate_info (struct agr_proc *,
 147                                        const struct ccase *);
 148 /* Prototypes. */
 149 static bool parse_aggregate_functions (struct lexer *, const struct dictionary *,
 150                                        struct agr_proc *);
 151 static void agr_destroy (struct agr_proc *);
 152 static void dump_aggregate_info (const struct agr_proc *agr,
 153                                  struct casewriter *output,
 154                                  const struct ccase *break_case);
 155 \f
 156 /* Parsing. */
 157
 158 /* Parses and executes the AGGREGATE procedure. */
 159 int
 160 cmd_aggregate (struct lexer *lexer, struct dataset *ds)
 161 {
 162   struct dictionary *dict = dataset_dict (ds);
 163   struct agr_proc agr;
 164   struct file_handle *out_file = NULL;
 165   struct casereader *input = NULL, *group;
 166   struct casegrouper *grouper;
 167   struct casewriter *output = NULL;
 168
 169   bool copy_documents = false;
 170   bool presorted = false;
 171   bool saw_direction;
 172   bool ok;
 173
 174   memset(&agr, 0 , sizeof (agr));
 175   agr.missing = ITEMWISE;
 176   agr.src_dict = dict;
 177   subcase_init_empty (&agr.sort);
 178
 179   /* OUTFILE subcommand must be first. */
 180   lex_match (lexer, T_SLASH);
 181   if (!lex_force_match_id (lexer, "OUTFILE"))
 182     goto error;
 183   lex_match (lexer, T_EQUALS);
 184   if (!lex_match (lexer, T_ASTERISK))
 185     {
 186       out_file = fh_parse (lexer, FH_REF_FILE, dataset_session (ds));
 187       if (out_file == NULL)
 188         goto error;
 189     }
 190
 191   if (out_file == NULL && lex_match_id (lexer, "MODE"))
 192     {
 193       lex_match (lexer, T_EQUALS);
 194       if (lex_match_id (lexer, "ADDVARIABLES"))
 195         {
 196           agr.add_variables = true;
 197
 198           /* presorted is assumed in ADDVARIABLES mode */
 199           presorted = true;
 200         }
 201       else if (lex_match_id (lexer, "REPLACE"))
 202         {
 203           agr.add_variables = false;
 204         }
 205       else
 206         goto error;
 207     }
 208
 209   if ( agr.add_variables )
 210     agr.dict = dict_clone (dict);
 211   else
 212     agr.dict = dict_create (dict_get_encoding (dict));
 213
 214   dict_set_label (agr.dict, dict_get_label (dict));
 215   dict_set_documents (agr.dict, dict_get_documents (dict));
 216
 217   /* Read most of the subcommands. */
 218   for (;;)
 219     {
 220       lex_match (lexer, T_SLASH);
 221
 222       if (lex_match_id (lexer, "MISSING"))
 223         {
 224           lex_match (lexer, T_EQUALS);
 225           if (!lex_match_id (lexer, "COLUMNWISE"))
 226             {
 227               lex_error_expecting (lexer, "COLUMNWISE", NULL);
 228               goto error;
 229             }
 230           agr.missing = COLUMNWISE;
 231         }
 232       else if (lex_match_id (lexer, "DOCUMENT"))
 233         copy_documents = true;
 234       else if (lex_match_id (lexer, "PRESORTED"))
 235         presorted = true;
 236       else if (lex_force_match_id (lexer, "BREAK"))
 237         {
 238           int i;
 239
 240           lex_match (lexer, T_EQUALS);
 241           if (!parse_sort_criteria (lexer, dict, &agr.sort, &agr.break_vars,
 242                                     &saw_direction))
 243             goto error;
 244           agr.break_var_cnt = subcase_get_n_fields (&agr.sort);
 245
 246           if  (! agr.add_variables)
 247             for (i = 0; i < agr.break_var_cnt; i++)
 248               dict_clone_var_assert (agr.dict, agr.break_vars[i]);
 249
 250           /* BREAK must follow the options. */
 251           break;
 252         }
 253       else
 254         goto error;
 255
 256     }
 257   if (presorted && saw_direction)
 258     msg (SW, _("When PRESORTED is specified, specifying sorting directions "
 259                "with (A) or (D) has no effect.  Output data will be sorted "
 260                "the same way as the input data."));
 261
 262   /* Read in the aggregate functions. */
 263   lex_match (lexer, T_SLASH);
 264   if (!parse_aggregate_functions (lexer, dict, &agr))
 265     goto error;
 266
 267   /* Delete documents. */
 268   if (!copy_documents)
 269     dict_clear_documents (agr.dict);
 270
 271   /* Cancel SPLIT FILE. */
 272   dict_set_split_vars (agr.dict, NULL, 0);
 273
 274   /* Initialize. */
 275   agr.case_cnt = 0;
 276
 277   if (out_file == NULL)
 278     {
 279       /* The active dataset will be replaced by the aggregated data,
 280          so TEMPORARY is moot. */
 281       proc_cancel_temporary_transformations (ds);
 282       proc_discard_output (ds);
 283       output = autopaging_writer_create (dict_get_proto (agr.dict));
 284     }
 285   else
 286     {
 287       output = any_writer_open (out_file, agr.dict);
 288       if (output == NULL)
 289         goto error;
 290     }
 291
 292   input = proc_open (ds);
 293   if (!subcase_is_empty (&agr.sort) && !presorted)
 294     {
 295       input = sort_execute (input, &agr.sort);
 296       subcase_clear (&agr.sort);
 297     }
 298
 299   for (grouper = casegrouper_create_vars (input, agr.break_vars,
 300                                           agr.break_var_cnt);
 301        casegrouper_get_next_group (grouper, &group);
 302        casereader_destroy (group))
 303     {
 304       struct casereader *placeholder = NULL;
 305       struct ccase *c = casereader_peek (group, 0);
 306
 307       if (c == NULL)
 308         {
 309           casereader_destroy (group);
 310           continue;
 311         }
 312
 313       initialize_aggregate_info (&agr);
 314
 315       if ( agr.add_variables )
 316         placeholder = casereader_clone (group);
 317
 318       {
 319         struct ccase *cg;
 320         for (; (cg = casereader_read (group)) != NULL; case_unref (cg))
 321           accumulate_aggregate_info (&agr, cg);
 322       }
 323
 324
 325       if  (agr.add_variables)
 326         {
 327           struct ccase *cg;
 328           for (; (cg = casereader_read (placeholder)) != NULL; case_unref (cg))
 329             dump_aggregate_info (&agr, output, cg);
 330
 331           casereader_destroy (placeholder);
 332         }
 333       else
 334         {
 335           dump_aggregate_info (&agr, output, c);
 336         }
 337       case_unref (c);
 338     }
 339   if (!casegrouper_destroy (grouper))
 340     goto error;
 341
 342   if (!proc_commit (ds))
 343     {
 344       input = NULL;
 345       goto error;
 346     }
 347   input = NULL;
 348
 349   if (out_file == NULL)
 350     {
 351       struct casereader *next_input = casewriter_make_reader (output);
 352       if (next_input == NULL)
 353         goto error;
 354
 355       dataset_set_dict (ds, agr.dict);
 356       dataset_set_source (ds, next_input);
 357       agr.dict = NULL;
 358     }
 359   else
 360     {
 361       ok = casewriter_destroy (output);
 362       output = NULL;
 363       if (!ok)
 364         goto error;
 365     }
 366
 367   agr_destroy (&agr);
 368   fh_unref (out_file);
 369   return CMD_SUCCESS;
 370
 371 error:
 372   if (input != NULL)
 373     proc_commit (ds);
 374   casewriter_destroy (output);
 375   agr_destroy (&agr);
 376   fh_unref (out_file);
 377   return CMD_CASCADING_FAILURE;
 378 }
 379
 380 /* Parse all the aggregate functions. */
 381 static bool
 382 parse_aggregate_functions (struct lexer *lexer, const struct dictionary *dict,
 383                            struct agr_proc *agr)
 384 {
 385   struct agr_var *tail; /* Tail of linked list starting at agr->vars. */
 386
 387   /* Parse everything. */
 388   tail = NULL;
 389   for (;;)
 390     {
 391       char **dest;
 392       char **dest_label;
 393       size_t n_dest;
 394       struct string function_name;
 395
 396       enum mv_class exclude;
 397       const struct agr_func *function;
 398       int func_index;
 399
 400       union agr_argument arg[2];
 401
 402       const struct variable **src;
 403       size_t n_src;
 404
 405       size_t i;
 406
 407       dest = NULL;
 408       dest_label = NULL;
 409       n_dest = 0;
 410       src = NULL;
 411       function = NULL;
 412       n_src = 0;
 413       arg[0].c = NULL;
 414       arg[1].c = NULL;
 415       ds_init_empty (&function_name);
 416
 417       /* Parse the list of target variables. */
 418       while (!lex_match (lexer, T_EQUALS))
 419         {
 420           size_t n_dest_prev = n_dest;
 421
 422           if (!parse_DATA_LIST_vars (lexer, dict, &dest, &n_dest,
 423                                      (PV_APPEND | PV_SINGLE | PV_NO_SCRATCH
 424                                       | PV_NO_DUPLICATE)))
 425             goto error;
 426
 427           /* Assign empty labels. */
 428           {
 429             int j;
 430
 431             dest_label = xnrealloc (dest_label, n_dest, sizeof *dest_label);
 432             for (j = n_dest_prev; j < n_dest; j++)
 433               dest_label[j] = NULL;
 434           }
 435
 436
 437
 438           if (lex_is_string (lexer))
 439             {
 440               dest_label[n_dest - 1] = xstrdup (lex_tokcstr (lexer));
 441               lex_get (lexer);
 442             }
 443         }
 444
 445       /* Get the name of the aggregation function. */
 446       if (lex_token (lexer) != T_ID)
 447         {
 448           lex_error (lexer, _("expecting aggregation function"));
 449           goto error;
 450         }
 451
 452       ds_assign_substring (&function_name, lex_tokss (lexer));
 453       exclude = ds_chomp_byte (&function_name, '.') ? MV_SYSTEM : MV_ANY;
 454
 455       for (function = agr_func_tab; function->name; function++)
 456         if (!c_strcasecmp (function->name, ds_cstr (&function_name)))
 457           break;
 458       if (NULL == function->name)
 459         {
 460           msg (SE, _("Unknown aggregation function %s."),
 461                ds_cstr (&function_name));
 462           goto error;
 463         }
 464       ds_destroy (&function_name);
 465       func_index = function - agr_func_tab;
 466       lex_get (lexer);
 467
 468       /* Check for leading lparen. */
 469       if (!lex_match (lexer, T_LPAREN))
 470         {
 471           if (function->src_vars == AGR_SV_YES)
 472             {
 473               lex_force_match (lexer, T_LPAREN);
 474               goto error;
 475             }
 476         }
 477       else
 478         {
 479           /* Parse list of source variables. */
 480           {
 481             int pv_opts = PV_NO_SCRATCH;
 482
 483             if (func_index == SUM || func_index == MEAN || func_index == SD)
 484               pv_opts |= PV_NUMERIC;
 485             else if (function->n_args)
 486               pv_opts |= PV_SAME_TYPE;
 487
 488             if (!parse_variables_const (lexer, dict, &src, &n_src, pv_opts))
 489               goto error;
 490           }
 491
 492           /* Parse function arguments, for those functions that
 493              require arguments. */
 494           if (function->n_args != 0)
 495             for (i = 0; i < function->n_args; i++)
 496               {
 497                 int type;
 498
 499                 lex_match (lexer, T_COMMA);
 500                 if (lex_is_string (lexer))
 501                   {
 502                     arg[i].c = recode_string (dict_get_encoding (agr->dict),
 503                                               "UTF-8", lex_tokcstr (lexer),
 504                                               -1);
 505                     type = VAL_STRING;
 506                   }
 507                 else if (lex_is_number (lexer))
 508                   {
 509                     arg[i].f = lex_tokval (lexer);
 510                     type = VAL_NUMERIC;
 511                   }
 512                 else
 513                   {
 514                     msg (SE, _("Missing argument %zu to %s."),
 515                          i + 1, function->name);
 516                     goto error;
 517                   }
 518
 519                 lex_get (lexer);
 520
 521                 if (type != var_get_type (src[0]))
 522                   {
 523                     msg (SE, _("Arguments to %s must be of same type as "
 524                                "source variables."),
 525                          function->name);
 526                     goto error;
 527                   }
 528               }
 529
 530           /* Trailing rparen. */
 531           if (!lex_force_match (lexer, T_RPAREN))
 532             goto error;
 533
 534           /* Now check that the number of source variables match
 535              the number of target variables.  If we check earlier
 536              than this, the user can get very misleading error
 537              message, i.e. `AGGREGATE x=SUM(y t).' will get this
 538              error message when a proper message would be more
 539              like `unknown variable t'. */
 540           if (n_src != n_dest)
 541             {
 542               msg (SE, _("Number of source variables (%zu) does not match "
 543                          "number of target variables (%zu)."),
 544                     n_src, n_dest);
 545               goto error;
 546             }
 547
 548           if ((func_index == PIN || func_index == POUT
 549               || func_index == FIN || func_index == FOUT)
 550               && (var_is_numeric (src[0])
 551                   ? arg[0].f > arg[1].f
 552                   : str_compare_rpad (arg[0].c, arg[1].c) > 0))
 553             {
 554               union agr_argument t = arg[0];
 555               arg[0] = arg[1];
 556               arg[1] = t;
 557
 558               msg (SW, _("The value arguments passed to the %s function "
 559                          "are out-of-order.  They will be treated as if "
 560                          "they had been specified in the correct order."),
 561                    function->name);
 562             }
 563         }
 564
 565       /* Finally add these to the linked list of aggregation
 566          variables. */
 567       for (i = 0; i < n_dest; i++)
 568         {
 569           struct agr_var *v = xzalloc (sizeof *v);
 570
 571           /* Add variable to chain. */
 572           if (agr->agr_vars != NULL)
 573             tail->next = v;
 574           else
 575             agr->agr_vars = v;
 576           tail = v;
 577           tail->next = NULL;
 578           v->moments = NULL;
 579
 580           /* Create the target variable in the aggregate
 581              dictionary. */
 582           {
 583             struct variable *destvar;
 584
 585             v->function = func_index;
 586
 587             if (src)
 588               {
 589                 v->src = src[i];
 590
 591                 if (var_is_alpha (src[i]))
 592                   {
 593                     v->function |= FSTRING;
 594                     v->string = xmalloc (var_get_width (src[i]));
 595                   }
 596
 597                 if (function->alpha_type == VAL_STRING)
 598                   destvar = dict_clone_var_as (agr->dict, v->src, dest[i]);
 599                 else
 600                   {
 601                     assert (var_is_numeric (v->src)
 602                             || function->alpha_type == VAL_NUMERIC);
 603                     destvar = dict_create_var (agr->dict, dest[i], 0);
 604                     if (destvar != NULL)
 605                       {
 606                         struct fmt_spec f;
 607                         if ((func_index == N || func_index == NMISS)
 608                             && dict_get_weight (dict) != NULL)
 609                           f = fmt_for_output (FMT_F, 8, 2);
 610                         else
 611                           f = function->format;
 612                         var_set_both_formats (destvar, &f);
 613                       }
 614                   }
 615               } else {
 616                 struct fmt_spec f;
 617                 v->src = NULL;
 618                 destvar = dict_create_var (agr->dict, dest[i], 0);
 619                 if (destvar != NULL)
 620                   {
 621                     if ((func_index == N || func_index == NMISS)
 622                         && dict_get_weight (dict) != NULL)
 623                       f = fmt_for_output (FMT_F, 8, 2);
 624                     else
 625                       f = function->format;
 626                     var_set_both_formats (destvar, &f);
 627                   }
 628             }
 629
 630             if (!destvar)
 631               {
 632                 msg (SE, _("Variable name %s is not unique within the "
 633                            "aggregate file dictionary, which contains "
 634                            "the aggregate variables and the break "
 635                            "variables."),
 636                      dest[i]);
 637                 goto error;
 638               }
 639
 640             free (dest[i]);
 641             if (dest_label[i])
 642               var_set_label (destvar, dest_label[i], true);
 643
 644             v->dest = destvar;
 645           }
 646
 647           v->exclude = exclude;
 648
 649           if (v->src != NULL)
 650             {
 651               int j;
 652
 653               if (var_is_numeric (v->src))
 654                 for (j = 0; j < function->n_args; j++)
 655                   v->arg[j].f = arg[j].f;
 656               else
 657                 for (j = 0; j < function->n_args; j++)
 658                   v->arg[j].c = xstrdup (arg[j].c);
 659             }
 660         }
 661
 662       if (src != NULL && var_is_alpha (src[0]))
 663         for (i = 0; i < function->n_args; i++)
 664           {
 665             free (arg[i].c);
 666             arg[i].c = NULL;
 667           }
 668
 669       free (src);
 670       free (dest);
 671       free (dest_label);
 672
 673       if (!lex_match (lexer, T_SLASH))
 674         {
 675           if (lex_token (lexer) == T_ENDCMD)
 676             return true;
 677
 678           lex_error (lexer, "expecting end of command");
 679           return false;
 680         }
 681       continue;
 682
 683     error:
 684       ds_destroy (&function_name);
 685       for (i = 0; i < n_dest; i++)
 686         {
 687           free (dest[i]);
 688           free (dest_label[i]);
 689         }
 690       free (dest);
 691       free (dest_label);
 692       free (arg[0].c);
 693       free (arg[1].c);
 694       if (src && n_src && var_is_alpha (src[0]))
 695         for (i = 0; i < function->n_args; i++)
 696           {
 697             free (arg[i].c);
 698             arg[i].c = NULL;
 699           }
 700       free (src);
 701
 702       return false;
 703     }
 704 }
 705
 706 /* Destroys AGR. */
 707 static void
 708 agr_destroy (struct agr_proc *agr)
 709 {
 710   struct agr_var *iter, *next;
 711
 712   subcase_destroy (&agr->sort);
 713   free (agr->break_vars);
 714   for (iter = agr->agr_vars; iter; iter = next)
 715     {
 716       next = iter->next;
 717
 718       if (iter->function & FSTRING)
 719         {
 720           size_t n_args;
 721           size_t i;
 722
 723           n_args = agr_func_tab[iter->function & FUNC].n_args;
 724           for (i = 0; i < n_args; i++)
 725             free (iter->arg[i].c);
 726           free (iter->string);
 727         }
 728       else if (iter->function == SD)
 729         moments1_destroy (iter->moments);
 730
 731       dict_destroy_internal_var (iter->subject);
 732       dict_destroy_internal_var (iter->weight);
 733
 734       free (iter);
 735     }
 736   if (agr->dict != NULL)
 737     dict_destroy (agr->dict);
 738 }
 739 \f
 740 /* Execution. */
 741
 742 /* Accumulates aggregation data from the case INPUT. */
 743 static void
 744 accumulate_aggregate_info (struct agr_proc *agr, const struct ccase *input)
 745 {
 746   struct agr_var *iter;
 747   double weight;
 748   bool bad_warn = true;
 749
 750   weight = dict_get_case_weight (agr->src_dict, input, &bad_warn);
 751
 752   for (iter = agr->agr_vars; iter; iter = iter->next)
 753     if (iter->src)
 754       {
 755         const union value *v = case_data (input, iter->src);
 756         int src_width = var_get_width (iter->src);
 757
 758         if (var_is_value_missing (iter->src, v, iter->exclude))
 759           {
 760             switch (iter->function)
 761               {
 762               case NMISS:
 763               case NMISS | FSTRING:
 764                 iter->dbl[0] += weight;
 765                 break;
 766               case NUMISS:
 767               case NUMISS | FSTRING:
 768                 iter->int1++;
 769                 break;
 770               }
 771             iter->saw_missing = true;
 772             continue;
 773           }
 774
 775         /* This is horrible.  There are too many possibilities. */
 776         switch (iter->function)
 777           {
 778           case SUM:
 779             iter->dbl[0] += v->f * weight;
 780             iter->int1 = 1;
 781             break;
 782           case MEAN:
 783             iter->dbl[0] += v->f * weight;
 784             iter->dbl[1] += weight;
 785             break;
 786           case MEDIAN:
 787             {
 788               double wv ;
 789               struct ccase *cout;
 790
 791               cout = case_create (casewriter_get_proto (iter->writer));
 792
 793               case_data_rw (cout, iter->subject)->f
 794                 = case_data (input, iter->src)->f;
 795
 796               wv = dict_get_case_weight (agr->src_dict, input, NULL);
 797
 798               case_data_rw (cout, iter->weight)->f = wv;
 799
 800               iter->cc += wv;
 801
 802               casewriter_write (iter->writer, cout);
 803             }
 804             break;
 805           case SD:
 806             moments1_add (iter->moments, v->f, weight);
 807             break;
 808           case MAX:
 809             iter->dbl[0] = MAX (iter->dbl[0], v->f);
 810             iter->int1 = 1;
 811             break;
 812           case MAX | FSTRING:
 813             /* Need to do some kind of Unicode collation thingy here */
 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 }