1 |
/* PSPP - linear regression. |
/* PSPP - binary encodings for categorical variables. |
2 |
Copyright (C) 2005 Free Software Foundation, Inc. |
Copyright (C) 2005 Free Software Foundation, Inc. |
3 |
Written by Jason H Stover <jason@sakla.net>. |
Written by Jason H Stover <jason@sakla.net>. |
4 |
|
|
36 |
#include <error.h> |
#include <error.h> |
37 |
#include "alloc.h" |
#include "alloc.h" |
38 |
#include "error.h" |
#include "error.h" |
|
#include "var.h" |
|
39 |
#include "cat.h" |
#include "cat.h" |
40 |
|
#include "cat-routines.h" |
41 |
#include <string.h> |
#include <string.h> |
|
#include <math.h> |
|
|
#include <gsl/gsl_machine.h> |
|
|
#include <gsl/gsl_vector.h> |
|
|
#include <gsl/gsl_matrix.h> |
|
42 |
|
|
43 |
#define N_INITIAL_CATEGORIES 1 |
#define N_INITIAL_CATEGORIES 1 |
|
#define CAT_COLUMN_NOT_FOUND -1 |
|
|
#define CAT_VALUE_NOT_FOUND -2 |
|
|
#define CAT_INDEX_NOT_FOUND -3 |
|
44 |
|
|
45 |
void |
void |
46 |
cat_stored_values_create (struct variable *v) |
cat_stored_values_create (struct variable *v) |
65 |
} |
} |
66 |
} |
} |
67 |
|
|
68 |
static size_t |
/* |
69 |
|
Which subscript corresponds to val? |
70 |
|
*/ |
71 |
|
size_t |
72 |
cat_value_find (const struct variable *v, const union value *val) |
cat_value_find (const struct variable *v, const union value *val) |
73 |
{ |
{ |
74 |
size_t i; |
size_t i; |
117 |
} |
} |
118 |
} |
} |
119 |
|
|
|
/* |
|
|
Return the subscript of the binary vector corresponding |
|
|
to this value. |
|
|
*/ |
|
|
size_t |
|
|
cat_value_to_subscript (const union value *val, struct variable *v) |
|
|
{ |
|
|
const union value *val2; |
|
|
size_t subscript; |
|
|
int different; |
|
|
|
|
|
assert (v != NULL); |
|
|
assert (val != NULL); |
|
|
assert (v->obs_vals != NULL); |
|
|
subscript = v->obs_vals->n_categories - 1; |
|
|
while (subscript > 0) |
|
|
{ |
|
|
val2 = v->obs_vals->vals + subscript; |
|
|
assert (val2 != NULL); |
|
|
different = compare_values (val, val2, v->width); |
|
|
if (!different) |
|
|
{ |
|
|
return subscript; |
|
|
} |
|
|
subscript--; |
|
|
} |
|
|
return subscript; |
|
|
} |
|
|
|
|
120 |
union value * |
union value * |
121 |
cat_subscript_to_value (const size_t s, struct variable *v) |
cat_subscript_to_value (const size_t s, struct variable *v) |
122 |
{ |
{ |
130 |
return NULL; |
return NULL; |
131 |
} |
} |
132 |
} |
} |
|
|
|
|
/* |
|
|
Which element of a vector is equal to the value x? |
|
|
*/ |
|
|
static size_t |
|
|
cat_which_element_eq (const gsl_vector * vec, double x) |
|
|
{ |
|
|
size_t i; |
|
|
|
|
|
for (i = 0; i < vec->size; i++) |
|
|
{ |
|
|
if (fabs (gsl_vector_get (vec, i) - x) < GSL_DBL_EPSILON) |
|
|
{ |
|
|
return i; |
|
|
} |
|
|
} |
|
|
return CAT_VALUE_NOT_FOUND; |
|
|
} |
|
|
static int |
|
|
cat_is_zero_vector (const gsl_vector * vec) |
|
|
{ |
|
|
size_t i; |
|
|
|
|
|
for (i = 0; i < vec->size; i++) |
|
|
{ |
|
|
if (gsl_vector_get (vec, i) != 0.0) |
|
|
{ |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
return 1; |
|
|
} |
|
|
|
|
|
/* |
|
|
Return the value of v corresponding to the vector vec. |
|
|
*/ |
|
|
union value * |
|
|
cat_vector_to_value (const gsl_vector * vec, struct variable *v) |
|
|
{ |
|
|
size_t i; |
|
|
|
|
|
i = cat_which_element_eq (vec, 1.0); |
|
|
if (i != CAT_VALUE_NOT_FOUND) |
|
|
{ |
|
|
return cat_subscript_to_value (i + 1, v); |
|
|
} |
|
|
if (cat_is_zero_vector (vec)) |
|
|
{ |
|
|
return cat_subscript_to_value (0, v); |
|
|
} |
|
|
return NULL; |
|
|
} |
|
|
|
|
|
struct design_matrix * |
|
|
design_matrix_create (int n_variables, |
|
|
const struct variable *v_variables[], |
|
|
const size_t n_data) |
|
|
{ |
|
|
struct design_matrix *dm; |
|
|
const struct variable *v; |
|
|
size_t i; |
|
|
size_t n_cols = 0; |
|
|
size_t col; |
|
|
|
|
|
dm = xmalloc (sizeof *dm); |
|
|
dm->vars = xnmalloc (n_variables, sizeof *dm->vars); |
|
|
dm->n_vars = n_variables; |
|
|
|
|
|
for (i = 0; i < n_variables; i++) |
|
|
{ |
|
|
v = v_variables[i]; |
|
|
assert ((dm->vars + i) != NULL); |
|
|
(dm->vars + i)->v = v; /* Allows us to look up the variable from |
|
|
the design matrix. */ |
|
|
(dm->vars + i)->first_column = n_cols; |
|
|
if (v->type == NUMERIC) |
|
|
{ |
|
|
n_cols++; |
|
|
(dm->vars + i)->last_column = n_cols; |
|
|
} |
|
|
else if (v->type == ALPHA) |
|
|
{ |
|
|
assert (v->obs_vals != NULL); |
|
|
(dm->vars + i)->last_column = |
|
|
(dm->vars + i)->first_column + v->obs_vals->n_categories - 2; |
|
|
n_cols += v->obs_vals->n_categories - 1; |
|
|
} |
|
|
} |
|
|
dm->m = gsl_matrix_calloc (n_data, n_cols); |
|
|
col = 0; |
|
|
|
|
|
return dm; |
|
|
} |
|
|
|
|
|
void |
|
|
design_matrix_destroy (struct design_matrix *dm) |
|
|
{ |
|
|
free (dm->vars); |
|
|
gsl_matrix_free (dm->m); |
|
|
free (dm); |
|
|
} |
|
|
|
|
|
/* |
|
|
Return the index of the variable for the |
|
|
given column. |
|
|
*/ |
|
|
static size_t |
|
|
design_matrix_col_to_var_index (const struct design_matrix *dm, size_t col) |
|
|
{ |
|
|
size_t i; |
|
|
struct design_matrix_var v; |
|
|
|
|
|
for (i = 0; i < dm->n_vars; i++) |
|
|
{ |
|
|
v = dm->vars[i]; |
|
|
if (v.first_column <= col && col <= v.last_column) |
|
|
return (v.v)->index; |
|
|
} |
|
|
return CAT_INDEX_NOT_FOUND; |
|
|
} |
|
|
|
|
|
/* |
|
|
Return a pointer to the variable whose values |
|
|
are stored in column col. |
|
|
*/ |
|
|
struct variable * |
|
|
design_matrix_col_to_var (const struct design_matrix *dm, size_t col) |
|
|
{ |
|
|
size_t index; |
|
|
size_t i; |
|
|
struct design_matrix_var dmv; |
|
|
|
|
|
index = design_matrix_col_to_var_index (dm, col); |
|
|
for (i = 0; i < dm->n_vars; i++) |
|
|
{ |
|
|
dmv = dm->vars[i]; |
|
|
if ((dmv.v)->index == index) |
|
|
{ |
|
|
return (struct variable *) dmv.v; |
|
|
} |
|
|
} |
|
|
return NULL; |
|
|
} |
|
|
|
|
|
static size_t |
|
|
cmp_dm_var_index (const struct design_matrix_var *dmv, size_t index) |
|
|
{ |
|
|
if (dmv->v->index == index) |
|
|
return 1; |
|
|
return 0; |
|
|
} |
|
|
|
|
|
/* |
|
|
Return the number of the first column which holds the |
|
|
values for variable v. |
|
|
*/ |
|
|
size_t |
|
|
design_matrix_var_to_column (const struct design_matrix * dm, |
|
|
const struct variable * v) |
|
|
{ |
|
|
size_t i; |
|
|
struct design_matrix_var tmp; |
|
|
|
|
|
for (i = 0; i < dm->n_vars; i++) |
|
|
{ |
|
|
tmp = dm->vars[i]; |
|
|
if (cmp_dm_var_index (&tmp, v->index)) |
|
|
{ |
|
|
return tmp.first_column; |
|
|
} |
|
|
} |
|
|
return CAT_COLUMN_NOT_FOUND; |
|
|
} |
|
|
|
|
|
/* Last column. */ |
|
|
static size_t |
|
|
dm_var_to_last_column (const struct design_matrix *dm, |
|
|
const struct variable *v) |
|
|
{ |
|
|
size_t i; |
|
|
struct design_matrix_var tmp; |
|
|
|
|
|
for (i = 0; i < dm->n_vars; i++) |
|
|
{ |
|
|
tmp = dm->vars[i]; |
|
|
if (cmp_dm_var_index (&tmp, v->index)) |
|
|
{ |
|
|
return tmp.last_column; |
|
|
} |
|
|
} |
|
|
return CAT_COLUMN_NOT_FOUND; |
|
|
} |
|
|
|
|
|
/* |
|
|
Set the appropriate value in the design matrix, |
|
|
whether that value is from a categorical or numeric |
|
|
variable. For a categorical variable, only the usual |
|
|
binary encoding is allowed. |
|
|
*/ |
|
|
void |
|
|
design_matrix_set_categorical (struct design_matrix *dm, size_t row, |
|
|
const struct variable *var, |
|
|
const union value *val) |
|
|
{ |
|
|
size_t col; |
|
|
size_t is_one; |
|
|
size_t fc; |
|
|
size_t lc; |
|
|
double entry; |
|
|
|
|
|
assert (var->type == ALPHA); |
|
|
fc = design_matrix_var_to_column (dm, var); |
|
|
lc = dm_var_to_last_column (dm, var); |
|
|
assert (lc != CAT_COLUMN_NOT_FOUND); |
|
|
assert (fc != CAT_COLUMN_NOT_FOUND); |
|
|
is_one = fc + cat_value_find (var, val); |
|
|
for (col = fc; col <= lc; col++) |
|
|
{ |
|
|
entry = (col == is_one) ? 1.0 : 0.0; |
|
|
gsl_matrix_set (dm->m, row, col, entry); |
|
|
} |
|
|
} |
|
|
void |
|
|
design_matrix_set_numeric (struct design_matrix *dm, size_t row, |
|
|
const struct variable *var, const union value *val) |
|
|
{ |
|
|
size_t col; |
|
|
|
|
|
assert (var->type == NUMERIC); |
|
|
col = design_matrix_var_to_column ((const struct design_matrix *) dm, var); |
|
|
assert (col != CAT_COLUMN_NOT_FOUND); |
|
|
gsl_matrix_set (dm->m, row, col, val->f); |
|
|
} |
|