From ce4f35416abc94c3c4d39312da42b9fff0788073 Mon Sep 17 00:00:00 2001
From: John Darrington <john@darrington.wattle.id.au>
Date: Mon, 14 Nov 2011 18:19:37 +0100
Subject: [PATCH] GLM: Add debugging option /SHOWCODES

---
 src/language/stats/glm.c | 32 +++++++++++++++-
 src/math/covariance.c    | 82 ++++++++++++++++++++++++++++++++++++++++
 src/math/covariance.h    | 10 +++++
 3 files changed, 123 insertions(+), 1 deletion(-)

diff --git a/src/language/stats/glm.c b/src/language/stats/glm.c
index 2536c5f5..fd5870c1 100644
--- a/src/language/stats/glm.c
+++ b/src/language/stats/glm.c
@@ -68,6 +68,8 @@ struct glm_spec
   bool intercept;
 
   double alpha;
+
+  bool dump_coding;
 };
 
 struct glm_workspace
@@ -143,6 +145,7 @@ cmd_glm (struct lexer *lexer, struct dataset *ds)
   glm.intercept = true;
   glm.wv = dict_get_weight (glm.dict);
   glm.alpha = 0.05;
+  glm.dump_coding = false;
 
   if (!parse_variables_const (lexer, glm.dict,
 			      &glm.dep_vars, &glm.n_dep_vars,
@@ -284,6 +287,13 @@ cmd_glm (struct lexer *lexer, struct dataset *ds)
 	  if (glm.n_interactions > 0)
 	    design = true;
 	}
+      else if (lex_match_id (lexer, "SHOWCODES"))
+	/* Undocumented debug option */
+	{
+	  lex_match (lexer, T_EQUALS);
+
+	  glm.dump_coding = true;
+	}
       else
 	{
 	  lex_error (lexer, NULL);
@@ -478,7 +488,12 @@ run_glm (struct glm_spec *cmd, struct casereader *input,
     }
   casereader_destroy (reader);
 
-  for (reader = input;
+  if (cmd->dump_coding)
+    reader = casereader_clone (input);
+  else
+    reader = input;
+
+  for (;
        (c = casereader_read (reader)) != NULL; case_unref (c))
     {
       double weight = dict_get_case_weight (dict, c, &warn_bad_weight);
@@ -491,6 +506,21 @@ run_glm (struct glm_spec *cmd, struct casereader *input,
     }
   casereader_destroy (reader);
 
+
+  if (cmd->dump_coding)
+    {
+      struct tab_table *t =
+	covariance_dump_enc_header (cov,
+				    1 + casereader_count_cases (input));
+      for (reader = input;
+	   (c = casereader_read (reader)) != NULL; case_unref (c))
+	{
+	  covariance_dump_enc (cov, c, t);
+	}
+      casereader_destroy (reader);
+      tab_submit (t);
+    }
+
   {
     gsl_matrix *cm = covariance_calculate_unnormalized (cov);
 
diff --git a/src/math/covariance.c b/src/math/covariance.c
index 8e9f1db1..9bc8eb72 100644
--- a/src/math/covariance.c
+++ b/src/math/covariance.c
@@ -722,4 +722,86 @@ covariance_dim (const struct covariance * cov)
   return (cov->dim);
 }
 
+
 
+/*
+  Routines to assist debugging.
+  The following are not thoroughly tested and in certain respects
+  unreliable.  They should only be
+  used for aids to development. Not as user accessible code.
+*/
+
+#include "libpspp/str.h"
+#include "output/tab.h"
+#include "data/format.h"
+
+
+/* Create a table which can be populated with the encodings for
+   the covariance matrix COV */
+struct tab_table *
+covariance_dump_enc_header (const struct covariance *cov, int length)
+{
+  struct tab_table *t = tab_create (cov->dim,  length);
+  int i;
+  tab_title (t, "Covariance Encoding");
+
+  tab_box (t, 
+	   TAL_2, TAL_2, 0, 0,
+	   0, 0,   tab_nc (t) - 1,   tab_nr (t) - 1);
+
+  tab_hline (t, TAL_2, 0, tab_nc (t) - 1, 1);
+
+
+  for (i = 0 ; i < cov->n_vars; ++i)
+    {
+      tab_text (t, i, 0, TAT_TITLE, var_get_name (cov->vars[i]));
+      tab_vline (t, TAL_1, i + 1, 0, tab_nr (t) - 1);
+    }
+
+  int n = 0;
+  while (i < cov->dim)
+    {
+      struct string str;
+      int idx = i - cov->n_vars;
+      const struct interaction *iact =
+	categoricals_get_interaction_by_subscript (cov->categoricals, idx);
+
+      ds_init_empty (&str);
+      interaction_to_string (iact, &str);
+
+      int df = categoricals_df (cov->categoricals, n);
+
+      tab_joint_text (t,
+		      i, 0,
+		      i + df - 1, 0,
+		      TAT_TITLE, ds_cstr (&str));
+
+      if (i + df < tab_nr (t) - 1)
+	tab_vline (t, TAL_1, i + df, 0, tab_nr (t) - 1);
+
+      i += df;
+      n++;
+      ds_destroy (&str);
+    }
+
+  return t;
+}
+
+
+/*
+  Append table T, which should have been returned by covariance_dump_enc_header
+  with an entry corresponding to case C for the covariance matrix COV
+ */
+void
+covariance_dump_enc (const struct covariance *cov, const struct ccase *c,
+		     struct tab_table *t)
+{
+  static int row = 0;
+  int i;
+  ++row;
+  for (i = 0 ; i < cov->dim; ++i)
+    {
+      double v = get_val (cov, i, c);
+      tab_double (t, i, row, 0, v, i < cov->n_vars ? NULL : &F_8_0);
+    }
+}
diff --git a/src/math/covariance.h b/src/math/covariance.h
index ed5b3ee7..73450971 100644
--- a/src/math/covariance.h
+++ b/src/math/covariance.h
@@ -49,4 +49,14 @@ const gsl_matrix *covariance_moments (const struct covariance *cov, int m);
 const struct categoricals * covariance_get_categoricals (const struct covariance *cov);
 size_t covariance_dim (const struct covariance * cov);
 
+struct tab_table ;
+void
+covariance_dump_enc (const struct covariance *cov, const struct ccase *c,
+		     struct tab_table *t);
+
+struct tab_table *
+covariance_dump_enc_header (const struct covariance *cov, int length);
+
+
+
 #endif
-- 
2.30.2