Cruft removal
[pspp-builds.git] / src / math / interaction.c
index be3d3edb576bad70a4b15d9c6a8a8b27fde5d0a6..7fc9f0f63d2c5efee0098f06fe921d50758425e6 100644 (file)
@@ -1,25 +1,21 @@
-/* PSPP - Creates data structures to store interactions for
-   statistical routines.  
+/* PSPP - a program for statistical analysis.
+   Copyright (C) 2009 Free Software Foundation, Inc.
 
-   Copyright (C) 2007 Free Software Foundation, Inc.
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-   This program is free software; you can redistribute it and/or
-   modify it under the terms of the GNU General Public License as
-   published by the Free Software Foundation; either version 2 of the
-   License, or (at your option) any later version.
-
-   This program is distributed in the hope that it will be useful, but
-   WITHOUT ANY WARRANTY; without even the implied warranty of
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-   General Public License for more details.
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
-   along with this program; if not, write to the Free Software
-   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-   02110-1301, USA. */
+   along with this program.  If not, see <http://www.gnu.org/licenses/>. */
 
 /*
-  An interaction is a gsl_vector containing a "product" of other
+  An interaction is a structure containing a "product" of other
   variables. The variables can be either categorical or numeric.
   If the variables are all numeric, the interaction is just the
   scalar product. If any of the variables are categorical, their
   OBS_VALS member. If there are K categorical variables, each with
   N_1, N_2, ..., N_K categories, then the interaction will have
   N_1 * N_2 * N_3 *...* N_K - 1 entries.
+
+  When using these functions, make sure the orders of variables and
+  values match when appropriate.
  */
+
+#include <config.h>
 #include <assert.h>
-#include <libpspp/alloc.h>
-#include <gsl/gsl_math.h>
-#include <gsl/gsl_vector.h>
-#include <data/category.h>
+#include <data/value.h>
 #include <data/variable.h>
+#include <gl/unistr.h>
+#include <math/interaction.h>
+#include <string.h>
+#include <xalloc.h>
+
+struct interaction_variable
+{
+  int n_vars;
+  const struct variable **members;
+  struct variable *intr;
+  size_t n_alpha;
+};
+
+struct interaction_value
+{
+  const struct interaction_variable *intr;
+  union value val; /* Concatenation of the string values in this
+                      interaction's value, or the product of a bunch
+                      of numeric values for a purely numeric
+                      interaction.
+                   */
+  double f; /* Product of the numerical values in this interaction's value. */
+};
 
 /*
-  Convert a list of values to a binary vector. The order of VALS must
-  correspond to the order of V.
+  An interaction_variable has type alpha if any of members have type
+  alpha. Otherwise, its type is numeric.
  */
-gsl_vector *
-get_interaction (union value **vals, const struct variable **v, size_t n_vars)
+struct interaction_variable *
+interaction_variable_create (const struct variable **vars, int n_vars)
 {
-  gsl_vector *result = NULL;
-  size_t *subs = NULL;
-  size_t length = 1;
+  struct interaction_variable *result = NULL;
   size_t i;
-  size_t j;
-  double tmp = 1.0;
 
-  assert (n_vars > 0);
-  for (i = 0; i < n_vars; i++)
+  if (n_vars > 0)
     {
-      if (var_is_alpha (v[i]))
-       {
-         length *= cat_get_n_categories (v[i]);
-       }
-      else
+      int width = 0;
+
+      result = xmalloc (sizeof (*result));
+      result->n_alpha = 0;
+      result->members = xnmalloc (n_vars, sizeof (*result->members));
+      result->n_vars = n_vars;
+      for (i = 0; i < n_vars; i++)
        {
-         length = (length > 0) ? length : 1;
+         result->members[i] = vars[i];
+         if (var_is_alpha (vars[i]))
+           {
+             result->n_alpha++;
+             width += var_get_width (vars[i]);
+           }
        }
+      result->intr = var_create_internal (0, width);
     }
-  if (length > 0)
-    {
-      length--;
-    }
 
-  result = gsl_vector_calloc (length);
-  subs = xnmalloc (n_vars, sizeof (*subs));
-  for (j = 0; j < n_vars; j++)
+  return result;
+}
+void interaction_variable_destroy (struct interaction_variable *iv)
+{
+  var_destroy (iv->intr);
+  free (iv->members);
+  free (iv);
+}
+
+/*
+  Get one of the member variables.
+ */
+const struct variable *
+interaction_get_member (const struct interaction_variable *iv, size_t i)
+{
+  return iv->members[i];
+}
+
+size_t
+interaction_get_n_vars (const struct interaction_variable *iv)
+{
+  return (iv == NULL) ? 0 : iv->n_vars;
+}
+
+size_t
+interaction_get_n_alpha (const struct interaction_variable *iv)
+{
+  return iv->n_alpha;
+}
+
+size_t
+interaction_get_n_numeric (const struct interaction_variable *iv)
+{
+  return (interaction_get_n_vars (iv) - interaction_get_n_alpha (iv));
+}
+
+/*
+  Get the interaction variable itself.
+ */
+const struct variable *
+interaction_get_variable (const struct interaction_variable *iv)
+{
+  return iv->intr;
+}
+/*
+  Given list of values, compute the value of the corresponding
+  interaction.  This "value" is not stored as the typical vector of
+  0's and one double, but rather the string values are concatenated to
+  make one big string value, and the numerical values are multiplied
+  together to give the non-zero entry of the corresponding vector.
+ */
+struct interaction_value *
+interaction_value_create (const struct interaction_variable *var, const union value **vals)
+{
+  struct interaction_value *result = NULL;
+  
+  if (var != NULL)
     {
-      if (var_is_alpha (v[j]))
+      size_t i;
+      int val_width = var_get_width (interaction_get_variable (var));
+      int offset = 0;
+      size_t n_vars = interaction_get_n_vars (var);
+
+      result = xmalloc (sizeof (*result));
+      result->intr = var;
+
+      value_init (&result->val, val_width);
+
+      result->f = 1.0;
+      for (i = 0; i < n_vars; i++)
+       {
+          const struct variable *member = interaction_get_member (var, i);
+
+         if (var_is_value_missing (member, vals[i], MV_ANY))
+           {
+             value_set_missing (&result->val, val_width);
+             result->f = SYSMIS;
+             break;
+           }
+         else
+           {
+             if (var_is_alpha (var->members[i]))
+               {
+                 uint8_t *val = value_str_rw (&result->val, val_width);
+                  int w = var_get_width (var->members[i]);
+                  u8_cpy (val + offset, value_str (vals[i], w), w);
+                  offset += w;
+               }
+             else if (var_is_numeric (var->members[i]))
+               {
+                 result->f *= vals[i]->f;
+               }
+           }
+       }
+      if (interaction_get_n_alpha (var) == 0)
        {
-         subs[j] = cat_value_find (v[j], vals[j]);
+         /*
+           If there are no categorical variables, then the
+           interaction consists of only numeric data. In this case,
+           code that uses this interaction_value will see the union
+           member as the numeric value. If we were to store that
+           numeric value in result->f as well, the calling code may
+           inadvertently square this value by multiplying by
+           result->val->f. Such multiplication would be correct for an
+           interaction consisting of both categorical and numeric
+           data, but a mistake for purely numerical interactions. To
+           avoid the error, we set result->f to 1.0 for numeric
+           interactions.
+          */
+         result->val.f = result->f;
+         result->f = 1.0;
        }
     }
-  j = subs[0];
-  for (i = 1; i < n_vars; i++)
+  return result;
+}
+
+const union value *
+interaction_value_get (const struct interaction_value *val)
+{
+  return &val->val;
+}
+
+/*
+  Returns the numeric value of the non-zero entry for the vector
+  corresponding to this interaction.  Do not use this function to get
+  the numeric value of a purely numeric interaction. Instead, use the
+  union value * returned by interaction_value_get.
+ */
+double 
+interaction_value_get_nonzero_entry (const struct interaction_value *val)
+{
+  if (val != NULL)
+    return val->f;
+  return 1.0;
+}
+
+void 
+interaction_value_destroy (struct interaction_value *val)
+{
+  if (val != NULL)
     {
-      j = j * cat_get_n_categories (v[i]) + subs[i];
+      int val_width = var_get_width (interaction_get_variable (val->intr));
+
+      value_destroy (&val->val, val_width);
+      free (val);
     }
-  gsl_vector_set (result, j, 1.0);
-  /*
-     If any of the variables are numeric, the interaction of that
-     variable with another is just a scalar product.
-   */
-  for (i = 1; i < n_vars; i++)
-    {
-      if (var_is_numeric (v[i]))
+}
+
+/*
+  Return a value from a variable that is an interaction. 
+ */
+struct interaction_value *
+interaction_case_data (const struct ccase *ccase, const struct interaction_variable *iv)
+{
+  size_t i;
+  size_t n_vars;
+  const struct variable *member;
+  const union value **vals = NULL;
+
+  n_vars = interaction_get_n_vars (iv);
+  vals = xnmalloc (n_vars, sizeof (*vals));
+
+  for (i = 0; i < n_vars; i++)
        {
-         tmp *= vals[i]->f;
+         member = interaction_get_member (iv, i);
+         vals[i] = case_data (ccase, member);
        }
-    }
-  if (fabs (tmp - 1.0) > GSL_DBL_EPSILON)
+
+  return interaction_value_create (iv, vals);
+}
+
+bool
+is_interaction (const struct variable *var, const struct interaction_variable **iv, size_t n_intr)
+{
+  size_t i;
+  const struct variable *intr;
+  
+  for (i = 0; i < n_intr; i++)
     {
-      gsl_vector_set (result, j, tmp);
+      intr = interaction_get_variable (iv[i]);
+      if (var_get_dict_index (intr) == var_get_dict_index (var))
+       {
+         return true;
+       }
     }
-  free (subs);
-
-  return result;
+  return false;
 }
+