Clean up how transformations work.
[pspp] / src / language / stats / regression.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 2005, 2009, 2010, 2011, 2012, 2013, 2014,
3    2016, 2017, 2019 Free Software Foundation, Inc.
4
5    This program is free software: you can redistribute it and/or modify
6    it under the terms of the GNU General Public License as published by
7    the Free Software Foundation, either version 3 of the License, or
8    (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13    GNU General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
17
18 #include <config.h>
19
20 #include <float.h>
21 #include <stdbool.h>
22
23 #include <gsl/gsl_math.h>
24 #include <gsl/gsl_cdf.h>
25 #include <gsl/gsl_matrix.h>
26
27 #include <data/dataset.h>
28 #include <data/casewriter.h>
29
30 #include "language/command.h"
31 #include "language/lexer/lexer.h"
32 #include "language/lexer/value-parser.h"
33 #include "language/lexer/variable-parser.h"
34
35
36 #include "data/casegrouper.h"
37 #include "data/casereader.h"
38 #include "data/dictionary.h"
39
40 #include "math/covariance.h"
41 #include "math/linreg.h"
42 #include "math/moments.h"
43
44 #include "libpspp/message.h"
45 #include "libpspp/taint.h"
46
47 #include "output/pivot-table.h"
48
49 #include "gl/intprops.h"
50 #include "gl/minmax.h"
51
52 #include "gettext.h"
53 #define _(msgid) gettext (msgid)
54 #define N_(msgid) msgid
55
56
57 #define STATS_R      1
58 #define STATS_COEFF  2
59 #define STATS_ANOVA  4
60 #define STATS_OUTS   8
61 #define STATS_CI    16
62 #define STATS_BCOV  32
63 #define STATS_TOL   64
64
65 #define STATS_DEFAULT  (STATS_R | STATS_COEFF | STATS_ANOVA | STATS_OUTS)
66
67
68
69 struct regression
70 {
71   struct dataset *ds;
72
73   const struct variable **vars;
74   size_t n_vars;
75
76   const struct variable **dep_vars;
77   size_t n_dep_vars;
78
79   unsigned int stats;
80   double ci;
81
82   bool resid;
83   bool pred;
84
85   bool origin;
86 };
87
88 struct regression_workspace
89 {
90   /* The new variables which will be introduced by /SAVE */
91   const struct variable **predvars;
92   const struct variable **residvars;
93
94   /* A reader/writer pair to temporarily hold the
95      values of the new variables */
96   struct casewriter *writer;
97   struct casereader *reader;
98
99   /* Indeces of the new values in the reader/writer (-1 if not applicable) */
100   int res_idx;
101   int pred_idx;
102
103   /* 0, 1 or 2 depending on what new variables are to be created */
104   int extras;
105 };
106
107 static void run_regression (const struct regression *cmd,
108                             struct regression_workspace *ws,
109                             struct casereader *input);
110
111
112 /* Return a string based on PREFIX which may be used as the name
113    of a new variable in DICT */
114 static char *
115 reg_get_name (const struct dictionary *dict, const char *prefix)
116 {
117   char *name;
118   int i;
119
120   /* XXX handle too-long prefixes */
121   name = xmalloc (strlen (prefix) + INT_BUFSIZE_BOUND (i) + 1);
122   for (i = 1;; i++)
123     {
124       sprintf (name, "%s%d", prefix, i);
125       if (dict_lookup_var (dict, name) == NULL)
126         return name;
127     }
128 }
129
130
131 static const struct variable *
132 create_aux_var (struct dataset *ds, const char *prefix)
133 {
134   struct variable *var;
135   struct dictionary *dict = dataset_dict (ds);
136   char *name = reg_get_name (dict, prefix);
137   var = dict_create_var_assert (dict, name, 0);
138   free (name);
139   return var;
140 }
141
142 /* Auxiliary data for transformation when /SAVE is entered */
143 struct save_trans_data
144 {
145   int n_dep_vars;
146   struct regression_workspace *ws;
147 };
148
149 static bool
150 save_trans_free (void *aux)
151 {
152   struct save_trans_data *save_trans_data = aux;
153   free (save_trans_data->ws->predvars);
154   free (save_trans_data->ws->residvars);
155
156   casereader_destroy (save_trans_data->ws->reader);
157   free (save_trans_data->ws);
158   free (save_trans_data);
159   return true;
160 }
161
162 static enum trns_result
163 save_trans_func (void *aux, struct ccase **c, casenumber x UNUSED)
164 {
165   struct save_trans_data *save_trans_data = aux;
166   struct regression_workspace *ws = save_trans_data->ws;
167   struct ccase *in =  casereader_read (ws->reader);
168
169   if (in)
170     {
171       int k;
172       *c = case_unshare (*c);
173
174       for (k = 0; k < save_trans_data->n_dep_vars; ++k)
175         {
176           if (ws->pred_idx != -1)
177             {
178               double pred = case_num_idx (in, ws->extras * k + ws->pred_idx);
179               *case_num_rw (*c, ws->predvars[k]) = pred;
180             }
181
182           if (ws->res_idx != -1)
183             {
184               double resid = case_num_idx (in, ws->extras * k + ws->res_idx);
185               *case_num_rw (*c, ws->residvars[k]) = resid;
186             }
187         }
188       case_unref (in);
189     }
190
191   return TRNS_CONTINUE;
192 }
193
194 int
195 cmd_regression (struct lexer *lexer, struct dataset *ds)
196 {
197   struct regression_workspace workspace;
198   struct regression regression;
199   const struct dictionary *dict = dataset_dict (ds);
200   bool save;
201
202   memset (&regression, 0, sizeof (struct regression));
203
204   regression.ci = 0.95;
205   regression.stats = STATS_DEFAULT;
206   regression.pred = false;
207   regression.resid = false;
208
209   regression.ds = ds;
210   regression.origin = false;
211
212   bool variables_seen = false;
213   bool method_seen = false;
214   bool dependent_seen = false;
215   while (lex_token (lexer) != T_ENDCMD)
216     {
217       lex_match (lexer, T_SLASH);
218
219       if (lex_match_id (lexer, "VARIABLES"))
220         {
221           if (method_seen)
222             {
223               msg (SE, _("VARIABLES may not appear after %s"), "METHOD");
224               goto error;
225             }
226           if (dependent_seen)
227             {
228               msg (SE, _("VARIABLES may not appear after %s"), "DEPENDENT");
229               goto error;
230             }
231           variables_seen = true;
232           lex_match (lexer, T_EQUALS);
233
234           if (!parse_variables_const (lexer, dict,
235                                       &regression.vars, &regression.n_vars,
236                                       PV_NO_DUPLICATE | PV_NUMERIC))
237             goto error;
238         }
239       else if (lex_match_id (lexer, "DEPENDENT"))
240         {
241           dependent_seen = true;
242           lex_match (lexer, T_EQUALS);
243
244           free (regression.dep_vars);
245           regression.n_dep_vars = 0;
246
247           if (!parse_variables_const (lexer, dict,
248                                       &regression.dep_vars,
249                                       &regression.n_dep_vars,
250                                       PV_NO_DUPLICATE | PV_NUMERIC))
251             goto error;
252         }
253       else if (lex_match_id (lexer, "ORIGIN"))
254         {
255           regression.origin = true;
256         }
257       else if (lex_match_id (lexer, "NOORIGIN"))
258         {
259           regression.origin = false;
260         }
261       else if (lex_match_id (lexer, "METHOD"))
262         {
263           method_seen = true;
264           lex_match (lexer, T_EQUALS);
265
266           if (!lex_force_match_id (lexer, "ENTER"))
267             {
268               goto error;
269             }
270
271           if (! variables_seen)
272             {
273               if (!parse_variables_const (lexer, dict,
274                                           &regression.vars, &regression.n_vars,
275                                           PV_NO_DUPLICATE | PV_NUMERIC))
276                 goto error;
277             }
278         }
279       else if (lex_match_id (lexer, "STATISTICS"))
280         {
281           unsigned long statistics = 0;
282           lex_match (lexer, T_EQUALS);
283
284           while (lex_token (lexer) != T_ENDCMD
285                  && lex_token (lexer) != T_SLASH)
286             {
287               if (lex_match (lexer, T_ALL))
288                 {
289                   statistics = ~0;
290                 }
291               else if (lex_match_id (lexer, "DEFAULTS"))
292                 {
293                   statistics |= STATS_DEFAULT;
294                 }
295               else if (lex_match_id (lexer, "R"))
296                 {
297                   statistics |= STATS_R;
298                 }
299               else if (lex_match_id (lexer, "COEFF"))
300                 {
301                   statistics |= STATS_COEFF;
302                 }
303               else if (lex_match_id (lexer, "ANOVA"))
304                 {
305                   statistics |= STATS_ANOVA;
306                 }
307               else if (lex_match_id (lexer, "BCOV"))
308                 {
309                   statistics |= STATS_BCOV;
310                 }
311               else if (lex_match_id (lexer, "TOL"))
312                 {
313                   statistics |= STATS_TOL;
314                 }
315               else if (lex_match_id (lexer, "CI"))
316                 {
317                   statistics |= STATS_CI;
318
319                   if (lex_match (lexer, T_LPAREN) &&
320                       lex_force_num (lexer))
321                     {
322                       regression.ci = lex_number (lexer) / 100.0;
323                       lex_get (lexer);
324                       if (! lex_force_match (lexer, T_RPAREN))
325                         goto error;
326                     }
327                 }
328               else
329                 {
330                   lex_error (lexer, NULL);
331                   goto error;
332                 }
333             }
334
335           if (statistics)
336             regression.stats = statistics;
337
338         }
339       else if (lex_match_id (lexer, "SAVE"))
340         {
341           lex_match (lexer, T_EQUALS);
342
343           while (lex_token (lexer) != T_ENDCMD
344                  && lex_token (lexer) != T_SLASH)
345             {
346               if (lex_match_id (lexer, "PRED"))
347                 {
348                   regression.pred = true;
349                 }
350               else if (lex_match_id (lexer, "RESID"))
351                 {
352                   regression.resid = true;
353                 }
354               else
355                 {
356                   lex_error (lexer, NULL);
357                   goto error;
358                 }
359             }
360         }
361       else
362         {
363           lex_error (lexer, NULL);
364           goto error;
365         }
366     }
367
368   if (!regression.vars)
369     {
370       dict_get_vars (dict, &regression.vars, &regression.n_vars, 0);
371     }
372
373   save = regression.pred || regression.resid;
374   workspace.extras = 0;
375   workspace.res_idx = -1;
376   workspace.pred_idx = -1;
377   workspace.writer = NULL;
378   workspace.reader = NULL;
379   workspace.residvars = NULL;
380   workspace.predvars = NULL;
381   if (save)
382     {
383       int i;
384       struct caseproto *proto = caseproto_create ();
385
386       if (regression.resid)
387         {
388           workspace.res_idx = workspace.extras ++;
389           workspace.residvars = xcalloc (regression.n_dep_vars, sizeof (*workspace.residvars));
390
391           for (i = 0; i < regression.n_dep_vars; ++i)
392             {
393               workspace.residvars[i] = create_aux_var (ds, "RES");
394               proto = caseproto_add_width (proto, 0);
395             }
396         }
397
398       if (regression.pred)
399         {
400           workspace.pred_idx = workspace.extras ++;
401           workspace.predvars = xcalloc (regression.n_dep_vars, sizeof (*workspace.predvars));
402
403           for (i = 0; i < regression.n_dep_vars; ++i)
404             {
405               workspace.predvars[i] = create_aux_var (ds, "PRED");
406               proto = caseproto_add_width (proto, 0);
407             }
408         }
409
410       if (proc_make_temporary_transformations_permanent (ds))
411         msg (SW, _("REGRESSION with SAVE ignores TEMPORARY.  "
412                    "Temporary transformations will be made permanent."));
413
414       if (dict_get_filter (dict))
415         msg (SW, _("REGRESSION with SAVE ignores FILTER.  "
416                    "All cases will be processed."));
417
418       workspace.writer = autopaging_writer_create (proto);
419       caseproto_unref (proto);
420     }
421
422
423   {
424     struct casegrouper *grouper;
425     struct casereader *group;
426     bool ok;
427
428     grouper = casegrouper_create_splits (proc_open_filtering (ds, !save), dict);
429
430
431     while (casegrouper_get_next_group (grouper, &group))
432       {
433         run_regression (&regression,
434                         &workspace,
435                         group);
436
437       }
438     ok = casegrouper_destroy (grouper);
439     ok = proc_commit (ds) && ok;
440   }
441
442   if (workspace.writer)
443     {
444       struct save_trans_data *save_trans_data = xmalloc (sizeof *save_trans_data);
445       struct casereader *r = casewriter_make_reader (workspace.writer);
446       workspace.writer = NULL;
447       workspace.reader = r;
448       save_trans_data->ws = xmalloc (sizeof (workspace));
449       memcpy (save_trans_data->ws, &workspace, sizeof (workspace));
450       save_trans_data->n_dep_vars = regression.n_dep_vars;
451
452       static const struct trns_class trns_class = {
453         .name = "REGRESSION",
454         .execute = save_trans_func,
455         .destroy = save_trans_free,
456       };
457       add_transformation (ds, &trns_class, save_trans_data);
458     }
459
460
461   free (regression.vars);
462   free (regression.dep_vars);
463   return CMD_SUCCESS;
464
465 error:
466
467   free (regression.vars);
468   free (regression.dep_vars);
469   return CMD_FAILURE;
470 }
471
472 /* Return the size of the union of dependent and independent variables */
473 static size_t
474 get_n_all_vars (const struct regression *cmd)
475 {
476   size_t result = cmd->n_vars;
477   size_t i;
478   size_t j;
479
480   result += cmd->n_dep_vars;
481   for (i = 0; i < cmd->n_dep_vars; i++)
482     {
483       for (j = 0; j < cmd->n_vars; j++)
484         {
485           if (cmd->vars[j] == cmd->dep_vars[i])
486             {
487               result--;
488             }
489         }
490     }
491   return result;
492 }
493
494 /* Fill VARS with the union of dependent and independent variables */
495 static void
496 fill_all_vars (const struct variable **vars, const struct regression *cmd)
497 {
498   size_t x = 0;
499   size_t i;
500   for (i = 0; i < cmd->n_vars; i++)
501     {
502       vars[i] = cmd->vars[i];
503     }
504
505   for (i = 0; i < cmd->n_dep_vars; i++)
506     {
507       size_t j;
508       bool absent = true;
509       for (j = 0; j < cmd->n_vars; j++)
510         {
511           if (cmd->dep_vars[i] == cmd->vars[j])
512             {
513               absent = false;
514               break;
515             }
516         }
517       if (absent)
518         {
519           vars[cmd->n_vars + x++] = cmd->dep_vars[i];
520         }
521     }
522 }
523
524
525 /* Fill the array VARS, with all the predictor variables from CMD, except
526    variable X */
527 static void
528 fill_predictor_x (const struct variable **vars, const struct variable *x, const struct regression *cmd)
529 {
530   size_t i;
531   size_t n = 0;
532
533   for (i = 0; i < cmd->n_vars; i++)
534     {
535       if (cmd->vars[i] == x)
536         continue;
537
538       vars[n++] = cmd->vars[i];
539     }
540 }
541
542 /*
543   Is variable k the dependent variable?
544 */
545 static bool
546 is_depvar (const struct regression *cmd, size_t k, const struct variable *v)
547 {
548   return v == cmd->vars[k];
549 }
550
551
552 /* Identify the explanatory variables in v_variables.  Returns
553    the number of independent variables. */
554 static int
555 identify_indep_vars (const struct regression *cmd,
556                      const struct variable **indep_vars,
557                      const struct variable *depvar)
558 {
559   int n_indep_vars = 0;
560   int i;
561
562   for (i = 0; i < cmd->n_vars; i++)
563     if (!is_depvar (cmd, i, depvar))
564       indep_vars[n_indep_vars++] = cmd->vars[i];
565   if ((n_indep_vars < 1) && is_depvar (cmd, 0, depvar))
566     {
567       /*
568          There is only one independent variable, and it is the same
569          as the dependent variable. Print a warning and continue.
570        */
571       msg (SW,
572            gettext
573            ("The dependent variable is equal to the independent variable. "
574             "The least squares line is therefore Y=X. "
575             "Standard errors and related statistics may be meaningless."));
576       n_indep_vars = 1;
577       indep_vars[0] = cmd->vars[0];
578     }
579   return n_indep_vars;
580 }
581
582 static double
583 fill_covariance (gsl_matrix * cov, struct covariance *all_cov,
584                  const struct variable **vars,
585                  size_t n_vars, const struct variable *dep_var,
586                  const struct variable **all_vars, size_t n_all_vars,
587                  double *means)
588 {
589   size_t i;
590   size_t j;
591   size_t dep_subscript = SIZE_MAX;
592   size_t *rows;
593   const gsl_matrix *ssizes;
594   const gsl_matrix *mean_matrix;
595   const gsl_matrix *ssize_matrix;
596   double result = 0.0;
597
598   const gsl_matrix *cm = covariance_calculate_unnormalized (all_cov);
599
600   if (cm == NULL)
601     return 0;
602
603   rows = xnmalloc (cov->size1 - 1, sizeof (*rows));
604
605   for (i = 0; i < n_all_vars; i++)
606     {
607       for (j = 0; j < n_vars; j++)
608         {
609           if (vars[j] == all_vars[i])
610             {
611               rows[j] = i;
612             }
613         }
614       if (all_vars[i] == dep_var)
615         {
616           dep_subscript = i;
617         }
618     }
619   assert (dep_subscript != SIZE_MAX);
620
621   mean_matrix = covariance_moments (all_cov, MOMENT_MEAN);
622   ssize_matrix = covariance_moments (all_cov, MOMENT_NONE);
623   for (i = 0; i < cov->size1 - 1; i++)
624     {
625       means[i] = gsl_matrix_get (mean_matrix, rows[i], 0)
626         / gsl_matrix_get (ssize_matrix, rows[i], 0);
627       for (j = 0; j < cov->size2 - 1; j++)
628         {
629           gsl_matrix_set (cov, i, j, gsl_matrix_get (cm, rows[i], rows[j]));
630           gsl_matrix_set (cov, j, i, gsl_matrix_get (cm, rows[j], rows[i]));
631         }
632     }
633   means[cov->size1 - 1] = gsl_matrix_get (mean_matrix, dep_subscript, 0)
634     / gsl_matrix_get (ssize_matrix, dep_subscript, 0);
635   ssizes = covariance_moments (all_cov, MOMENT_NONE);
636   result = gsl_matrix_get (ssizes, dep_subscript, rows[0]);
637   for (i = 0; i < cov->size1 - 1; i++)
638     {
639       gsl_matrix_set (cov, i, cov->size1 - 1,
640                       gsl_matrix_get (cm, rows[i], dep_subscript));
641       gsl_matrix_set (cov, cov->size1 - 1, i,
642                       gsl_matrix_get (cm, rows[i], dep_subscript));
643       if (result > gsl_matrix_get (ssizes, rows[i], dep_subscript))
644         {
645           result = gsl_matrix_get (ssizes, rows[i], dep_subscript);
646         }
647     }
648   gsl_matrix_set (cov, cov->size1 - 1, cov->size1 - 1,
649                   gsl_matrix_get (cm, dep_subscript, dep_subscript));
650   free (rows);
651   return result;
652 }
653
654 \f
655
656 struct model_container
657 {
658   struct linreg **models;
659 };
660
661 /*
662   STATISTICS subcommand output functions.
663 */
664 static void reg_stats_r (const struct linreg *,     const struct variable *);
665 static void reg_stats_coeff (const struct regression *, const struct linreg *,
666                              const struct model_container *, const gsl_matrix *,
667                              const struct variable *);
668 static void reg_stats_anova (const struct linreg *, const struct variable *);
669 static void reg_stats_bcov (const struct linreg *,  const struct variable *);
670
671
672 static struct linreg **
673 run_regression_get_models (const struct regression *cmd,
674                            struct casereader *input,
675                            bool output)
676 {
677   size_t i;
678   struct model_container *model_container = XCALLOC (cmd->n_vars, struct model_container);
679
680   struct ccase *c;
681   struct covariance *cov;
682   struct casereader *reader;
683
684   if (cmd->stats & STATS_TOL)
685     {
686       for (i = 0; i < cmd->n_vars; i++)
687         {
688           struct regression subreg;
689           subreg.origin = cmd->origin;
690           subreg.ds = cmd->ds;
691           subreg.n_vars = cmd->n_vars - 1;
692           subreg.n_dep_vars = 1;
693           subreg.vars = xmalloc (sizeof (*subreg.vars) * cmd->n_vars - 1);
694           subreg.dep_vars = xmalloc (sizeof (*subreg.dep_vars));
695           fill_predictor_x (subreg.vars, cmd->vars[i], cmd);
696           subreg.dep_vars[0] = cmd->vars[i];
697           subreg.stats = STATS_R;
698           subreg.ci = 0;
699           subreg.resid = false;
700           subreg.pred = false;
701
702           model_container[i].models =
703             run_regression_get_models (&subreg, input, false);
704           free (subreg.vars);
705           free (subreg.dep_vars);
706         }
707     }
708
709   size_t n_all_vars = get_n_all_vars (cmd);
710   const struct variable **all_vars = xnmalloc (n_all_vars, sizeof (*all_vars));
711
712   /* In the (rather pointless) case where the dependent variable is
713      the independent variable, n_all_vars == 1.
714      However this would result in a buffer overflow so we must
715      over-allocate the space required in this malloc call.
716      See bug #58599  */
717   double *means = xnmalloc (n_all_vars <= 1 ? 2 : n_all_vars,
718                             sizeof (*means));
719   fill_all_vars (all_vars, cmd);
720   cov = covariance_1pass_create (n_all_vars, all_vars,
721                                  dict_get_weight (dataset_dict (cmd->ds)),
722                                  MV_ANY, cmd->origin == false);
723
724   reader = casereader_clone (input);
725   reader = casereader_create_filter_missing (reader, all_vars, n_all_vars,
726                                              MV_ANY, NULL, NULL);
727 {
728     struct casereader *r = casereader_clone (reader);
729
730     for (; (c = casereader_read (r)) != NULL; case_unref (c))
731       {
732         covariance_accumulate (cov, c);
733       }
734     casereader_destroy (r);
735   }
736
737   struct linreg **models = XCALLOC (cmd->n_dep_vars, struct linreg*);
738
739   for (int k = 0; k < cmd->n_dep_vars; k++)
740     {
741       const struct variable **vars = xnmalloc (cmd->n_vars, sizeof (*vars));
742       const struct variable *dep_var = cmd->dep_vars[k];
743       int n_indep = identify_indep_vars (cmd, vars, dep_var);
744       gsl_matrix *cov_matrix = gsl_matrix_alloc (n_indep + 1, n_indep + 1);
745       double n_data = fill_covariance (cov_matrix, cov, vars, n_indep,
746                                 dep_var, all_vars, n_all_vars, means);
747       models[k] = linreg_alloc (dep_var, vars,  n_data, n_indep, cmd->origin);
748       for (i = 0; i < n_indep; i++)
749         {
750           linreg_set_indep_variable_mean (models[k], i, means[i]);
751         }
752       linreg_set_depvar_mean (models[k], means[i]);
753       if (n_data > 0)
754         {
755           linreg_fit (cov_matrix, models[k]);
756
757           if (output && !taint_has_tainted_successor (casereader_get_taint (input)))
758             {
759               /*
760                 Find the least-squares estimates and other statistics.
761               */
762               if (cmd->stats & STATS_R)
763                 reg_stats_r (models[k], dep_var);
764
765               if (cmd->stats & STATS_ANOVA)
766                 reg_stats_anova (models[k], dep_var);
767
768               if (cmd->stats & STATS_COEFF)
769                 reg_stats_coeff (cmd, models[k],
770                                  model_container,
771                                  cov_matrix, dep_var);
772
773               if (cmd->stats & STATS_BCOV)
774                 reg_stats_bcov  (models[k], dep_var);
775             }
776         }
777       else
778         {
779           msg (SE, _("No valid data found. This command was skipped."));
780         }
781       free (vars);
782       gsl_matrix_free (cov_matrix);
783     }
784
785   casereader_destroy (reader);
786
787   for (int i = 0; i < cmd->n_vars; i++)
788     {
789       if (model_container[i].models)
790         {
791           linreg_unref (model_container[i].models[0]);
792         }
793       free (model_container[i].models);
794     }
795   free (model_container);
796
797   free (all_vars);
798   free (means);
799   covariance_destroy (cov);
800   return models;
801 }
802
803 static void
804 run_regression (const struct regression *cmd,
805                 struct regression_workspace *ws,
806                 struct casereader *input)
807 {
808   struct linreg **models = run_regression_get_models (cmd, input, true);
809
810   if (ws->extras > 0)
811    {
812      struct ccase *c;
813       struct casereader *r = casereader_clone (input);
814
815       for (; (c = casereader_read (r)) != NULL; case_unref (c))
816         {
817           struct ccase *outc = case_create (casewriter_get_proto (ws->writer));
818           for (int k = 0; k < cmd->n_dep_vars; k++)
819             {
820               const struct variable **vars = xnmalloc (cmd->n_vars, sizeof (*vars));
821               const struct variable *dep_var = cmd->dep_vars[k];
822               int n_indep = identify_indep_vars (cmd, vars, dep_var);
823               double *vals = xnmalloc (n_indep, sizeof (*vals));
824               for (int i = 0; i < n_indep; i++)
825                 {
826                   const union value *tmp = case_data (c, vars[i]);
827                   vals[i] = tmp->f;
828                 }
829
830               if (cmd->pred)
831                 {
832                   double pred = linreg_predict (models[k], vals, n_indep);
833                   *case_num_rw_idx (outc, k * ws->extras + ws->pred_idx) = pred;
834                 }
835
836               if (cmd->resid)
837                 {
838                   double obs = case_num (c, linreg_dep_var (models[k]));
839                   double res = linreg_residual (models[k], obs,  vals, n_indep);
840                   *case_num_rw_idx (outc, k * ws->extras + ws->res_idx) = res;
841                 }
842               free (vals);
843               free (vars);
844             }
845           casewriter_write (ws->writer, outc);
846         }
847       casereader_destroy (r);
848     }
849
850   for (int k = 0; k < cmd->n_dep_vars; k++)
851     {
852       linreg_unref (models[k]);
853     }
854
855   free (models);
856   casereader_destroy (input);
857 }
858
859 \f
860
861
862 static void
863 reg_stats_r (const struct linreg * c, const struct variable *var)
864 {
865   struct pivot_table *table = pivot_table_create__ (
866     pivot_value_new_text_format (N_("Model Summary (%s)"),
867                                  var_to_string (var)),
868     "Model Summary");
869
870   pivot_dimension_create (table, PIVOT_AXIS_COLUMN, N_("Statistics"),
871                           N_("R"), N_("R Square"), N_("Adjusted R Square"),
872                           N_("Std. Error of the Estimate"));
873
874   double rsq = linreg_ssreg (c) / linreg_sst (c);
875   double adjrsq = (rsq -
876                    (1.0 - rsq) * linreg_n_coeffs (c)
877                    / (linreg_n_obs (c) - linreg_n_coeffs (c) - 1));
878   double std_error = sqrt (linreg_mse (c));
879
880   double entries[] = {
881     sqrt (rsq), rsq, adjrsq, std_error
882   };
883   for (size_t i = 0; i < sizeof entries / sizeof *entries; i++)
884     pivot_table_put1 (table, i, pivot_value_new_number (entries[i]));
885
886   pivot_table_submit (table);
887 }
888
889 /*
890   Table showing estimated regression coefficients.
891 */
892 static void
893 reg_stats_coeff (const struct regression *cmd, const struct linreg *c,
894                  const struct model_container *mc, const gsl_matrix *cov,
895                  const struct variable *var)
896 {
897   struct pivot_table *table = pivot_table_create__ (
898     pivot_value_new_text_format (N_("Coefficients (%s)"), var_to_string (var)),
899     "Coefficients");
900
901   struct pivot_dimension *statistics = pivot_dimension_create (
902     table, PIVOT_AXIS_COLUMN, N_("Statistics"));
903   pivot_category_create_group (statistics->root,
904                                N_("Unstandardized Coefficients"),
905                                N_("B"), N_("Std. Error"));
906   pivot_category_create_group (statistics->root,
907                                N_("Standardized Coefficients"), N_("Beta"));
908   pivot_category_create_leaves (statistics->root, N_("t"),
909                                 N_("Sig."), PIVOT_RC_SIGNIFICANCE);
910   if (cmd->stats & STATS_CI)
911     {
912       struct pivot_category *interval = pivot_category_create_group__ (
913         statistics->root, pivot_value_new_text_format (
914           N_("%g%% Confidence Interval for B"),
915           cmd->ci * 100.0));
916       pivot_category_create_leaves (interval, N_("Lower Bound"),
917                                     N_("Upper Bound"));
918     }
919
920   if (cmd->stats & STATS_TOL)
921     pivot_category_create_group (statistics->root,
922                                  N_("Collinearity Statistics"),
923                                  N_("Tolerance"), N_("VIF"));
924
925
926   struct pivot_dimension *variables = pivot_dimension_create (
927     table, PIVOT_AXIS_ROW, N_("Variables"));
928
929   double df = linreg_n_obs (c) - linreg_n_coeffs (c) - 1;
930   double q = (1 - cmd->ci) / 2.0;  /* 2-tailed test */
931   double tval = gsl_cdf_tdist_Qinv (q, df);
932
933   if (!cmd->origin)
934     {
935       int var_idx = pivot_category_create_leaf (
936         variables->root, pivot_value_new_text (N_("(Constant)")));
937
938       double std_err = sqrt (gsl_matrix_get (linreg_cov (c), 0, 0));
939       double t_stat = linreg_intercept (c) / std_err;
940       double base_entries[] = {
941         linreg_intercept (c),
942         std_err,
943         0.0,
944         t_stat,
945         2.0 * gsl_cdf_tdist_Q (fabs (t_stat),
946                                linreg_n_obs (c) - linreg_n_coeffs (c)),
947       };
948
949       size_t col = 0;
950       for (size_t i = 0; i < sizeof base_entries / sizeof *base_entries; i++)
951         pivot_table_put2 (table, col++, var_idx,
952                           pivot_value_new_number (base_entries[i]));
953
954       if (cmd->stats & STATS_CI)
955         {
956           double interval_entries[] = {
957             linreg_intercept (c) - tval * std_err,
958             linreg_intercept (c) + tval * std_err,
959           };
960
961           for (size_t i = 0; i < sizeof interval_entries / sizeof *interval_entries; i++)
962             pivot_table_put2 (table, col++, var_idx,
963                               pivot_value_new_number (interval_entries[i]));
964         }
965     }
966
967   for (size_t j = 0; j < linreg_n_coeffs (c); j++)
968     {
969       const struct variable *v = linreg_indep_var (c, j);
970       int var_idx = pivot_category_create_leaf (
971         variables->root, pivot_value_new_variable (v));
972
973       double std_err = sqrt (gsl_matrix_get (linreg_cov (c), j + 1, j + 1));
974       double t_stat = linreg_coeff (c, j) / std_err;
975       double base_entries[] = {
976         linreg_coeff (c, j),
977         sqrt (gsl_matrix_get (linreg_cov (c), j + 1, j + 1)),
978         (sqrt (gsl_matrix_get (cov, j, j)) * linreg_coeff (c, j) /
979          sqrt (gsl_matrix_get (cov, cov->size1 - 1, cov->size2 - 1))),
980         t_stat,
981         2 * gsl_cdf_tdist_Q (fabs (t_stat), df)
982       };
983
984       size_t col = 0;
985       for (size_t i = 0; i < sizeof base_entries / sizeof *base_entries; i++)
986         pivot_table_put2 (table, col++, var_idx,
987                           pivot_value_new_number (base_entries[i]));
988
989       if (cmd->stats & STATS_CI)
990         {
991           double interval_entries[] = {
992             linreg_coeff (c, j)  - tval * std_err,
993             linreg_coeff (c, j)  + tval * std_err,
994           };
995
996
997           for (size_t i = 0; i < sizeof interval_entries / sizeof *interval_entries; i++)
998             pivot_table_put2 (table, col++, var_idx,
999                               pivot_value_new_number (interval_entries[i]));
1000         }
1001
1002       if (cmd->stats & STATS_TOL)
1003         {
1004           {
1005             struct linreg *m = mc[j].models[0];
1006             double rsq = linreg_ssreg (m) / linreg_sst (m);
1007             pivot_table_put2 (table, col++, var_idx, pivot_value_new_number (1.0 - rsq));
1008             pivot_table_put2 (table, col++, var_idx, pivot_value_new_number (1.0 / (1.0 - rsq)));
1009           }
1010         }
1011     }
1012
1013   pivot_table_submit (table);
1014 }
1015
1016 /*
1017   Display the ANOVA table.
1018 */
1019 static void
1020 reg_stats_anova (const struct linreg * c, const struct variable *var)
1021 {
1022   struct pivot_table *table = pivot_table_create__ (
1023     pivot_value_new_text_format (N_("ANOVA (%s)"), var_to_string (var)),
1024     "ANOVA");
1025
1026   pivot_dimension_create (table, PIVOT_AXIS_COLUMN, N_("Statistics"),
1027                           N_("Sum of Squares"), PIVOT_RC_OTHER,
1028                           N_("df"), PIVOT_RC_INTEGER,
1029                           N_("Mean Square"), PIVOT_RC_OTHER,
1030                           N_("F"), PIVOT_RC_OTHER,
1031                           N_("Sig."), PIVOT_RC_SIGNIFICANCE);
1032
1033   pivot_dimension_create (table, PIVOT_AXIS_ROW, N_("Source"),
1034                           N_("Regression"), N_("Residual"), N_("Total"));
1035
1036   double msm = linreg_ssreg (c) / linreg_dfmodel (c);
1037   double mse = linreg_mse (c);
1038   double F = msm / mse;
1039
1040   struct entry
1041     {
1042       int stat_idx;
1043       int source_idx;
1044       double x;
1045     }
1046   entries[] = {
1047     /* Sums of Squares. */
1048     { 0, 0, linreg_ssreg (c) },
1049     { 0, 1, linreg_sse (c) },
1050     { 0, 2, linreg_sst (c) },
1051     /* Degrees of freedom. */
1052     { 1, 0, linreg_dfmodel (c) },
1053     { 1, 1, linreg_dferror (c) },
1054     { 1, 2, linreg_dftotal (c) },
1055     /* Mean Squares. */
1056     { 2, 0, msm },
1057     { 2, 1, mse },
1058     /* F */
1059     { 3, 0, F },
1060     /* Significance. */
1061     { 4, 0, gsl_cdf_fdist_Q (F, linreg_dfmodel (c), linreg_dferror (c)) },
1062   };
1063   for (size_t i = 0; i < sizeof entries / sizeof *entries; i++)
1064     {
1065       const struct entry *e = &entries[i];
1066       pivot_table_put2 (table, e->stat_idx, e->source_idx,
1067                         pivot_value_new_number (e->x));
1068     }
1069
1070   pivot_table_submit (table);
1071 }
1072
1073
1074 static void
1075 reg_stats_bcov (const struct linreg * c, const struct variable *var)
1076 {
1077   struct pivot_table *table = pivot_table_create__ (
1078     pivot_value_new_text_format (N_("Coefficient Correlations (%s)"),
1079                                  var_to_string (var)),
1080     "Coefficient Correlations");
1081
1082   for (size_t i = 0; i < 2; i++)
1083     {
1084       struct pivot_dimension *models = pivot_dimension_create (
1085         table, i ? PIVOT_AXIS_ROW : PIVOT_AXIS_COLUMN, N_("Models"));
1086       for (size_t j = 0; j < linreg_n_coeffs (c); j++)
1087         pivot_category_create_leaf (
1088           models->root, pivot_value_new_variable (
1089             linreg_indep_var (c, j)));
1090     }
1091
1092   pivot_dimension_create (table, PIVOT_AXIS_ROW, N_("Statistics"),
1093                           N_("Covariances"));
1094
1095   for (size_t i = 0; i < linreg_n_coeffs (c); i++)
1096     for (size_t k = 0; k < linreg_n_coeffs (c); k++)
1097       {
1098         double cov = gsl_matrix_get (linreg_cov (c), MIN (i, k), MAX (i, k));
1099         pivot_table_put3 (table, k, i, 0, pivot_value_new_number (cov));
1100       }
1101
1102   pivot_table_submit (table);
1103 }