src/aggregate.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21 #include <assert.h>
  22 #include <stdlib.h>
  23 #include "alloc.h"
  24 #include "approx.h"
  25 #include "command.h"
  26 #include "error.h"
  27 #include "file-handle.h"
  28 #include "lexer.h"
  29 #include "misc.h"
  30 #include "settings.h"
  31 #include "sfm.h"
  32 #include "sort.h"
  33 #include "stats.h"
  34 #include "str.h"
  35 #include "var.h"
  36 #include "vfm.h"
  37 #include "vfmP.h"
  38
  39 #include "debug-print.h"
  40
  41 /* Specifies how to make an aggregate variable. */
  42 struct agr_var
  43   {
  44     struct agr_var *next;               /* Next in list. */
  45
  46     /* Collected during parsing. */
  47     struct variable *src;       /* Source variable. */
  48     struct variable *dest;      /* Target variable. */
  49     int function;               /* Function. */
  50     int include_missing;        /* 1=Include user-missing values. */
  51     union value arg[2];         /* Arguments. */
  52
  53     /* Accumulated during AGGREGATE execution. */
  54     double dbl[3];
  55     int int1, int2;
  56     char *string;
  57     int missing;
  58   };
  59
  60 /* Aggregation functions. */
  61 enum
  62   {
  63     NONE, SUM, MEAN, SD, MAX, MIN, PGT, PLT, PIN, POUT, FGT, FLT, FIN,
  64     FOUT, N, NU, NMISS, NUMISS, FIRST, LAST,
  65     N_AGR_FUNCS, N_NO_VARS, NU_NO_VARS,
  66     FUNC = 0x1f, /* Function mask. */
  67     FSTRING = 1<<5, /* String function bit. */
  68     FWEIGHT = 1<<6, /* Weighted function bit. */
  69     FOPTIONS = FSTRING | FWEIGHT /* Function options mask. */
  70   };
  71
  72 /* Attributes of an aggregation function. */
  73 struct agr_func
  74   {
  75     const char *name;           /* Aggregation function name. */
  76     int n_args;                 /* Number of arguments. */
  77     int alpha_type;             /* When given ALPHA arguments, output type. */
  78     struct fmt_spec format;     /* Format spec if alpha_type != ALPHA. */
  79   };
  80
  81 /* Attributes of aggregation functions. */
  82 static struct agr_func agr_func_tab[] =
  83   {
  84     {"<NONE>",  0, -1,      {0, 0, 0}},
  85     {"SUM",     0, -1,      {FMT_F, 8, 2}},
  86     {"MEAN",    0, -1,      {FMT_F, 8, 2}},
  87     {"SD",      0, -1,      {FMT_F, 8, 2}},
  88     {"MAX",     0, ALPHA,   {-1, -1, -1}},
  89     {"MIN",     0, ALPHA,   {-1, -1, -1}},
  90     {"PGT",     1, NUMERIC, {FMT_F, 5, 1}},
  91     {"PLT",     1, NUMERIC, {FMT_F, 5, 1}},
  92     {"PIN",     2, NUMERIC, {FMT_F, 5, 1}},
  93     {"POUT",    2, NUMERIC, {FMT_F, 5, 1}},
  94     {"FGT",     1, NUMERIC, {FMT_F, 5, 3}},
  95     {"FLT",     1, NUMERIC, {FMT_F, 5, 3}},
  96     {"FIN",     2, NUMERIC, {FMT_F, 5, 3}},
  97     {"FOUT",    2, NUMERIC, {FMT_F, 5, 3}},
  98     {"N",       0, NUMERIC, {FMT_F, 7, 0}},
  99     {"NU",      0, NUMERIC, {FMT_F, 7, 0}},
 100     {"NMISS",   0, NUMERIC, {FMT_F, 7, 0}},
 101     {"NUMISS",  0, NUMERIC, {FMT_F, 7, 0}},
 102     {"FIRST",   0, ALPHA,   {-1, -1, -1}},
 103     {"LAST",    0, ALPHA,   {-1, -1, -1}},
 104     {NULL,      0, -1,      {-1, -1, -1}},
 105     {"N",       0, NUMERIC, {FMT_F, 7, 0}},
 106     {"NU",      0, NUMERIC, {FMT_F, 7, 0}},
 107   };
 108
 109 /* Output file, or NULL for the active file. */
 110 static struct file_handle *outfile;
 111
 112 /* Missing value types. */
 113 enum
 114   {
 115     ITEMWISE,           /* Missing values item by item. */
 116     COLUMNWISE          /* Missing values column by column. */
 117   };
 118
 119 /* ITEMWISE or COLUMNWISE. */
 120 static int missing;
 121
 122 /* Aggregate variables. */
 123 static struct agr_var *agr_first, *agr_next;
 124
 125 /* Aggregate dictionary. */
 126 static struct dictionary *agr_dict;
 127
 128 /* Number of cases passed through aggregation. */
 129 static int case_count;
 130
 131 /* Last values of the break variables. */
 132 static union value *prev_case;
 133
 134 /* Buffers for use by the 10x transformation. */
 135 static flt64 *buf64_1xx;
 136 static struct ccase *buf_1xx;
 137
 138 static void initialize_aggregate_info (void);
 139
 140 /* Prototypes. */
 141 static int parse_aggregate_functions (void);
 142 static void free_aggregate_functions (void);
 143 static int aggregate_single_case (struct ccase *input, struct ccase *output);
 144 static int create_sysfile (void);
 145
 146 static int agr_00x_trns_proc (struct trns_header *, struct ccase *);
 147 static void agr_00x_end_func (void);
 148 static int agr_10x_trns_proc (struct trns_header *, struct ccase *);
 149 static void agr_10x_trns_free (struct trns_header *);
 150 static void agr_10x_end_func (void);
 151 static int agr_11x_func (void);
 152
 153 #if DEBUGGING
 154 static void debug_print (int flags);
 155 #endif
 156 \f
 157 /* Parsing. */
 158
 159 /* Parses and executes the AGGREGATE procedure. */
 160 int
 161 cmd_aggregate (void)
 162 {
 163   /* From sort.c. */
 164   int parse_sort_variables (void);
 165
 166   /* Have we seen these subcommands? */
 167   unsigned seen = 0;
 168
 169   outfile = NULL;
 170   missing = ITEMWISE;
 171   v_sort = NULL;
 172   prev_case = NULL;
 173
 174   agr_dict = new_dictionary (1);
 175
 176   lex_match_id ("AGGREGATE");
 177
 178   /* Read most of the subcommands. */
 179   for (;;)
 180     {
 181       lex_match('/');
 182
 183       if (lex_match_id ("OUTFILE"))
 184         {
 185           if (seen & 1)
 186             {
 187               free (v_sort);
 188               free_dictionary (agr_dict);
 189               msg (SE, _("OUTFILE specified multiple times."));
 190               return CMD_FAILURE;
 191             }
 192           seen |= 1;
 193
 194           lex_match ('=');
 195           if (lex_match ('*'))
 196             outfile = NULL;
 197           else
 198             {
 199               outfile = fh_parse_file_handle ();
 200               if (outfile == NULL)
 201                 {
 202                   free (v_sort);
 203                   free_dictionary (agr_dict);
 204                   return CMD_FAILURE;
 205                 }
 206             }
 207         }
 208       else if (lex_match_id ("MISSING"))
 209         {
 210           lex_match ('=');
 211           if (!lex_match_id ("COLUMNWISE"))
 212             {
 213               free (v_sort);
 214               free_dictionary (agr_dict);
 215               lex_error (_("while expecting COLUMNWISE"));
 216               return CMD_FAILURE;
 217             }
 218           missing = COLUMNWISE;
 219         }
 220       else if (lex_match_id ("DOCUMENT"))
 221         seen |= 2;
 222       else if (lex_match_id ("PRESORTED"))
 223         seen |= 4;
 224       else if (lex_match_id ("BREAK"))
 225         {
 226           if (seen & 8)
 227             {
 228               free (v_sort);
 229               free_dictionary (agr_dict);
 230               msg (SE, _("BREAK specified multiple times."));
 231               return CMD_FAILURE;
 232             }
 233           seen |= 8;
 234
 235           lex_match ('=');
 236           if (!parse_sort_variables ())
 237             {
 238               free_dictionary (agr_dict);
 239               return CMD_FAILURE;
 240             }
 241
 242           {
 243             int i;
 244
 245             for (i = 0; i < nv_sort; i++)
 246               {
 247                 struct variable *v;
 248
 249                 v = dup_variable (agr_dict, v_sort[i], v_sort[i]->name);
 250                 assert (v != NULL);
 251               }
 252           }
 253         }
 254       else break;
 255     }
 256
 257   /* Check for proper syntax. */
 258   if (!(seen & 8))
 259     msg (SW, _("BREAK subcommand not specified."));
 260
 261   /* Read in the aggregate functions. */
 262   if (!parse_aggregate_functions ())
 263     {
 264       free_aggregate_functions ();
 265       free (v_sort);
 266       return CMD_FAILURE;
 267     }
 268
 269   /* Delete documents. */
 270   if (!(seen & 2))
 271     {
 272       free (agr_dict->documents);
 273       agr_dict->documents = NULL;
 274       agr_dict->n_documents = 0;
 275     }
 276
 277   /* Cancel SPLIT FILE. */
 278   default_dict.n_splits = 0;
 279   free (default_dict.splits);
 280   default_dict.splits = NULL;
 281
 282 #if DEBUGGING
 283   debug_print (seen);
 284 #endif
 285
 286   /* Initialize. */
 287   case_count = 0;
 288   initialize_aggregate_info ();
 289
 290   /* How to implement all this... There are three important variables:
 291      whether output is going to the active file (0) or a separate file
 292      (1); whether the input data is presorted (0) or needs sorting
 293      (1); whether there is a temporary transformation (1) or not (0).
 294      The eight cases are as follows:
 295
 296      000 (0): Pass it through an aggregate transformation that
 297      modifies the data.
 298
 299      001 (1): Cancel the temporary transformation and handle as 000.
 300
 301      010 (2): Set up a SORT CASES and aggregate the output, writing
 302      the results to the active file.
 303
 304      011 (3): Cancel the temporary transformation and handle as 010.
 305
 306      100 (4): Pass it through an aggregate transformation that doesn't
 307      modify the data but merely writes it to the output file.
 308
 309      101 (5): Handled as 100.
 310
 311      110 (6): Set up a SORT CASES and capture the output, aggregate
 312      it, write it to the output file without modifying the active
 313      file.
 314
 315      111 (7): Handled as 110. */
 316
 317   {
 318     unsigned type = 0;
 319
 320     if (outfile != NULL)
 321       type |= 4;
 322     if (nv_sort != 0 && (seen & 4) == 0)
 323       type |= 2;
 324     if (temporary)
 325       type |= 1;
 326
 327     switch (type)
 328       {
 329       case 3:
 330         cancel_temporary ();
 331         /* fall through */
 332       case 2:
 333         sort_cases (0);
 334         goto case0;
 335
 336       case 1:
 337         cancel_temporary ();
 338         /* fall through */
 339       case 0:
 340       case0:
 341         {
 342           struct trns_header *t = xmalloc (sizeof *t);
 343           t->proc = agr_00x_trns_proc;
 344           t->free = NULL;
 345           add_transformation (t);
 346
 347           temporary = 2;
 348           temp_dict = agr_dict;
 349           temp_trns = n_trns;
 350
 351           agr_dict = NULL;
 352
 353           procedure (NULL, NULL, agr_00x_end_func);
 354           break;
 355         }
 356
 357       case 4:
 358       case 5:
 359         {
 360           if (!create_sysfile ())
 361             goto lossage;
 362
 363           {
 364             struct trns_header *t = xmalloc (sizeof *t);
 365             t->proc = agr_10x_trns_proc;
 366             t->free = agr_10x_trns_free;
 367             add_transformation (t);
 368
 369             procedure (NULL, NULL, agr_10x_end_func);
 370           }
 371
 372           break;
 373         }
 374
 375       case 6:
 376       case 7:
 377         sort_cases (1);
 378
 379         if (!create_sysfile ())
 380           goto lossage;
 381         read_sort_output (agr_11x_func);
 382
 383         {
 384           struct ccase *save_temp_case = temp_case;
 385           temp_case = NULL;
 386           agr_11x_func ();
 387           temp_case = save_temp_case;
 388         }
 389
 390         break;
 391
 392       default:
 393         assert (0);
 394       }
 395   }
 396
 397   free (buf64_1xx);
 398   free (buf_1xx);
 399
 400   /* Clean up. */
 401   free (v_sort);
 402   free_aggregate_functions ();
 403   free (prev_case);
 404
 405   return CMD_SUCCESS;
 406
 407 lossage:
 408   /* Clean up. */
 409   free (v_sort);
 410   free_aggregate_functions ();
 411   free (prev_case);
 412
 413   return CMD_FAILURE;
 414 }
 415
 416 /* Create a system file for use in aggregation to an external file,
 417    and allocate temporary buffers for writing out cases. */
 418 static int
 419 create_sysfile (void)
 420 {
 421   struct sfm_write_info w;
 422   w.h = outfile;
 423   w.dict = agr_dict;
 424   w.compress = set_scompression;
 425   if (!sfm_write_dictionary (&w))
 426     {
 427       free_aggregate_functions ();
 428       free (v_sort);
 429       free_dictionary (agr_dict);
 430       return 0;
 431     }
 432
 433   buf64_1xx = xmalloc (sizeof *buf64_1xx * w.case_size);
 434   buf_1xx = xmalloc (sizeof (struct ccase) + sizeof (union value) * (agr_dict->nval - 1));
 435
 436   return 1;
 437 }
 438
 439 /* Parse all the aggregate functions. */
 440 static int
 441 parse_aggregate_functions (void)
 442 {
 443   agr_first = agr_next = NULL;
 444
 445   /* Anticipate weighting for optimization later. */
 446   update_weighting (&default_dict);
 447
 448   /* Parse everything. */
 449   for (;;)
 450     {
 451       char **dest;
 452       char **dest_label;
 453       int n_dest;
 454
 455       int include_missing;
 456       struct agr_func *function;
 457       int func_index;
 458
 459       union value arg[2];
 460
 461       struct variable **src;
 462       int n_src;
 463
 464       int i;
 465
 466       dest = NULL;
 467       dest_label = NULL;
 468       n_dest = 0;
 469       src = NULL;
 470       n_src = 0;
 471       arg[0].c = NULL;
 472       arg[1].c = NULL;
 473
 474       /* Parse the list of target variables. */
 475       while (!lex_match ('='))
 476         {
 477           int n_dest_prev = n_dest;
 478
 479           if (!parse_DATA_LIST_vars (&dest, &n_dest, PV_APPEND | PV_SINGLE | PV_NO_SCRATCH))
 480             goto lossage;
 481
 482           /* Assign empty labels. */
 483           {
 484             int j;
 485
 486             dest_label = xrealloc (dest_label, sizeof *dest_label * n_dest);
 487             for (j = n_dest_prev; j < n_dest; j++)
 488               dest_label[j] = NULL;
 489           }
 490
 491           if (token == T_STRING)
 492             {
 493               ds_truncate (&tokstr, 120);
 494               dest_label[n_dest - 1] = xstrdup (ds_value (&tokstr));
 495               lex_get ();
 496             }
 497         }
 498
 499       /* Get the name of the aggregation function. */
 500       if (token != T_ID)
 501         {
 502           lex_error (_("expecting aggregation function"));
 503           goto lossage;
 504         }
 505
 506       include_missing = 0;
 507       if (tokid[strlen (tokid) - 1] == '.')
 508         {
 509           include_missing = 1;
 510           tokid[strlen (tokid) - 1] = 0;
 511         }
 512
 513       for (function = agr_func_tab; function->name; function++)
 514         if (!strcmp (function->name, tokid))
 515           break;
 516       if (NULL == function->name)
 517         {
 518           msg (SE, _("Unknown aggregation function %s."), tokid);
 519           goto lossage;
 520         }
 521       func_index = function - agr_func_tab;
 522       lex_get ();
 523
 524       /* Check for leading lparen. */
 525       if (!lex_match ('('))
 526         {
 527           if (func_index == N)
 528             func_index = N_NO_VARS;
 529           else if (func_index == NU)
 530             func_index = NU_NO_VARS;
 531           else
 532             {
 533               lex_error (_("expecting `('"));
 534               goto lossage;
 535             }
 536         } else {
 537           /* Parse list of source variables. */
 538           {
 539             int pv_opts = PV_NO_SCRATCH;
 540
 541             if (func_index == SUM || func_index == MEAN || func_index == SD)
 542               pv_opts |= PV_NUMERIC;
 543             else if (function->n_args)
 544               pv_opts |= PV_SAME_TYPE;
 545
 546             if (!parse_variables (&default_dict, &src, &n_src, pv_opts))
 547               goto lossage;
 548           }
 549
 550           /* Parse function arguments, for those functions that
 551              require arguments. */
 552           if (function->n_args != 0)
 553             for (i = 0; i < function->n_args; i++)
 554               {
 555                 int type;
 556
 557                 lex_match (',');
 558                 if (token == T_STRING)
 559                   {
 560                     arg[i].c = xstrdup (ds_value (&tokstr));
 561                     type = ALPHA;
 562                   }
 563                 else if (token == T_NUM)
 564                   {
 565                     arg[i].f = tokval;
 566                     type = NUMERIC;
 567                   } else {
 568                     msg (SE, _("Missing argument %d to %s."), i + 1, function->name);
 569                     goto lossage;
 570                   }
 571
 572                 lex_get ();
 573
 574                 if (type != src[0]->type)
 575                   {
 576                     msg (SE, _("Arguments to %s must be of same type as "
 577                                "source variables."),
 578                          function->name);
 579                     goto lossage;
 580                   }
 581               }
 582
 583           /* Trailing rparen. */
 584           if (!lex_match(')'))
 585             {
 586               lex_error (_("expecting `)'"));
 587               goto lossage;
 588             }
 589
 590           /* Now check that the number of source variables match the
 591              number of target variables.  Do this here because if we
 592              do it earlier then the user can get very misleading error
 593              messages; i.e., `AGGREGATE x=SUM(y t).' will get this
 594              error message when a proper message would be more like
 595              `unknown variable t'. */
 596           if (n_src != n_dest)
 597             {
 598               msg (SE, _("Number of source variables (%d) does not match "
 599                          "number of target variables (%d)."),
 600                    n_src, n_dest);
 601               goto lossage;
 602             }
 603         }
 604
 605       /* Finally add these to the linked list of aggregation
 606          variables. */
 607       for (i = 0; i < n_dest; i++)
 608         {
 609           struct agr_var *v = xmalloc (sizeof *v);
 610
 611           /* Add variable to chain. */
 612           if (agr_first)
 613             agr_next = agr_next->next = v;
 614           else
 615             agr_first = agr_next = v;
 616           agr_next->next = NULL;
 617
 618           /* Create the target variable in the aggregate
 619              dictionary. */
 620           {
 621             struct variable *destvar;
 622
 623             agr_next->function = func_index;
 624
 625             if (src)
 626               {
 627                 int output_type;
 628
 629                 agr_next->src = src[i];
 630
 631                 if (src[i]->type == ALPHA)
 632                   {
 633                     agr_next->function |= FSTRING;
 634                     agr_next->string = xmalloc (src[i]->width);
 635                   }
 636
 637                 if (default_dict.weight_index != -1)
 638                   agr_next->function |= FWEIGHT;
 639
 640                 if (agr_next->src->type == NUMERIC)
 641                   output_type = NUMERIC;
 642                 else
 643                   output_type = function->alpha_type;
 644
 645                 if (function->alpha_type == ALPHA)
 646                   destvar = dup_variable (agr_dict, agr_next->src, dest[i]);
 647                 else
 648                   {
 649                     destvar = create_variable (agr_dict, dest[i], output_type,
 650                                                agr_next->src->width);
 651                     if (output_type == NUMERIC)
 652                       destvar->print = destvar->write = function->format;
 653                     if (output_type == NUMERIC && default_dict.weight_index != -1
 654                         && (func_index == N || func_index == N_NO_VARS
 655                             || func_index == NU || func_index == NU_NO_VARS))
 656                       {
 657                         struct fmt_spec f = {FMT_F, 8, 2};
 658
 659                         destvar->print = destvar->write = f;
 660                       }
 661                   }
 662               } else {
 663                 agr_next->src = NULL;
 664                 destvar = create_variable (agr_dict, dest[i], NUMERIC, 0);
 665               }
 666
 667             if (!destvar)
 668               {
 669                 msg (SE, _("Variable name %s is not unique within the "
 670                            "aggregate file dictionary, which contains "
 671                            "the aggregate variables and the break "
 672                            "variables."),
 673                      dest[i]);
 674                 free (dest[i]);
 675                 goto lossage;
 676               }
 677
 678             free (dest[i]);
 679             if (dest_label[i])
 680               {
 681                 destvar->label = dest_label[i];
 682                 dest_label[i] = NULL;
 683               }
 684             else if (function->alpha_type == ALPHA)
 685               destvar->print = destvar->write = function->format;
 686
 687             agr_next->dest = destvar;
 688           }
 689
 690           agr_next->include_missing = include_missing;
 691
 692           if (agr_next->src != NULL)
 693             {
 694               int j;
 695
 696               if (agr_next->src->type == NUMERIC)
 697                 for (j = 0; j < function->n_args; j++)
 698                   agr_next->arg[j].f = arg[j].f;
 699               else
 700                 for (j = 0; j < function->n_args; j++)
 701                   agr_next->arg[j].c = xstrdup (arg[j].c);
 702             }
 703         }
 704
 705       if (src != NULL && src[0]->type == ALPHA)
 706         for (i = 0; i < function->n_args; i++)
 707           {
 708             free (arg[i].c);
 709             arg[i].c = NULL;
 710           }
 711
 712       free (src);
 713       free (dest);
 714       free (dest_label);
 715
 716       if (!lex_match ('/'))
 717         {
 718           if (token == '.')
 719             return 1;
 720
 721           lex_error ("expecting end of command");
 722           return 0;
 723         }
 724       continue;
 725
 726     lossage:
 727       for (i = 0; i < n_dest; i++)
 728         {
 729           free (dest[i]);
 730           free (dest_label[i]);
 731         }
 732       free (dest);
 733       free (dest_label);
 734       free (arg[0].c);
 735       free (arg[1].c);
 736       if (src && n_src && src[0]->type == ALPHA)
 737         for (i = 0; i < function->n_args; i++)
 738           {
 739             free(arg[i].c);
 740             arg[i].c = NULL;
 741           }
 742       free (src);
 743
 744       return 0;
 745     }
 746 }
 747
 748 /* Frees all the state for the AGGREGATE procedure. */
 749 static void
 750 free_aggregate_functions (void)
 751 {
 752   struct agr_var *iter, *next;
 753
 754   if (agr_dict)
 755     free_dictionary (agr_dict);
 756   for (iter = agr_first; iter; iter = next)
 757     {
 758       next = iter->next;
 759
 760       if (iter->function & FSTRING)
 761         {
 762           int n_args;
 763           int i;
 764
 765           n_args = agr_func_tab[iter->function & FUNC].n_args;
 766           for (i = 0; i < n_args; i++)
 767             free (iter->arg[i].c);
 768           free (iter->string);
 769         }
 770       free (iter);
 771     }
 772 }
 773 \f
 774 /* Execution. */
 775
 776 static void accumulate_aggregate_info (struct ccase *input);
 777 static void dump_aggregate_info (struct ccase *output);
 778
 779 /* Processes a single case INPUT for aggregation.  If output is
 780    warranted, it is written to case OUTPUT, which may be (but need not
 781    be) an alias to INPUT.  Returns -1 when output is performed, -2
 782    otherwise. */
 783 /* The code in this function has an eerie similarity to
 784    vfm.c:SPLIT_FILE_procfunc()... */
 785 static int
 786 aggregate_single_case (struct ccase *input, struct ccase *output)
 787 {
 788   /* The first case always begins a new break group.  We also need to
 789      preserve the values of the case for later comparison. */
 790   if (case_count++ == 0)
 791     {
 792       int n_elem = 0;
 793
 794       {
 795         int i;
 796
 797         for (i = 0; i < nv_sort; i++)
 798           n_elem += v_sort[i]->nv;
 799       }
 800
 801       prev_case = xmalloc (sizeof *prev_case * n_elem);
 802
 803       /* Copy INPUT into prev_case. */
 804       {
 805         union value *iter = prev_case;
 806         int i;
 807
 808         for (i = 0; i < nv_sort; i++)
 809           {
 810             struct variable *v = v_sort[i];
 811
 812             if (v->type == NUMERIC)
 813               (iter++)->f = input->data[v->fv].f;
 814             else
 815               {
 816                 memcpy (iter->s, input->data[v->fv].s, v->width);
 817                 iter += v->nv;
 818               }
 819           }
 820       }
 821
 822       accumulate_aggregate_info (input);
 823
 824       return -2;
 825     }
 826
 827   /* Compare the value of each break variable to the values on the
 828      previous case. */
 829   {
 830     union value *iter = prev_case;
 831     int i;
 832
 833     for (i = 0; i < nv_sort; i++)
 834       {
 835         struct variable *v = v_sort[i];
 836
 837         switch (v->type)
 838           {
 839           case NUMERIC:
 840             if (approx_ne (input->data[v->fv].f, iter->f))
 841               goto not_equal;
 842             iter++;
 843             break;
 844           case ALPHA:
 845             if (memcmp (input->data[v->fv].s, iter->s, v->width))
 846               goto not_equal;
 847             iter += v->nv;
 848             break;
 849           default:
 850             assert (0);
 851           }
 852       }
 853   }
 854
 855   accumulate_aggregate_info (input);
 856
 857   return -2;
 858
 859 not_equal:
 860   /* The values of the break variable are different from the values on
 861      the previous case.  That means that it's time to dump aggregate
 862      info. */
 863   dump_aggregate_info (output);
 864   initialize_aggregate_info ();
 865   accumulate_aggregate_info (input);
 866
 867   /* Copy INPUT into prev_case. */
 868   {
 869     union value *iter = prev_case;
 870     int i;
 871
 872     for (i = 0; i < nv_sort; i++)
 873       {
 874         struct variable *v = v_sort[i];
 875
 876         if (v->type == NUMERIC)
 877           (iter++)->f = input->data[v->fv].f;
 878         else
 879           {
 880             memcpy (iter->s, input->data[v->fv].s, v->width);
 881             iter += v->nv;
 882           }
 883       }
 884   }
 885
 886   return -1;
 887 }
 888
 889 /* Accumulates aggregation data from the case INPUT. */
 890 static void
 891 accumulate_aggregate_info (struct ccase *input)
 892 {
 893   struct agr_var *iter;
 894
 895 #define WEIGHT (input->data[default_dict.weight_index].f)
 896
 897   for (iter = agr_first; iter; iter = iter->next)
 898     if (iter->src)
 899       {
 900         union value *v = &input->data[iter->src->fv];
 901
 902         if ((!iter->include_missing && is_missing (v, iter->src))
 903             || (iter->include_missing && iter->src->type == NUMERIC
 904                 && v->f == SYSMIS))
 905           {
 906             switch (iter->function)
 907               {
 908               case NMISS | FWEIGHT:
 909                 iter->dbl[0] += WEIGHT;
 910                 break;
 911               case NMISS:
 912               case NUMISS:
 913               case NUMISS | FWEIGHT:
 914                 iter->int1++;
 915                 break;
 916               }
 917             iter->missing = 1;
 918             continue;
 919           }
 920
 921         /* This is horrible.  There are too many possibilities. */
 922         switch (iter->function)
 923           {
 924           case SUM:
 925           case SUM | FWEIGHT:
 926             iter->dbl[0] += v->f;
 927             break;
 928           case MEAN:
 929             iter->dbl[0] += v->f;
 930             iter->int1++;
 931             break;
 932           case MEAN | FWEIGHT:
 933             {
 934               double w = WEIGHT;
 935               iter->dbl[0] += v->f * w;
 936               iter->dbl[1] += w;
 937               break;
 938             }
 939           case SD:
 940             iter->dbl[0] += v->f;
 941             iter->dbl[1] += v->f * v->f;
 942             iter->int1++;
 943             break;
 944           case SD | FWEIGHT:
 945             {
 946               double w = WEIGHT;
 947               double product = v->f * w;
 948               iter->dbl[0] += product;
 949               iter->dbl[1] += product * v->f;
 950               iter->dbl[2] += w;
 951               break;
 952             }
 953           case MAX:
 954           case MAX | FWEIGHT:
 955             iter->dbl[0] = max (iter->dbl[0], v->f);
 956             iter->int1 = 1;
 957             break;
 958           case MAX | FSTRING:
 959           case MAX | FSTRING | FWEIGHT:
 960             if (memcmp (iter->string, v->s, iter->src->width) < 0)
 961               memcpy (iter->string, v->s, iter->src->width);
 962             iter->int1 = 1;
 963             break;
 964           case MIN:
 965           case MIN | FWEIGHT:
 966             iter->dbl[0] = min (iter->dbl[0], v->f);
 967             iter->int1 = 1;
 968             break;
 969           case MIN | FSTRING:
 970           case MIN | FSTRING | FWEIGHT:
 971             if (memcmp (iter->string, v->s, iter->src->width) > 0)
 972               memcpy (iter->string, v->s, iter->src->width);
 973             iter->int1 = 1;
 974             break;
 975           case FGT:
 976           case PGT:
 977             if (approx_gt (v->f, iter->arg[0].f))
 978               iter->int1++;
 979             iter->int2++;
 980             break;
 981           case FGT | FWEIGHT:
 982           case PGT | FWEIGHT:
 983             {
 984               double w = WEIGHT;
 985               if (approx_gt (v->f, iter->arg[0].f))
 986                 iter->dbl[0] += w;
 987               iter->dbl[1] += w;
 988               break;
 989             }
 990           case FGT | FSTRING:
 991           case PGT | FSTRING:
 992             if (memcmp (iter->arg[0].c, v->s, iter->src->width) < 0)
 993               iter->int1++;
 994             iter->int2++;
 995             break;
 996           case FGT | FSTRING | FWEIGHT:
 997           case PGT | FSTRING | FWEIGHT:
 998             {
 999               double w = WEIGHT;
1000               if (memcmp (iter->arg[0].c, v->s, iter->src->width) < 0)
1001                 iter->dbl[0] += w;
1002               iter->dbl[1] += w;
1003               break;
1004             }
1005           case FLT:
1006           case PLT:
1007             if (approx_lt (v->f, iter->arg[0].f))
1008               iter->int1++;
1009             iter->int2++;
1010             break;
1011           case FLT | FWEIGHT:
1012           case PLT | FWEIGHT:
1013             {
1014               double w = WEIGHT;
1015               if (approx_lt (v->f, iter->arg[0].f))
1016                 iter->dbl[0] += w;
1017               iter->dbl[1] += w;
1018               break;
1019             }
1020           case FLT | FSTRING:
1021           case PLT | FSTRING:
1022             if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0)
1023               iter->int1++;
1024             iter->int2++;
1025             break;
1026           case FLT | FSTRING | FWEIGHT:
1027           case PLT | FSTRING | FWEIGHT:
1028             {
1029               double w = WEIGHT;
1030               if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0)
1031                 iter->dbl[0] += w;
1032               iter->dbl[1] += w;
1033               break;
1034             }
1035           case FIN:
1036           case PIN:
1037             if (approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
1038               iter->int1++;
1039             iter->int2++;
1040             break;
1041           case FIN | FWEIGHT:
1042           case PIN | FWEIGHT:
1043             {
1044               double w = WEIGHT;
1045               if (approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
1046                 iter->dbl[0] += w;
1047               iter->dbl[1] += w;
1048               break;
1049             }
1050           case FIN | FSTRING:
1051           case PIN | FSTRING:
1052             if (memcmp (iter->arg[0].c, v->s, iter->src->width) <= 0
1053                 && memcmp (iter->arg[1].c, v->s, iter->src->width) >= 0)
1054               iter->int1++;
1055             iter->int2++;
1056             break;
1057           case FIN | FSTRING | FWEIGHT:
1058           case PIN | FSTRING | FWEIGHT:
1059             {
1060               double w = WEIGHT;
1061               if (memcmp (iter->arg[0].c, v->s, iter->src->width) <= 0
1062                   && memcmp (iter->arg[1].c, v->s, iter->src->width) >= 0)
1063                 iter->dbl[0] += w;
1064               iter->dbl[1] += w;
1065               break;
1066             }
1067           case FOUT:
1068           case POUT:
1069             if (!approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
1070               iter->int1++;
1071             iter->int2++;
1072             break;
1073           case FOUT | FWEIGHT:
1074           case POUT | FWEIGHT:
1075             {
1076               double w = WEIGHT;
1077               if (!approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
1078                 iter->dbl[0] += w;
1079               iter->dbl[1] += w;
1080               break;
1081             }
1082           case FOUT | FSTRING:
1083           case POUT | FSTRING:
1084             if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0
1085                 && memcmp (iter->arg[1].c, v->s, iter->src->width) < 0)
1086               iter->int1++;
1087             iter->int2++;
1088             break;
1089           case FOUT | FSTRING | FWEIGHT:
1090           case POUT | FSTRING | FWEIGHT:
1091             {
1092               double w = WEIGHT;
1093               if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0
1094                   && memcmp (iter->arg[1].c, v->s, iter->src->width) < 0)
1095                 iter->dbl[0] += w;
1096               iter->dbl[1] += w;
1097               break;
1098             }
1099           case N | FWEIGHT:
1100             iter->dbl[0] += WEIGHT;
1101             break;
1102           case N:
1103           case NU:
1104           case NU | FWEIGHT:
1105             iter->int1++;
1106             break;
1107           case FIRST:
1108           case FIRST | FWEIGHT:
1109             if (iter->int1 == 0)
1110               {
1111                 iter->dbl[0] = v->f;
1112                 iter->int1 = 1;
1113               }
1114             break;
1115           case FIRST | FSTRING:
1116           case FIRST | FSTRING | FWEIGHT:
1117             if (iter->int1 == 0)
1118               {
1119                 memcpy (iter->string, v->s, iter->src->width);
1120                 iter->int1 = 1;
1121               }
1122             break;
1123           case LAST:
1124           case LAST | FWEIGHT:
1125             iter->dbl[0] = v->f;
1126             iter->int1 = 1;
1127             break;
1128           case LAST | FSTRING:
1129           case LAST | FSTRING | FWEIGHT:
1130             memcpy (iter->string, v->s, iter->src->width);
1131             iter->int1 = 1;
1132             break;
1133           default:
1134             assert (0);
1135           }
1136     } else {
1137       switch (iter->function)
1138         {
1139         case N_NO_VARS | FWEIGHT:
1140           iter->dbl[0] += WEIGHT;
1141           break;
1142         case N_NO_VARS:
1143         case NU_NO_VARS:
1144         case NU_NO_VARS | FWEIGHT:
1145           iter->int1++;
1146           break;
1147         default:
1148           assert (0);
1149         }
1150     }
1151 }
1152
1153 /* We've come to a record that differs from the previous in one or
1154    more of the break variables.  Make an output record from the
1155    accumulated statistics in the OUTPUT case. */
1156 static void
1157 dump_aggregate_info (struct ccase *output)
1158 {
1159   debug_printf (("(dumping "));
1160
1161   {
1162     int n_elem = 0;
1163
1164     {
1165       int i;
1166
1167       for (i = 0; i < nv_sort; i++)
1168         n_elem += v_sort[i]->nv;
1169     }
1170     debug_printf (("n_elem=%d:", n_elem));
1171     memcpy (output->data, prev_case, sizeof (union value) * n_elem);
1172   }
1173
1174   {
1175     struct agr_var *i;
1176
1177     for (i = agr_first; i; i = i->next)
1178       {
1179         union value *v = &output->data[i->dest->fv];
1180
1181         debug_printf ((" %d,%d", i->dest->fv, i->dest->nv));
1182
1183         if (missing == COLUMNWISE && i->missing != 0
1184             && (i->function & FUNC) != N && (i->function & FUNC) != NU
1185             && (i->function & FUNC) != NMISS && (i->function & FUNC) != NUMISS)
1186           {
1187             if (i->function & FSTRING)
1188               memset (v->s, ' ', i->dest->width);
1189             else
1190               v->f = SYSMIS;
1191             continue;
1192           }
1193
1194         switch (i->function)
1195           {
1196           case SUM:
1197           case SUM | FWEIGHT:
1198             v->f = i->dbl[0];
1199             break;
1200           case MEAN:
1201             v->f = i->int1 ? i->dbl[0] / i->int1 : SYSMIS;
1202             break;
1203           case MEAN | FWEIGHT:
1204             v->f = i->dbl[1] != 0.0 ? i->dbl[0] / i->dbl[1] : SYSMIS;
1205             break;
1206           case SD:
1207             v->f = ((i->int1 > 1)
1208                     ? calc_stddev (calc_variance (i->dbl, i->int1))
1209                     : SYSMIS);
1210             break;
1211           case SD | FWEIGHT:
1212             v->f = ((i->dbl[2] > 1.0)
1213                     ? calc_stddev (calc_variance (i->dbl, i->dbl[2]))
1214                     : SYSMIS);
1215             break;
1216           case MAX:
1217           case MAX | FWEIGHT:
1218           case MIN:
1219           case MIN | FWEIGHT:
1220             v->f = i->int1 ? i->dbl[0] : SYSMIS;
1221             break;
1222           case MAX | FSTRING:
1223           case MAX | FSTRING | FWEIGHT:
1224           case MIN | FSTRING:
1225           case MIN | FSTRING | FWEIGHT:
1226             if (i->int1)
1227               memcpy (v->s, i->string, i->dest->width);
1228             else
1229               memset (v->s, ' ', i->dest->width);
1230             break;
1231           case FGT:
1232           case FGT | FSTRING:
1233           case FLT:
1234           case FLT | FSTRING:
1235           case FIN:
1236           case FIN | FSTRING:
1237           case FOUT:
1238           case FOUT | FSTRING:
1239             v->f = i->int2 ? (double) i->int1 / (double) i->int2 : SYSMIS;
1240             break;
1241           case FGT | FWEIGHT:
1242           case FGT | FSTRING | FWEIGHT:
1243           case FLT | FWEIGHT:
1244           case FLT | FSTRING | FWEIGHT:
1245           case FIN | FWEIGHT:
1246           case FIN | FSTRING | FWEIGHT:
1247           case FOUT | FWEIGHT:
1248           case FOUT | FSTRING | FWEIGHT:
1249             v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] : SYSMIS;
1250             break;
1251           case PGT:
1252           case PGT | FSTRING:
1253           case PLT:
1254           case PLT | FSTRING:
1255           case PIN:
1256           case PIN | FSTRING:
1257           case POUT:
1258           case POUT | FSTRING:
1259             v->f = (i->int2
1260                     ? (double) i->int1 / (double) i->int2 * 100.0
1261                     : SYSMIS);
1262             break;
1263           case PGT | FWEIGHT:
1264           case PGT | FSTRING | FWEIGHT:
1265           case PLT | FWEIGHT:
1266           case PLT | FSTRING | FWEIGHT:
1267           case PIN | FWEIGHT:
1268           case PIN | FSTRING | FWEIGHT:
1269           case POUT | FWEIGHT:
1270           case POUT | FSTRING | FWEIGHT:
1271             v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] * 100.0 : SYSMIS;
1272             break;
1273           case N | FWEIGHT:
1274             v->f = i->dbl[0];
1275           case N:
1276           case NU:
1277           case NU | FWEIGHT:
1278             v->f = i->int1;
1279             break;
1280           case FIRST:
1281           case FIRST | FWEIGHT:
1282           case LAST:
1283           case LAST | FWEIGHT:
1284             v->f = i->int1 ? i->dbl[0] : SYSMIS;
1285             break;
1286           case FIRST | FSTRING:
1287           case FIRST | FSTRING | FWEIGHT:
1288           case LAST | FSTRING:
1289           case LAST | FSTRING | FWEIGHT:
1290             if (i->int1)
1291               memcpy (v->s, i->string, i->dest->width);
1292             else
1293               memset (v->s, ' ', i->dest->width);
1294             break;
1295           case N_NO_VARS | FWEIGHT:
1296             v->f = i->dbl[0];
1297             break;
1298           case N_NO_VARS:
1299           case NU_NO_VARS:
1300           case NU_NO_VARS | FWEIGHT:
1301             v->f = i->int1;
1302             break;
1303           case NMISS | FWEIGHT:
1304             v->f = i->dbl[0];
1305             break;
1306           case NMISS:
1307           case NUMISS:
1308           case NUMISS | FWEIGHT:
1309             v->f = i->int1;
1310             break;
1311           default:
1312             assert (0);
1313           }
1314       }
1315   }
1316   debug_printf ((") "));
1317 }
1318
1319 /* Resets the state for all the aggregate functions. */
1320 static void
1321 initialize_aggregate_info (void)
1322 {
1323   struct agr_var *iter;
1324
1325   for (iter = agr_first; iter; iter = iter->next)
1326     {
1327       int plain_function = iter->function & ~FWEIGHT;
1328
1329       iter->missing = 0;
1330       switch (plain_function)
1331         {
1332         case MIN:
1333           iter->dbl[0] = DBL_MAX;
1334           break;
1335         case MIN | FSTRING:
1336           memset (iter->string, 255, iter->src->width);
1337           break;
1338         case MAX:
1339           iter->dbl[0] = -DBL_MAX;
1340           break;
1341         case MAX | FSTRING:
1342           memset (iter->string, 0, iter->src->width);
1343           break;
1344         default:
1345           iter->dbl[0] = iter->dbl[1] = iter->dbl[2] = 0.0;
1346           iter->int1 = iter->int2 = 0;
1347           break;
1348         }
1349     }
1350 }
1351 \f
1352 /* Aggregate each case as it comes through.  Cases which aren't needed
1353    are dropped. */
1354 static int
1355 agr_00x_trns_proc (struct trns_header *h unused, struct ccase *c)
1356 {
1357   int code = aggregate_single_case (c, compaction_case);
1358   debug_printf (("%d ", code));
1359   return code;
1360 }
1361
1362 /* Output the last aggregate case.  It's okay to call the vfm_sink's
1363    write() method here because end_func is called so soon after all
1364    the cases have been output; very little has been cleaned up at this
1365    point. */
1366 static void
1367 agr_00x_end_func (void)
1368 {
1369   /* Ensure that info for the last break group gets written to the
1370      active file. */
1371   dump_aggregate_info (compaction_case);
1372   vfm_sink_info.ncases++;
1373   vfm_sink->write ();
1374 }
1375
1376 /* Transform the aggregate case buf_1xx, in internal format, to system
1377    file format, in buf64_1xx, and write the resultant case to the
1378    system file. */
1379 static void
1380 write_case_to_sfm (void)
1381 {
1382   flt64 *p = buf64_1xx;
1383   int i;
1384
1385   for (i = 0; i < agr_dict->nvar; i++)
1386     {
1387       struct variable *v = agr_dict->var[i];
1388
1389       if (v->type == NUMERIC)
1390         {
1391           double src = buf_1xx->data[v->fv].f;
1392           if (src == SYSMIS)
1393             *p++ = -FLT64_MAX;
1394           else
1395             *p++ = src;
1396         }
1397       else
1398         {
1399           memcpy (p, buf_1xx->data[v->fv].s, v->width);
1400           memset (&((char *) p)[v->width], ' ',
1401                   REM_RND_UP (v->width, sizeof (flt64)));
1402           p += DIV_RND_UP (v->width, sizeof (flt64));
1403         }
1404     }
1405
1406   sfm_write_case (outfile, buf64_1xx, p - buf64_1xx);
1407 }
1408
1409 /* Aggregate the current case and output it if we passed a
1410    breakpoint. */
1411 static int
1412 agr_10x_trns_proc (struct trns_header *h unused, struct ccase *c)
1413 {
1414   int code = aggregate_single_case (c, buf_1xx);
1415
1416   assert (code == -2 || code == -1);
1417   if (code == -1)
1418     write_case_to_sfm ();
1419   return -1;
1420 }
1421
1422 /* Close the system file now that we're done with it.  */
1423 static void
1424 agr_10x_trns_free (struct trns_header *h unused)
1425 {
1426   fh_close_handle (outfile);
1427 }
1428
1429 /* Ensure that info for the last break group gets written to the
1430    system file. */
1431 static void
1432 agr_10x_end_func (void)
1433 {
1434   dump_aggregate_info (buf_1xx);
1435   write_case_to_sfm ();
1436 }
1437
1438 /* When called with temp_case non-NULL (the normal case), runs the
1439    case through the aggregater and outputs it to the system file if
1440    appropriate.  If temp_case is NULL, finishes up writing the last
1441    case if necessary. */
1442 static int
1443 agr_11x_func (void)
1444 {
1445   if (temp_case != NULL)
1446     {
1447       int code = aggregate_single_case (temp_case, buf_1xx);
1448
1449       assert (code == -2 || code == -1);
1450       if (code == -1)
1451         write_case_to_sfm ();
1452     }
1453   else
1454     {
1455       if (case_count)
1456         {
1457           dump_aggregate_info (buf_1xx);
1458           write_case_to_sfm ();
1459         }
1460       fh_close_handle (outfile);
1461     }
1462   return 1;
1463 }
1464 \f
1465 /* Debugging. */
1466 #if DEBUGGING
1467 /* Print out useful debugging information. */
1468 static void
1469 debug_print (int flags)
1470 {
1471   printf ("AGGREGATE\n /OUTFILE=%s\n",
1472           outfile ? fh_handle_filename (outfile) : "*");
1473
1474   if (missing == COLUMNWISE)
1475     puts (" /MISSING=COLUMNWISE");
1476
1477   if (flags & 2)
1478     puts (" /DOCUMENT");
1479   if (flags & 4)
1480     puts (" /PRESORTED");
1481
1482   {
1483     int i;
1484
1485     printf (" /BREAK=");
1486     for (i = 0; i < nv_sort; i++)
1487       printf ("%s(%c) ", v_sort[i]->name,
1488               v_sort[i]->p.srt.order == SRT_ASCEND ? 'A' : 'D');
1489     putc ('\n', stdout);
1490   }
1491
1492   {
1493     struct agr_var *iter;
1494
1495     for (iter = agr_first; iter; iter = iter->next)
1496       {
1497         struct agr_func *f = &agr_func_tab[iter->function & FUNC];
1498
1499         printf (" /%s", iter->dest->name);
1500         if (iter->dest->label)
1501           printf ("'%s'", iter->dest->label);
1502         printf ("=%s(%s", f->name, iter->src->name);
1503         if (f->n_args)
1504           {
1505             int i;
1506
1507             for (i = 0; i < f->n_args; i++)
1508               {
1509                 putc (',', stdout);
1510                 if (iter->src->type == NUMERIC)
1511                   printf ("%g", iter->arg[i].f);
1512                 else
1513                   printf ("%.*s", iter->src->width, iter->arg[i].c);
1514               }
1515           }
1516         printf (")\n");
1517       }
1518   }
1519 }
1520
1521 #endif /* DEBUGGING */