[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Pspp-cvs] pspp/src regression.q
From: |
Jason H Stover |
Subject: |
[Pspp-cvs] pspp/src regression.q |
Date: |
Thu, 15 Dec 2005 22:52:45 +0000 |
CVSROOT: /sources/pspp
Module name: pspp
Branch:
Changes by: Jason H Stover <address@hidden> 05/12/15 22:23:32
Modified files:
src : regression.q
Log message:
Subcommand to export a model as a C function
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/pspp/pspp/src/regression.q.diff?tr1=1.18&tr2=1.19&r1=text&r2=text
Patches:
Index: pspp/src/regression.q
diff -u pspp/src/regression.q:1.18 pspp/src/regression.q:1.19
--- pspp/src/regression.q:1.18 Mon Nov 28 02:37:26 2005
+++ pspp/src/regression.q Thu Dec 15 22:23:18 2005
@@ -44,7 +44,6 @@
/* (headers) */
-
/* (specification)
"REGRESSION" (regression_):
*variables=varlist;
@@ -65,6 +64,7 @@
f,
defaults,
all;
+ export=custom;
^dependent=varlist;
^method=enter.
*/
@@ -78,6 +78,12 @@
size_t *indep_vars;
/*
+ File where the model will be saved if the EXPORT subcommand
+ is given.
+ */
+struct file_handle *model_file;
+
+/*
Return value for the procedure.
*/
int pspp_reg_rc = CMD_SUCCESS;
@@ -465,6 +471,69 @@
statistics_keyword_output (reg_stats_tol, keywords[tol], c);
statistics_keyword_output (reg_stats_selection, keywords[selection], c);
}
+static void
+subcommand_export (int export, pspp_linreg_cache *c)
+{
+ FILE *fp;
+ size_t i;
+ struct pspp_linreg_coeff coeff;
+
+ if (export)
+ {
+ assert (c != NULL);
+ assert (model_file != NULL);
+ assert (fp != NULL);
+ fp = fopen (handle_get_filename (model_file), "w");
+ fprintf (fp, "/* PSPP-generated linear regression model.\n Copyright
(C) 2005 Free Software Foundation, Inc.\n Generated by the GNU PSPP
regression procedure.\n\n This program is free software; you can redistribute
it and/or\n modify it under the terms of the GNU General Public License as\n
published by the Free Software Foundation; either version 2 of the\n
License, or (at your option) any later version.\n\n This program is
distributed in the hope that it will be useful, but\n WITHOUT ANY WARRANTY;
without even the implied warranty of\n MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU\n General Public License for more
details.\n\n You should have received a copy of the GNU General Public
License\n along with GNU PSPP; if not, write to the Free Software\n
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA\n 02110-1301,
USA. */\n\n");
+ fprintf (fp, "#include <string.h>\n\n");
+ fprintf (fp, "double\npspp_reg_estimate (const double *var_vals, conts
char *[] var_names)\n{\n\tchar *model_depvars[%d] = {", c->n_indeps);
+ for (i = 1; i < c->n_indeps; i++)
+ {
+ coeff = c->coeff[i];
+ fprintf (fp, "%s,\n\t\t", coeff.v->name);
+ }
+ coeff = c->coeff[i];
+ fprintf (fp, "%s};\n\t", coeff.v->name);
+ fprintf (fp, "double model_coeffs[%d] = {", c->n_indeps);
+ for (i = 1; i < c->n_indeps; i++)
+ {
+ coeff = c->coeff[i];
+ fprintf (fp, "%.15e,\n\t\t", coeff.estimate);
+ }
+ coeff = c->coeff[i];
+ fprintf (fp, "%.15e};\n\t", coeff.estimate);
+ coeff = c->coeff[0];
+ fprintf (fp, "double estimate = %.15e\n\t", coeff.estimate);
+ fprintf (fp, "int i;\n\tint j;\n\n\t");
+ fprintf (fp, "for (i = 0; i < %d; i++)\n\t", c->n_indeps);
+ fprintf (fp, "{\n\t\tfor (j = 0; j < %d; j++)\n\t\t", c->n_indeps);
+ fprintf (fp, "{\n\t\t\tif (strcmp (var_names[i], model_names[j]) ==
0)\n");
+ fprintf (fp, "\t\t\t{\n\t\t\t\testimate += var_vals[i] *
model_coeffs[j];\n");
+ fprintf (fp, "\t\t\t}\n\t\t}\n\t}\n\treturn estimate;\n}\n");
+ fclose (fp);
+ }
+}
+static int
+regression_custom_export (struct cmd_regression *cmd)
+{
+ /* 0 on failure, 1 on success, 2 on failure that should result in syntax
error */
+ if (!lex_force_match ('('))
+ return 0;
+
+ if (lex_match ('*'))
+ model_file = NULL;
+ else
+ {
+ model_file = fh_parse ();
+ if (model_file == NULL)
+ return 0;
+ }
+
+ if (!lex_force_match (')'))
+ return 0;
+
+ return 1;
+}
int
cmd_regression (void)
@@ -656,8 +725,9 @@
/*
Find the least-squares estimates and other statistics.
*/
- pspp_linreg ((const gsl_vector *) Y, X->m, &lopts, lcache);
+ pspp_linreg ((const gsl_vector *) Y, X->m, &lopts, lcache);
subcommand_statistics (cmd.a_statistics, lcache);
+ subcommand_export (cmd.sbc_export, lcache);
gsl_vector_free (Y);
design_matrix_destroy (X);
pspp_linreg_cache_free (lcache);
- [Pspp-cvs] pspp/src regression.q,
Jason H Stover <=
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/15
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/15
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/16
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/17
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/18
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/18
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/19
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/26
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/29
- [Pspp-cvs] pspp/src regression.q, Jason H Stover, 2005/12/30