+static unsigned int
+covariance_accumulator_hash (const void *h, const void *aux)
+{
+ struct covariance_accumulator *ca = (struct covariance_accumulator *) h;
+ size_t *n_vars = (size_t *) aux;
+ size_t idx_max;
+ size_t idx_min;
+ const struct variable *v_min;
+ const struct variable *v_max;
+ const union value *val_min;
+ const union value *val_max;
+
+ /*
+ Order everything by the variables' indices. This ensures we get the
+ same key regardless of the order in which the variables are stored
+ and passed around.
+ */
+ v_min =
+ (var_get_dict_index (ca->v1) <
+ var_get_dict_index (ca->v2)) ? ca->v1 : ca->v2;
+ v_max = (ca->v1 == v_min) ? ca->v2 : ca->v1;
+
+ val_min = (v_min == ca->v1) ? ca->val1 : ca->val2;
+ val_max = (ca->val1 == val_min) ? ca->val2 : ca->val1;
+
+ idx_min = var_get_dict_index (v_min);
+ idx_max = var_get_dict_index (v_max);
+
+ if (var_is_numeric (v_max) && var_is_numeric (v_min))
+ {
+ return (*n_vars * idx_max + idx_min);
+ }
+ if (var_is_numeric (v_max) && var_is_alpha (v_min))
+ {
+ return hash_numeric_alpha (v_max, v_min, val_min, *n_vars);
+ }
+ if (var_is_alpha (v_max) && var_is_numeric (v_min))
+ {
+ return (hash_numeric_alpha (v_min, v_max, val_max, *n_vars));
+ }
+ if (var_is_alpha (v_max) && var_is_alpha (v_min))
+ {
+ unsigned tmp = hsh_hash_bytes (val_max, var_get_width (v_max));
+ tmp ^= hsh_hash_bytes (val_min, var_get_width (v_min));
+ tmp += *n_vars * (*n_vars + 1 + idx_max) + idx_min;
+ return (size_t) tmp;
+ }
+ return -1u;
+}
+
+/*
+ Make a hash table consisting of struct covariance_accumulators.
+ This allows the accumulation of the elements of a covariance matrix
+ in a single data pass. Call covariance_accumulate () for each case
+ in the data.
+ */
+static struct hsh_table *
+covariance_hsh_create (size_t *n_vars)
+{
+ return hsh_create (*n_vars * *n_vars, covariance_accumulator_compare,
+ covariance_accumulator_hash, covariance_accumulator_free,
+ n_vars);
+}
+
+static void
+covariance_accumulator_free (void *c_, const void *aux UNUSED)
+{
+ struct covariance_accumulator *c = c_;
+ assert (c != NULL);
+ free (c);
+}
+
+/*
+ Hash comparison. Returns 0 for a match, or a non-zero int
+ otherwise. The sign of a non-zero return value *should* indicate the
+ position of C relative to the covariance_accumulator described by
+ the other arguments. But for now, it just returns 1 for any
+ non-match. This should be changed when someone figures out how to
+ compute a sensible sign for the return value.
+ */
+static int
+match_nodes (const struct covariance_accumulator *c,
+ const struct variable *v1, const struct variable *v2,
+ const union value *val1, const union value *val2)
+{
+ if (var_get_dict_index (v1) == var_get_dict_index (c->v1))
+ if (var_get_dict_index (v2) == var_get_dict_index (c->v2))
+ {
+ if (var_is_numeric (v1) && var_is_numeric (v2))
+ {
+ return 0;
+ }
+ if (var_is_numeric (v1) && var_is_alpha (v2))
+ {
+ if (!compare_values_short (val2, c->val2, v2))
+ {
+ return 0;
+ }
+ }
+ if (var_is_alpha (v1) && var_is_numeric (v2))
+ {
+ if (!compare_values_short (val1, c->val1, v1))
+ {
+ return 0;
+ }
+ }
+ if (var_is_alpha (v1) && var_is_alpha (v2))
+ {
+ if (!compare_values_short (val1, c->val1, v1))
+ {
+ if (!compare_values_short (val2, c->val2, v2))
+ {
+ return 0;
+ }
+ }
+ }
+ }
+ return 1;
+}
+
+/*
+ This function is meant to be used as a comparison function for
+ a struct hsh_table in src/libpspp/hash.c.
+*/
+static int
+covariance_accumulator_compare (const void *a1_, const void *a2_,
+ const void *aux UNUSED)
+{
+ const struct covariance_accumulator *a1 = a1_;
+ const struct covariance_accumulator *a2 = a2_;
+
+ if (a1 == NULL && a2 == NULL)
+ return 0;
+
+ if (a1 == NULL || a2 == NULL)
+ return 1;
+
+ return match_nodes (a1, a2->v1, a2->v2, a2->val1, a2->val2);
+}
+
+static unsigned int
+hash_numeric_alpha (const struct variable *v1, const struct variable *v2,
+ const union value *val, size_t n_vars)
+{
+ unsigned int result = -1u;
+ if (var_is_numeric (v1) && var_is_alpha (v2))
+ {
+ result = n_vars * ((n_vars + 1) + var_get_dict_index (v1))
+ + var_get_dict_index (v2) + hsh_hash_string (val->s);
+ }
+ else if (var_is_alpha (v1) && var_is_numeric (v2))
+ {
+ result = hash_numeric_alpha (v2, v1, val, n_vars);
+ }
+ return result;
+}
+
+
+static double
+update_product (const struct variable *v1, const struct variable *v2,
+ const union value *val1, const union value *val2)
+{
+ assert (v1 != NULL);
+ assert (v2 != NULL);
+ assert (val1 != NULL);
+ assert (val2 != NULL);
+ if (var_is_alpha (v1) && var_is_alpha (v2))
+ {
+ return 1.0;
+ }
+ if (var_is_numeric (v1) && var_is_numeric (v2))
+ {
+ return (val1->f * val2->f);
+ }
+ if (var_is_numeric (v1) && var_is_alpha (v2))
+ {
+ return (val1->f);
+ }
+ if (var_is_numeric (v2) && var_is_alpha (v1))
+ {
+ update_product (v2, v1, val2, val1);
+ }
+ return 0.0;
+}
+static double
+update_sum (const struct variable *var, const union value *val, double weight)
+{
+ assert (var != NULL);
+ assert (val != NULL);
+ if (var_is_alpha (var))
+ {
+ return weight;
+ }
+ return val->f;
+}
+static struct covariance_accumulator *
+get_new_covariance_accumulator (const struct variable *v1,
+ const struct variable *v2,
+ const union value *val1,
+ const union value *val2)
+{
+ if ((v1 != NULL) && (v2 != NULL) && (val1 != NULL) && (val2 != NULL))
+ {
+ struct covariance_accumulator *ca;
+ ca = xmalloc (sizeof (*ca));
+ ca->v1 = v1;
+ ca->v2 = v2;
+ ca->val1 = val1;
+ ca->val2 = val2;
+ return ca;
+ }
+ return NULL;
+}
+
+static const struct variable **
+get_covariance_variables (const struct covariance_matrix *cov)
+{
+ return cov->v_variables;
+}
+
+static void
+update_hash_entry (struct hsh_table *c,
+ const struct variable *v1,
+ const struct variable *v2,
+ const union value *val1, const union value *val2,
+ const struct interaction_value *i_val1,
+ const struct interaction_value *i_val2)
+{
+ struct covariance_accumulator *ca;
+ struct covariance_accumulator *new_entry;
+ double iv_f1;
+ double iv_f2;
+
+ iv_f1 = interaction_value_get_nonzero_entry (i_val1);
+ iv_f2 = interaction_value_get_nonzero_entry (i_val2);
+ ca = get_new_covariance_accumulator (v1, v2, val1, val2);
+ ca->dot_product = update_product (ca->v1, ca->v2, ca->val1, ca->val2);
+ ca->dot_product *= iv_f1 * iv_f2;
+ ca->sum1 = update_sum (ca->v1, ca->val1, iv_f1);
+ ca->sum2 = update_sum (ca->v2, ca->val2, iv_f2);
+ ca->ssize = 1.0;
+ new_entry = hsh_insert (c, ca);
+
+ if (new_entry != NULL)
+ {
+ new_entry->dot_product += ca->dot_product;
+ new_entry->ssize += 1.0;
+ new_entry->sum1 += ca->sum1;
+ new_entry->sum2 += ca->sum2;
+ /*
+ If DOT_PRODUCT is null, CA was not already in the hash
+ hable, so we don't free it because it was just inserted.
+ If DOT_PRODUCT was not null, CA is already in the hash table.
+ Unnecessary now, it must be freed here.
+ */
+ free (ca);
+ }
+}
+
+/*
+ Compute the covariance matrix in a single data-pass. Cases with
+ missing values are dropped pairwise, in other words, only if one of
+ the two values necessary to accumulate the inner product is missing.
+
+ Do not call this function directly. Call it through the struct
+ covariance_matrix ACCUMULATE member function, for example,
+ cov->accumulate (cov, ccase).
+ */
+static void
+covariance_accumulate_pairwise (struct covariance_matrix *cov,
+ const struct ccase *ccase,
+ const struct interaction_variable **i_var,
+ size_t n_intr)
+{
+ size_t i;
+ size_t j;
+ const union value *val1;
+ const union value *val2;
+ const struct variable **v_variables;
+ struct interaction_value *i_val1 = NULL;
+ struct interaction_value *i_val2 = NULL;
+
+ assert (cov != NULL);
+ assert (ccase != NULL);
+
+ v_variables = get_covariance_variables (cov);
+ assert (v_variables != NULL);
+
+ for (i = 0; i < cov->n_variables; ++i)
+ {
+ if (is_interaction (v_variables[i], i_var, n_intr))
+ {
+ i_val1 = interaction_case_data (ccase, v_variables[i], i_var, n_intr);
+ val1 = interaction_value_get (i_val1);
+ }
+ else
+ {
+ val1 = case_data (ccase, v_variables[i]);
+ }
+ if (!var_is_value_missing (v_variables[i], val1, cov->missing_value))
+ {
+ cat_value_update (v_variables[i], val1);
+ if (var_is_numeric (v_variables[i]))
+ cov->update_moments (cov, i, val1->f);
+
+ for (j = i; j < cov->n_variables; j++)
+ {
+ if (is_interaction (v_variables[j], i_var, n_intr))
+ {
+ i_val2 = interaction_case_data (ccase, v_variables[j], i_var, n_intr);
+ val2 = interaction_value_get (i_val2);
+ }
+ else
+ {
+ val2 = case_data (ccase, v_variables[j]);
+ }
+ if (!var_is_value_missing
+ (v_variables[j], val2, cov->missing_value))
+ {
+ update_hash_entry (cov->ca, v_variables[i], v_variables[j],
+ val1, val2, i_val1, i_val2);
+ if (j != i)
+ update_hash_entry (cov->ca, v_variables[j],
+ v_variables[i], val2, val1, i_val2, i_val1);
+ }
+ }
+ }
+ }
+}
+
+/*
+ Compute the covariance matrix in a single data-pass. Cases with
+ missing values are dropped listwise. In other words, if one of the
+ values for any variable in a case is missing, the entire case is
+ skipped.
+
+ The caller must use a casefilter to remove the cases with missing
+ values before calling covariance_accumulate_listwise. This function
+ assumes that CCASE has already passed through this filter, and
+ contains no missing values.
+
+ Do not call this function directly. Call it through the struct
+ covariance_matrix ACCUMULATE member function, for example,
+ cov->accumulate (cov, ccase).
+ */
+static void
+covariance_accumulate_listwise (struct covariance_matrix *cov,
+ const struct ccase *ccase,
+ const struct interaction_variable **i_var,
+ size_t n_intr)
+{
+ size_t i;
+ size_t j;
+ const union value *val1;
+ const union value *val2;
+ const struct variable **v_variables;
+ struct interaction_value *i_val1 = NULL;
+ struct interaction_value *i_val2 = NULL;
+
+ assert (cov != NULL);
+ assert (ccase != NULL);
+
+ v_variables = get_covariance_variables (cov);
+ assert (v_variables != NULL);
+
+ for (i = 0; i < cov->n_variables; ++i)
+ {
+ if (is_interaction (v_variables[i], i_var, n_intr))
+ {
+ i_val1 = interaction_case_data (ccase, v_variables[i], i_var, n_intr);
+ val1 = interaction_value_get (i_val1);
+ }
+ else
+ {
+ val1 = case_data (ccase, v_variables[i]);
+ }
+ cat_value_update (v_variables[i], val1);
+ if (var_is_numeric (v_variables[i]))
+ cov->update_moments (cov, i, val1->f);
+
+ for (j = i; j < cov->n_variables; j++)
+ {
+ if (is_interaction (v_variables[j], i_var, n_intr))
+ {
+ i_val2 = interaction_case_data (ccase, v_variables[j], i_var, n_intr);
+ val2 = interaction_value_get (i_val2);
+ }
+ else
+ {
+ val2 = case_data (ccase, v_variables[j]);
+ }
+ update_hash_entry (cov->ca, v_variables[i], v_variables[j],
+ val1, val2, i_val1, i_val2);
+ if (j != i)
+ update_hash_entry (cov->ca, v_variables[j], v_variables[i],
+ val2, val1, i_val2, i_val1);
+ }
+ }
+}
+
+/*
+ Call this function during the data pass. Each case will be added to
+ a hash containing all values of the covariance matrix. After the
+ data have been passed, call covariance_matrix_compute to put the
+ values in the struct covariance_matrix.
+ */
+void
+covariance_matrix_accumulate (struct covariance_matrix *cov,
+ const struct ccase *ccase, void **aux, size_t n_intr)
+{
+ cov->accumulate (cov, ccase, (const struct interaction_variable **) aux, n_intr);
+}
+/*
+ If VAR is categorical with d categories, its first category should
+ correspond to the origin in d-dimensional Euclidean space.
+ */
+static bool
+is_origin (const struct variable *var, const union value *val)
+{
+ if (cat_value_find (var, val) == 0)
+ {
+ return true;
+ }
+ return false;
+}
+
+/*
+ Return the subscript of the column of the design matrix
+ corresponding to VAL. If VAR is categorical with d categories, its
+ first category should correspond to the origin in d-dimensional
+ Euclidean space, so there is no subscript for this value.
+ */
+static size_t
+get_exact_subscript (const struct design_matrix *dm, const struct variable *var,
+ const union value *val)
+{
+ size_t result;
+
+ if (is_origin (var, val))
+ {
+ return -1u;
+ }
+
+ result = design_matrix_var_to_column (dm, var);
+ if (var_is_alpha (var))
+ {
+ result += cat_value_find (var, val) - 1;
+ }
+ return result;
+}
+
+static void
+covariance_matrix_insert (struct design_matrix *cov,
+ const struct variable *v1,
+ const struct variable *v2, const union value *val1,
+ const union value *val2, double product)
+{
+ size_t row;
+ size_t col;
+
+ assert (cov != NULL);
+
+ row = get_exact_subscript (cov, v1, val1);
+ col = get_exact_subscript (cov, v2, val2);
+ if (row != -1u && col != -1u)
+ {
+ gsl_matrix_set (cov->m, row, col, product);
+ }
+}
+
+
+static bool
+is_covariance_contributor (const struct covariance_accumulator *ca, const struct design_matrix *dm,
+ size_t i, size_t j)
+{
+ size_t k;
+ const struct variable *v1;
+ const struct variable *v2;
+
+ assert (dm != NULL);
+ v1 = design_matrix_col_to_var (dm, i);
+ if (var_get_dict_index (v1) == var_get_dict_index(ca->v1))
+ {
+ v2 = design_matrix_col_to_var (dm, j);
+ if (var_get_dict_index (v2) == var_get_dict_index (ca->v2))
+ {
+ k = get_exact_subscript (dm, v1, ca->val1);
+ if (k == i)
+ {
+ k = get_exact_subscript (dm, v2, ca->val2);
+ if (k == j)
+ {
+ return true;
+ }
+ }
+ }
+ }
+ return false;
+}
+static double
+get_sum (const struct covariance_matrix *cov, size_t i)
+{
+ size_t k;
+ const struct variable *var;
+ const union value *val = NULL;
+ struct covariance_accumulator ca;
+ struct covariance_accumulator *c;
+
+ assert ( cov != NULL);
+ var = design_matrix_col_to_var (cov->cov, i);
+ if (var != NULL)
+ {
+ if (var_is_alpha (var))
+ {
+ k = design_matrix_var_to_column (cov->cov, var);
+ i -= k;
+ val = cat_subscript_to_value (i, var);
+ }
+ ca.v1 = var;
+ ca.v2 = var;
+ ca.val1 = val;
+ ca.val2 = val;
+ c = (struct covariance_accumulator *) hsh_find (cov->ca, &ca);
+ if (c != NULL)
+ {
+ return c->sum1;
+ }
+ }
+ return 0.0;
+}
+static void
+update_ssize (struct design_matrix *dm, size_t i, size_t j, struct covariance_accumulator *ca)
+{
+ struct variable *var;
+ double tmp;
+ var = design_matrix_col_to_var (dm, i);
+ if (var_get_dict_index (ca->v1) == var_get_dict_index (var))
+ {
+ var = design_matrix_col_to_var (dm, j);
+ if (var_get_dict_index (ca->v2) == var_get_dict_index (var))
+ {
+ tmp = gsl_matrix_get (dm->m, i, j);
+ tmp += ca->ssize;
+ gsl_matrix_set (dm->m, i, j, tmp);
+ }
+ }
+}
+static void
+covariance_accumulator_to_matrix (struct covariance_matrix *cov)
+{
+ size_t i;
+ size_t j;
+ double sum_i = 0.0;
+ double sum_j = 0.0;
+ double tmp = 0.0;
+ struct covariance_accumulator *entry;
+ struct hsh_iterator iter;
+
+ cov->cov = covariance_matrix_create (cov->n_variables, cov->v_variables);
+ cov->ssize = covariance_matrix_create (cov->n_variables, cov->v_variables);
+ cov->sums = covariance_matrix_create (cov->n_variables, cov->v_variables);
+ for (i = 0; i < design_matrix_get_n_cols (cov->cov); i++)
+ {
+ sum_i = get_sum (cov, i);
+ for (j = i; j < design_matrix_get_n_cols (cov->cov); j++)
+ {
+ sum_j = get_sum (cov, j);
+ entry = hsh_first (cov->ca, &iter);
+ gsl_matrix_set (cov->sums->m, i, j, sum_i);
+ while (entry != NULL)
+ {
+ update_ssize (cov->ssize, i, j, entry);
+ /*
+ We compute the centered, un-normalized covariance matrix.
+ */
+ if (is_covariance_contributor (entry, cov->cov, i, j))
+ {
+ covariance_matrix_insert (cov->cov, entry->v1, entry->v2, entry->val1,
+ entry->val2, entry->dot_product);
+ }
+ entry = hsh_next (cov->ca, &iter);
+ }
+ tmp = gsl_matrix_get (cov->cov->m, i, j);
+ tmp -= sum_i * sum_j / gsl_matrix_get (cov->ssize->m, i, j);
+ gsl_matrix_set (cov->cov->m, i, j, tmp);
+ }
+ }
+}
+
+
+/*
+ Call this function after passing the data.
+ */
+void
+covariance_matrix_compute (struct covariance_matrix *cov)
+{
+ if (cov->n_pass == ONE_PASS)
+ {
+ covariance_accumulator_to_matrix (cov);
+ }
+}
+
+struct design_matrix *
+covariance_to_design (const struct covariance_matrix *c)
+{
+ if (c != NULL)
+ {
+ return c->cov;
+ }
+ return NULL;
+}