struct matrix_var
{
struct hmap_node hmap_node;
- const char *name;
+ char *name;
gsl_matrix *value;
};
case MOP_COL_INDEX:
for (size_t i = 0; i < e->n_subs; i++)
matrix_expr_destroy (e->subs[i]);
+ free (e->subs);
break;
case MOP_NUMBER:
for (double *D = gsl_matrix_ptr ((M), Y, X); D; D = NULL)
static bool
-is_vector (gsl_matrix *m)
+is_vector (const gsl_matrix *m)
{
return m->size1 <= 1 || m->size2 <= 1;
}
gsl_matrix_set (U, i, j, gsl_matrix_get (A, i, j));
/* two dot products to obtain pseudoinverse */
- tmp_mat = gsl_matrix_alloc (m, n);
- gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1., V, Sigma_pinv, 0., tmp_mat);
+ gsl_matrix *tmp_mat2 = gsl_matrix_alloc (m, n);
+ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1., V, Sigma_pinv, 0., tmp_mat2);
gsl_matrix *A_pinv;
if (swap)
{
A_pinv = gsl_matrix_alloc (n, m);
- gsl_blas_dgemm (CblasNoTrans, CblasTrans, 1., U, tmp_mat, 0., A_pinv);
+ gsl_blas_dgemm (CblasNoTrans, CblasTrans, 1., U, tmp_mat2, 0., A_pinv);
}
else
{
A_pinv = gsl_matrix_alloc (m, n);
- gsl_blas_dgemm (CblasNoTrans, CblasTrans, 1., tmp_mat, U, 0., A_pinv);
+ gsl_blas_dgemm (CblasNoTrans, CblasTrans, 1., tmp_mat2, U, 0., A_pinv);
}
gsl_matrix_free (tmp_mat);
+ gsl_matrix_free (tmp_mat2);
gsl_matrix_free (U);
gsl_matrix_free (Sigma_pinv);
gsl_vector_free (u);
msg (SE, _("Argument to GSCH with dimensions (%zu,%zu) contains only "
"%zu linearly independent columns."),
v->size1, v->size2, ux);
+ gsl_matrix_free (u);
return NULL;
}
static gsl_matrix *
matrix_eval_MDIAG (gsl_vector *v)
{
- gsl_matrix *m = gsl_matrix_alloc (v->size, v->size);
+ gsl_matrix *m = gsl_matrix_calloc (v->size, v->size);
gsl_vector diagonal = gsl_matrix_diagonal (m).vector;
gsl_vector_memcpy (&diagonal, v);
return m;
return rf->reader;
}
+static void
+read_file_destroy (struct read_file *rf)
+{
+ if (rf)
+ {
+ fh_unref (rf->file);
+ dfm_close_reader (rf->reader);
+ free (rf->encoding);
+ free (rf);
+ }
+}
+
static bool
matrix_parse_function (struct matrix_state *s, const char *token,
struct matrix_expr **exprp)
}
long int bl = bf;
- gsl_matrix *tmp = gsl_matrix_alloc (x->size1, x->size2);
- gsl_matrix *y = gsl_matrix_alloc (x->size1, x->size2);
+ gsl_matrix *y_ = gsl_matrix_alloc (x->size1, x->size2);
+ gsl_matrix *y = y_;
gsl_matrix_set_identity (y);
if (bl == 0)
return y;
+ gsl_matrix *t_ = gsl_matrix_alloc (x->size1, x->size2);
+ gsl_matrix *t = t_;
for (unsigned long int n = labs (bl); n > 1; n /= 2)
if (n & 1)
{
- mul_matrix (&y, x, y, &tmp);
- square_matrix (&x, &tmp);
+ mul_matrix (&y, x, y, &t);
+ square_matrix (&x, &t);
}
else
- square_matrix (&x, &tmp);
+ square_matrix (&x, &t);
- mul_matrix (&y, x, y, &tmp);
+ mul_matrix (&y, x, y, &t);
if (bf < 0)
invert_matrix (y);
- if (tmp != x_)
- gsl_matrix_free (tmp);
+ /* Garbage collection.
+
+ There are three matrices: 'x_', 'y_', and 't_', and 'x', 'y', and 't' are
+ a permutation of them. We are returning one of them; that one must not be
+ destroyed. We must not destroy 'x_' because the caller owns it. */
+ if (y != y_)
+ gsl_matrix_free (y_);
+ if (y != t_)
+ gsl_matrix_free (t_);
+
return y;
}
#define INDEX_VECTOR_INIT (struct index_vector) { .n = 0 }
static bool
-matrix_normalize_index_vector (gsl_matrix *m, size_t size,
+matrix_normalize_index_vector (const gsl_matrix *m, size_t size,
enum index_type index_type, size_t other_size,
struct index_vector *iv)
{
return false;
}
- gsl_vector v = to_vector (m);
+ gsl_vector v = to_vector (CONST_CAST (gsl_matrix *, m));
*iv = (struct index_vector) {
.indexes = xnmalloc (v.size, sizeof *iv->indexes),
.n = v.size,
matrix_lvalue_destroy (struct matrix_lvalue *lvalue)
{
if (lvalue)
- for (size_t i = 0; i < lvalue->n_indexes; i++)
- matrix_expr_destroy (lvalue->indexes[i]);
+ {
+ for (size_t i = 0; i < lvalue->n_indexes; i++)
+ matrix_expr_destroy (lvalue->indexes[i]);
+ free (lvalue);
+ }
}
static struct matrix_lvalue *
if (!lvalue->var)
{
msg (SE, _("Undefined variable %s."), lex_tokcstr (s->lexer));
+ free (lvalue);
return NULL;
}
else
m = NULL;
- return matrix_normalize_index_vector (m, size, index_type, other_size, iv);
+ bool ok = matrix_normalize_index_vector (m, size, index_type,
+ other_size, iv);
+ gsl_matrix_free (m);
+ return ok;
}
static bool
matrix_lvalue_evaluate_and_assign (struct matrix_lvalue *lvalue, gsl_matrix *sm)
{
struct index_vector iv0, iv1;
- return (matrix_lvalue_evaluate (lvalue, &iv0, &iv1)
- && matrix_lvalue_assign (lvalue, &iv0, &iv1, sm));
+ if (!matrix_lvalue_evaluate (lvalue, &iv0, &iv1))
+ {
+ gsl_matrix_free (sm);
+ return false;
+ }
+
+ return matrix_lvalue_assign (lvalue, &iv0, &iv1, sm);
}
\f
size_t n;
};
+static void matrix_cmds_uninit (struct matrix_cmds *);
+
struct matrix_cmd
{
enum matrix_cmd_type
}
loop;
+ struct display_command
+ {
+ struct matrix_state *state;
+ bool dictionary;
+ bool status;
+ }
+ display;
+
+ struct release_command
+ {
+ struct matrix_var **vars;
+ size_t n_vars;
+ }
+ release;
+
struct save_command
{
struct matrix_expr *expression;
}
write;
- struct display_command
- {
- struct matrix_state *state;
- bool dictionary;
- bool status;
- }
- display;
-
- struct release_command
- {
- struct matrix_var **vars;
- size_t n_vars;
- }
- release;
-
struct get_command
{
struct matrix_lvalue *dst;
static struct matrix_cmd *matrix_parse_command (struct matrix_state *);
static bool matrix_cmd_execute (struct matrix_cmd *);
+static void matrix_cmd_destroy (struct matrix_cmd *);
-static void
-matrix_cmd_destroy (struct matrix_cmd *cmd)
-{
- /* XXX */
- free (cmd);
-}
\f
static struct matrix_cmd *
matrix_parse_compute (struct matrix_state *s)
}
string_array_destroy (rlabels);
+ free (rlabels);
string_array_destroy (clabels);
+ free (clabels);
}
static void
if (!labels)
d->hide_all_labels = true;
string_array_destroy (labels);
+ free (labels);
}
static void
{
gsl_matrix *At = gsl_matrix_alloc (m->size2, m->size1);
gsl_matrix_transpose_memcpy (At, m);
+ gsl_matrix_free (m);
+
gsl_matrix *Vt = gsl_matrix_alloc (At->size2, At->size2);
gsl_matrix *St = gsl_matrix_calloc (At->size2, At->size2);
gsl_vector Stv = gsl_matrix_diagonal (St).vector;
return true;
}
+static void
+matrix_cmds_uninit (struct matrix_cmds *cmds)
+{
+ for (size_t i = 0; i < cmds->n; i++)
+ matrix_cmd_destroy (cmds->commands[i]);
+ free (cmds->commands);
+}
+
+static void
+matrix_cmd_destroy (struct matrix_cmd *cmd)
+{
+ if (!cmd)
+ return;
+
+ switch (cmd->type)
+ {
+ case MCMD_COMPUTE:
+ matrix_lvalue_destroy (cmd->compute.lvalue);
+ matrix_expr_destroy (cmd->compute.rvalue);
+ break;
+
+ case MCMD_PRINT:
+ matrix_expr_destroy (cmd->print.expression);
+ free (cmd->print.title);
+ print_labels_destroy (cmd->print.rlabels);
+ print_labels_destroy (cmd->print.clabels);
+ break;
+
+ case MCMD_DO_IF:
+ for (size_t i = 0; i < cmd->do_if.n_clauses; i++)
+ {
+ matrix_expr_destroy (cmd->do_if.clauses[i].condition);
+ matrix_cmds_uninit (&cmd->do_if.clauses[i].commands);
+ }
+ free (cmd->do_if.clauses);
+ break;
+
+ case MCMD_LOOP:
+ matrix_expr_destroy (cmd->loop.start);
+ matrix_expr_destroy (cmd->loop.end);
+ matrix_expr_destroy (cmd->loop.increment);
+ matrix_expr_destroy (cmd->loop.top_condition);
+ matrix_expr_destroy (cmd->loop.bottom_condition);
+ matrix_cmds_uninit (&cmd->loop.commands);
+ break;
+
+ case MCMD_BREAK:
+ break;
+
+ case MCMD_DISPLAY:
+ break;
+
+ case MCMD_RELEASE:
+ free (cmd->release.vars);
+ break;
+
+ case MCMD_SAVE:
+ matrix_expr_destroy (cmd->save.expression);
+ fh_unref (cmd->save.outfile);
+ string_array_destroy (cmd->save.variables);
+ matrix_expr_destroy (cmd->save.names);
+ stringi_set_destroy (&cmd->save.strings);
+ break;
+
+ case MCMD_READ:
+ matrix_lvalue_destroy (cmd->read.dst);
+ matrix_expr_destroy (cmd->read.size);
+ break;
+
+ case MCMD_WRITE:
+ matrix_expr_destroy (cmd->write.expression);
+ free (cmd->write.encoding);
+ break;
+
+ case MCMD_GET:
+ matrix_lvalue_destroy (cmd->get.dst);
+ fh_unref (cmd->get.file);
+ free (cmd->get.encoding);
+ string_array_destroy (&cmd->get.variables);
+ break;
+
+ case MCMD_MSAVE:
+ free (cmd->msave.varname_);
+ matrix_expr_destroy (cmd->msave.expr);
+ matrix_expr_destroy (cmd->msave.factors);
+ matrix_expr_destroy (cmd->msave.splits);
+ break;
+
+ case MCMD_MGET:
+ fh_unref (cmd->mget.file);
+ stringi_set_destroy (&cmd->mget.rowtypes);
+ break;
+
+ case MCMD_EIGEN:
+ matrix_expr_destroy (cmd->eigen.expr);
+ break;
+
+ case MCMD_SETDIAG:
+ matrix_expr_destroy (cmd->setdiag.expr);
+ break;
+
+ case MCMD_SVD:
+ matrix_expr_destroy (cmd->svd.expr);
+ break;
+ }
+ free (cmd);
+}
+
struct matrix_command_name
{
const char *name;
}
}
+ struct matrix_var *var, *next;
+ HMAP_FOR_EACH_SAFE (var, next, struct matrix_var, hmap_node, &state.vars)
+ {
+ free (var->name);
+ gsl_matrix_free (var->value);
+ hmap_delete (&state.vars, &var->hmap_node);
+ free (var);
+ }
+ hmap_destroy (&state.vars);
+ fh_unref (state.prev_save_outfile);
+ fh_unref (state.prev_write_outfile);
if (state.common)
{
dict_unref (state.common->dict);
casewriter_destroy (state.common->writer);
free (state.common);
}
+ fh_unref (state.prev_read_file);
+ for (size_t i = 0; i < state.n_read_files; i++)
+ read_file_destroy (state.read_files[i]);
+ free (state.read_files);
return CMD_SUCCESS;
}
projects / pspp / commitdiff