GLM: Add debugging option /SHOWCODES

diff --git a/src/language/stats/glm.c b/src/language/stats/glm.c
index 2536c5f52de069c9e326f3891e18600d61394c1e..fd5870c137d95f1d72aee239136ff497206abf76 100644 (file)
--- 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 8e9f1db14bda67435e316049507196e476bae302..9bc8eb72e7515a7ba2f3cb9042f315fe049e6877 100644 (file)
--- a/src/math/covariance.c
+++ b/src/math/covariance.c
@@ -722,4 +722,86 @@ covariance_dim (const struct covariance * cov)
   return (cov->dim);
 }
 
+\f
 
+/*
+  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 ed5b3ee73426951d0084eb5df20f8492db541cb7..7345097195a6b207e6c9cd2e5e8d317ce43de885 100644 (file)
--- 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