Encapsulated lexer and updated calling functions accordingly.
[pspp-builds.git] / src / language / stats / descriptives.c
index 62c0ede0d9a12cd0111bebbeae0cd6fcabf75ff3..c1653dc745d24b5cee4043cf94f04fd80867b4ec 100644 (file)
 /* FIXME: Many possible optimizations. */
 
 #include <config.h>
-#include <libpspp/message.h>
+
 #include <limits.h>
 #include <math.h>
 #include <stdlib.h>
-#include <libpspp/array.h>
-#include <libpspp/alloc.h>
+
 #include <data/case.h>
 #include <data/casefile.h>
-#include <language/command.h>
-#include <libpspp/compiler.h>
 #include <data/dictionary.h>
+#include <data/procedure.h>
+#include <data/transformations.h>
+#include <data/variable.h>
+#include <language/command.h>
+#include <language/dictionary/split-file.h>
 #include <language/lexer/lexer.h>
-#include <libpspp/message.h>
+#include <language/lexer/variable-parser.h>
+#include <libpspp/alloc.h>
+#include <libpspp/array.h>
+#include <libpspp/compiler.h>
 #include <libpspp/magic.h>
+#include <libpspp/message.h>
+#include <libpspp/assertion.h>
 #include <math/moments.h>
 #include <output/manager.h>
 #include <output/table.h>
-#include <data/variable.h>
-#include <procedure.h>
 
 #include "gettext.h"
 #define _(msgid) gettext (msgid)
@@ -155,7 +160,7 @@ struct dsc_proc
     /* Accumulated results. */
     double missing_listwise;    /* Sum of weights of cases missing listwise. */
     double valid;               /* Sum of weights of valid cases. */
-    int bad_warn;               /* Warn if bad weight found. */
+    bool bad_warn;               /* Warn if bad weight found. */
     enum dsc_statistic sort_by_stat; /* Statistic to sort by; -1: name. */
     int sort_ascending;         /* !0: ascending order; 0: descending. */
     unsigned long show_stats;   /* Statistics to display. */
@@ -164,26 +169,31 @@ struct dsc_proc
   };
 
 /* Parsing. */
-static enum dsc_statistic match_statistic (void);
+static enum dsc_statistic match_statistic (struct lexer *);
 static void free_dsc_proc (struct dsc_proc *);
 
 /* Z-score functions. */
-static int try_name (struct dsc_proc *dsc, char *name);
-static int generate_z_varname (struct dsc_proc *dsc, char *z_name,
-                               const char *name, size_t *z_cnt);
+static bool try_name (const struct dictionary *dict, 
+                     struct dsc_proc *dsc, const char *name);
+static bool generate_z_varname (const struct dictionary *dict, 
+                               struct dsc_proc *dsc, char *z_name,
+                               const char *name, size_t *z_cnt);
 static void dump_z_table (struct dsc_proc *);
-static void setup_z_trns (struct dsc_proc *);
+static void setup_z_trns (struct dsc_proc *, struct dataset *);
 
 /* Procedure execution functions. */
-static bool calc_descriptives (const struct casefile *, void *dsc_);
+static bool calc_descriptives (const struct ccase *first,
+                               const struct casefile *, void *dsc_, 
+                              const struct dataset *);
 static void display (struct dsc_proc *dsc);
 \f
 /* Parser and outline. */
 
 /* Handles DESCRIPTIVES. */
 int
-cmd_descriptives (void)
+cmd_descriptives (struct lexer *lexer, struct dataset *ds)
 {
+  struct dictionary *dict = dataset_dict (ds);
   struct dsc_proc *dsc;
   struct variable **vars = NULL;
   size_t var_cnt = 0;
@@ -209,106 +219,106 @@ cmd_descriptives (void)
   dsc->show_stats = dsc->calc_stats = DEFAULT_STATS;
 
   /* Parse DESCRIPTIVES. */
-  while (token != '.') 
+  while (lex_token (lexer) != '.') 
     {
-      if (lex_match_id ("MISSING"))
+      if (lex_match_id (lexer, "MISSING"))
         {
-          lex_match ('=');
-          while (token != '.' && token != '/') 
+          lex_match (lexer, '=');
+          while (lex_token (lexer) != '.' && lex_token (lexer) != '/') 
             {
-              if (lex_match_id ("VARIABLE"))
+              if (lex_match_id (lexer, "VARIABLE"))
                 dsc->missing_type = DSC_VARIABLE;
-              else if (lex_match_id ("LISTWISE"))
+              else if (lex_match_id (lexer, "LISTWISE"))
                 dsc->missing_type = DSC_LISTWISE;
-              else if (lex_match_id ("INCLUDE"))
+              else if (lex_match_id (lexer, "INCLUDE"))
                 dsc->include_user_missing = 1;
               else
                 {
-                  lex_error (NULL);
+                  lex_error (lexer, NULL);
                   goto error;
                 }
-              lex_match (',');
+              lex_match (lexer, ',');
             }
         }
-      else if (lex_match_id ("SAVE"))
+      else if (lex_match_id (lexer, "SAVE"))
         save_z_scores = 1;
-      else if (lex_match_id ("FORMAT")) 
+      else if (lex_match_id (lexer, "FORMAT")) 
         {
-          lex_match ('=');
-          while (token != '.' && token != '/') 
+          lex_match (lexer, '=');
+          while (lex_token (lexer) != '.' && lex_token (lexer) != '/') 
             {
-              if (lex_match_id ("LABELS"))
+              if (lex_match_id (lexer, "LABELS"))
                 dsc->show_var_labels = 1;
-              else if (lex_match_id ("NOLABELS"))
+              else if (lex_match_id (lexer, "NOLABELS"))
                 dsc->show_var_labels = 0;
-              else if (lex_match_id ("INDEX"))
+              else if (lex_match_id (lexer, "INDEX"))
                 dsc->show_index = 1;
-              else if (lex_match_id ("NOINDEX"))
+              else if (lex_match_id (lexer, "NOINDEX"))
                 dsc->show_index = 0;
-              else if (lex_match_id ("LINE"))
+              else if (lex_match_id (lexer, "LINE"))
                 dsc->format = DSC_LINE;
-              else if (lex_match_id ("SERIAL"))
+              else if (lex_match_id (lexer, "SERIAL"))
                 dsc->format = DSC_SERIAL;
               else
                 {
-                  lex_error (NULL);
+                  lex_error (lexer, NULL);
                   goto error;
                 }
-              lex_match (',');
+              lex_match (lexer, ',');
             }
         }
-      else if (lex_match_id ("STATISTICS")) 
+      else if (lex_match_id (lexer, "STATISTICS")) 
         {
-          lex_match ('=');
+          lex_match (lexer, '=');
           dsc->show_stats = 0;
-          while (token != '.' && token != '/') 
+          while (lex_token (lexer) != '.' && lex_token (lexer) != '/') 
             {
-              if (lex_match (T_ALL)) 
+              if (lex_match (lexer, T_ALL)) 
                 dsc->show_stats |= (1ul << DSC_N_STATS) - 1;
-              else if (lex_match_id ("DEFAULT"))
+              else if (lex_match_id (lexer, "DEFAULT"))
                 dsc->show_stats |= DEFAULT_STATS;
               else
-               dsc->show_stats |= 1ul << (match_statistic ());
-              lex_match (',');
+               dsc->show_stats |= 1ul << (match_statistic (lexer));
+              lex_match (lexer, ',');
             }
           if (dsc->show_stats == 0)
             dsc->show_stats = DEFAULT_STATS;
         }
-      else if (lex_match_id ("SORT")) 
+      else if (lex_match_id (lexer, "SORT")) 
         {
-          lex_match ('=');
-          if (lex_match_id ("NAME"))
+          lex_match (lexer, '=');
+          if (lex_match_id (lexer, "NAME"))
             dsc->sort_by_stat = DSC_NAME;
           else 
            {
-             dsc->sort_by_stat = match_statistic ();
+             dsc->sort_by_stat = match_statistic (lexer);
              if (dsc->sort_by_stat == DSC_NONE )
                dsc->sort_by_stat = DSC_MEAN;
            }
-          if (lex_match ('(')) 
+          if (lex_match (lexer, '(')) 
             {
-              if (lex_match_id ("A"))
+              if (lex_match_id (lexer, "A"))
                 dsc->sort_ascending = 1;
-              else if (lex_match_id ("D"))
+              else if (lex_match_id (lexer, "D"))
                 dsc->sort_ascending = 0;
               else
-                lex_error (NULL);
-              lex_force_match (')');
+                lex_error (lexer, NULL);
+              lex_force_match (lexer, ')');
             }
         }
       else if (var_cnt == 0)
         {
-          if (lex_look_ahead () == '=') 
+          if (lex_look_ahead (lexer) == '=') 
             {
-              lex_match_id ("VARIABLES");
-              lex_match ('=');
+              lex_match_id (lexer, "VARIABLES");
+              lex_match (lexer, '=');
             }
 
-          while (token != '.' && token != '/') 
+          while (lex_token (lexer) != '.' && lex_token (lexer) != '/') 
             {
               int i;
               
-              if (!parse_variables (default_dict, &vars, &var_cnt,
+              if (!parse_variables (lexer, dataset_dict (ds), &vars, &var_cnt,
                                     PV_APPEND | PV_NO_DUPLICATE | PV_NUMERIC))
                goto error;
 
@@ -322,34 +332,34 @@ cmd_descriptives (void)
                 }
               dsc->var_cnt = var_cnt;
 
-              if (lex_match ('(')) 
+              if (lex_match (lexer, '(')) 
                 {
-                  if (token != T_ID) 
+                  if (lex_token (lexer) != T_ID) 
                     {
-                      lex_error (NULL);
+                      lex_error (lexer, NULL);
                       goto error;
                     }
-                  if (try_name (dsc, tokid)) 
+                  if (try_name (dict, dsc, lex_tokid (lexer))) 
                     {
-                      strcpy (dsc->vars[dsc->var_cnt - 1].z_name, tokid);
+                      strcpy (dsc->vars[dsc->var_cnt - 1].z_name, lex_tokid (lexer));
                       z_cnt++;
                     }
                   else
                     msg (SE, _("Z-score variable name %s would be"
-                               " a duplicate variable name."), tokid);
-                  lex_get ();
-                  if (!lex_force_match (')'))
+                               " a duplicate variable name."), lex_tokid (lexer));
+                  lex_get (lexer);
+                  if (!lex_force_match (lexer, ')'))
                    goto error;
                 }
             }
         }
       else 
         {
-          lex_error (NULL);
+          lex_error (lexer, NULL);
           goto error; 
         }
 
-      lex_match ('/');
+      lex_match (lexer, '/');
     }
   if (var_cnt == 0)
     {
@@ -367,7 +377,7 @@ cmd_descriptives (void)
           for (i = 0; i < dsc->var_cnt; i++)
             if (dsc->vars[i].z_name[0] == 0) 
               {
-                if (!generate_z_varname (dsc, dsc->vars[i].z_name,
+                if (!generate_z_varname (dict, dsc, dsc->vars[i].z_name,
                                          dsc->vars[i].v->name, &gen_cnt))
                   goto error;
                 z_cnt++;
@@ -404,11 +414,11 @@ cmd_descriptives (void)
       dsc->vars[i].moments = moments_create (dsc->max_moment);
 
   /* Data pass. */
-  ok = multipass_procedure_with_splits (calc_descriptives, dsc);
+  ok = multipass_procedure_with_splits (ds, calc_descriptives, dsc);
 
   /* Z-scoring! */
   if (ok && z_cnt)
-    setup_z_trns (dsc);
+    setup_z_trns (dsc, ds);
 
   /* Done. */
   free (vars);
@@ -426,18 +436,18 @@ cmd_descriptives (void)
    specifiers). Emits an error if the current token ID does not name a
    statistic. */
 static enum dsc_statistic
-match_statistic (void
+match_statistic (struct lexer *lexer
 {
-  if (token == T_ID) 
+  if (lex_token (lexer) == T_ID) 
     {
       enum dsc_statistic stat;
 
       for (stat = 0; stat < DSC_N_STATS; stat++)
-        if (lex_match_id (dsc_info[stat].identifier)) 
+        if (lex_match_id (lexer, dsc_info[stat].identifier)) 
          return stat;
 
-      lex_get();
-      lex_error (_("expecting statistic name: reverting to default"));
+      lex_get (lexer);
+      lex_error (lexer, _("expecting statistic name: reverting to default"));
     }
 
   return DSC_NONE;
@@ -460,27 +470,28 @@ free_dsc_proc (struct dsc_proc *dsc)
 \f
 /* Z scores. */
 
-/* Returns 0 if NAME is a duplicate of any existing variable name or
-   of any previously-declared z-var name; otherwise returns 1. */
-static int
-try_name (struct dsc_proc *dsc, char *name)
+/* Returns false if NAME is a duplicate of any existing variable name or
+   of any previously-declared z-var name; otherwise returns true. */
+static bool
+try_name (const struct dictionary *dict, struct dsc_proc *dsc, 
+         const char *name)
 {
   size_t i;
 
-  if (dict_lookup_var (default_dict, name) != NULL)
-    return 0;
+  if (dict_lookup_var (dict, name) != NULL)
+    return false;
   for (i = 0; i < dsc->var_cnt; i++)
     if (!strcasecmp (dsc->vars[i].z_name, name))
-      return 0;
-  return 1;
+      return false;
+  return true;
 }
 
 /* Generates a name for a Z-score variable based on a variable
    named VAR_NAME, given that *Z_CNT generated variable names are
-   known to already exist.  If successful, returns nonzero and
-   copies the new name into Z_NAME.  On failure, returns zero. */
-static int
-generate_z_varname (struct dsc_proc *dsc, char *z_name,
+   known to already exist.  If successful, returns true and
+   copies the new name into Z_NAME.  On failure, returns false. */
+static bool
+generate_z_varname (const struct dictionary *dict, struct dsc_proc *dsc, char *z_name,
                     const char *var_name, size_t *z_cnt)
 {
   char name[LONG_NAME_LEN + 1];
@@ -488,10 +499,10 @@ generate_z_varname (struct dsc_proc *dsc, char *z_name,
   /* Try a name based on the original variable name. */
   name[0] = 'Z';
   str_copy_trunc (name + 1, sizeof name - 1, var_name);
-  if (try_name (dsc, name))
+  if (try_name (dict, dsc, name))
     {
       strcpy (z_name, name);
-      return 1;
+      return true;
     }
 
   /* Generate a synthetic name. */
@@ -512,15 +523,16 @@ generate_z_varname (struct dsc_proc *dsc, char *z_name,
          msg (SE, _("Ran out of generic names for Z-score variables.  "
                     "There are only 126 generic names: ZSC001-ZSC0999, "
                     "STDZ01-STDZ09, ZZZZ01-ZZZZ09, ZQZQ01-ZQZQ09."));
-         return 0;
+         return false;
        }
       
-      if (try_name (dsc, name))
+      if (try_name (dict, dsc, name))
        {
          strcpy (z_name, name);
-         return 1;
+         return true;
        }
     }
+  NOT_REACHED();
 }
 
 /* Outputs a table describing the mapping between source
@@ -571,7 +583,7 @@ dump_z_table (struct dsc_proc *dsc)
 */
 static int
 descriptives_trns_proc (void *trns_, struct ccase * c,
-                        int case_idx UNUSED)
+                        casenumber case_idx UNUSED)
 {
   struct dsc_trns *t = trns_;
   struct dsc_z_score *z;
@@ -624,7 +636,7 @@ descriptives_trns_free (void *trns_)
 
 /* Sets up a transformation to calculate Z scores. */
 static void
-setup_z_trns (struct dsc_proc *dsc)
+setup_z_trns (struct dsc_proc *dsc, struct dataset *ds)
 {
   struct dsc_trns *t;
   size_t cnt, i;
@@ -660,7 +672,7 @@ setup_z_trns (struct dsc_proc *dsc)
          char *cp;
          struct variable *dst_var;
 
-         dst_var = dict_create_var_assert (default_dict, dv->z_name, 0);
+         dst_var = dict_create_var_assert (dataset_dict (ds), dv->z_name, 0);
          if (dv->v->label)
            {
              dst_var->label = xmalloc (strlen (dv->v->label) + 12);
@@ -683,23 +695,28 @@ setup_z_trns (struct dsc_proc *dsc)
        }
     }
 
-  add_transformation (descriptives_trns_proc, descriptives_trns_free, t);
+  add_transformation (ds,
+                     descriptives_trns_proc, descriptives_trns_free, t);
 }
 \f
 /* Statistical calculation. */
 
-static int listwise_missing (struct dsc_proc *dsc, const struct ccase *c);
+static bool listwise_missing (struct dsc_proc *dsc, const struct ccase *c);
 
 /* Calculates and displays descriptive statistics for the cases
    in CF. */
 static bool
-calc_descriptives (const struct casefile *cf, void *dsc_) 
+calc_descriptives (const struct ccase *first,
+                   const struct casefile *cf, void *dsc_, 
+                  const struct dataset *ds) 
 {
   struct dsc_proc *dsc = dsc_;
   struct casereader *reader;
   struct ccase c;
   size_t i;
 
+  output_split_file_values (ds, first);
+
   for (i = 0; i < dsc->var_cnt; i++)
     {
       struct dsc_var *dv = &dsc->vars[i];
@@ -714,11 +731,11 @@ calc_descriptives (const struct casefile *cf, void *dsc_)
   dsc->valid = 0.;
 
   /* First pass to handle most of the work. */
-  for (reader = casefile_get_reader (cf);
+  for (reader = casefile_get_reader (cf, NULL);
        casereader_read (reader, &c);
        case_destroy (&c))
     {
-      double weight = dict_get_case_weight (default_dict, &c, &dsc->bad_warn);
+      double weight = dict_get_case_weight (dataset_dict (ds), &c, &dsc->bad_warn);
       if (weight <= 0.0) 
         continue;
        
@@ -759,11 +776,11 @@ calc_descriptives (const struct casefile *cf, void *dsc_)
   /* Second pass for higher-order moments. */
   if (dsc->max_moment > MOMENT_MEAN) 
     {
-      for (reader = casefile_get_reader (cf);
+      for (reader = casefile_get_reader (cf, NULL);
            casereader_read (reader, &c);
            case_destroy (&c))
         {
-          double weight = dict_get_case_weight (default_dict, &c, 
+          double weight = dict_get_case_weight (dataset_dict (ds), &c, 
                                                &dsc->bad_warn);
           if (weight <= 0.0)
             continue;
@@ -833,9 +850,9 @@ calc_descriptives (const struct casefile *cf, void *dsc_)
   return true;
 }
 
-/* Returns nonzero if any of the descriptives variables in DSC's
-   variable list have missing values in case C, zero otherwise. */
-static int
+/* Returns true if any of the descriptives variables in DSC's
+   variable list have missing values in case C, false otherwise. */
+static bool
 listwise_missing (struct dsc_proc *dsc, const struct ccase *c) 
 {
   size_t i;
@@ -848,9 +865,9 @@ listwise_missing (struct dsc_proc *dsc, const struct ccase *c)
       if (x == SYSMIS
           || (!dsc->include_user_missing
               && mv_is_num_user_missing (&dv->v->miss, x)))
-        return 1;
+        return true;
     }
-  return 0;
+  return false;
 }
 \f
 /* Statistical display. */
@@ -923,11 +940,11 @@ display (struct dsc_proc *dsc)
 /* Compares `struct dsc_var's A and B according to the ordering
    specified by CMD. */
 static int
-descriptives_compare_dsc_vars (const void *a_, const void *b_, void *dsc_)
+descriptives_compare_dsc_vars (const void *a_, const void *b_, const void *dsc_)
 {
   const struct dsc_var *a = a_;
   const struct dsc_var *b = b_;
-  struct dsc_proc *dsc = dsc_;
+  const struct dsc_proc *dsc = dsc_;
 
   int result;