X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fstats%2Flogistic.c;h=d5dbad360544789fedfc257849cbba0303841454;hb=refs%2Fheads%2Fcenter-titles;hp=4645ee14d208356d816ba386c73e3f45a8081033;hpb=00fd47eccf62f5657bc32655bdddcf3758d882e2;p=pspp

diff --git a/src/language/stats/logistic.c b/src/language/stats/logistic.c
index 4645ee14d2..d5dbad3605 100644
--- a/src/language/stats/logistic.c
+++ b/src/language/stats/logistic.c
@@ -344,13 +344,13 @@ xt_times_y_pi (const struct lr_spec *cmd,
 	       struct casereader *input,
 	       const struct variable **x, size_t n_x,
 	       const struct variable *y_var,
-	       double *likelihood)
+	       double *llikelihood)
 {
   struct casereader *reader;
   struct ccase *c;
   gsl_vector *output = gsl_vector_calloc (res->beta_hat->size);
 
-  *likelihood = 1.0;
+  *llikelihood = 0.0;
   res->tn = res->tp = res->fn = res->fp = 0;
   for (reader = casereader_clone (input);
        (c = casereader_read (reader)) != NULL; case_unref (c))
@@ -363,7 +363,7 @@ xt_times_y_pi (const struct lr_spec *cmd,
 
       double y = map_dependent_var (cmd, res, case_data (c, y_var));
 
-      *likelihood *= pow (pi, weight * y) * pow (1 - pi, weight * (1 - y));
+      *llikelihood += (weight * y) * log (pi) + log (1 - pi) * weight * (1 - y);
 
       for (v0 = 0; v0 < res->beta_hat->size; ++v0)
 	{
@@ -478,6 +478,11 @@ initial_pass (const struct lr_spec *cmd, struct lr_result *res, struct casereade
       double weight = dict_get_case_weight (cmd->dict, c, &res->warn_bad_weight);
       const union value *depval = case_data (c, cmd->dep_var);
 
+      if (var_is_value_missing (cmd->dep_var, depval, cmd->exclude))
+	{
+	  missing = true;
+	}
+      else 
       for (v = 0; v < cmd->n_indep_vars; ++v)
 	{
 	  const union value *val = case_data (c, cmd->indep_vars[v]);
@@ -518,6 +523,7 @@ initial_pass (const struct lr_spec *cmd, struct lr_result *res, struct casereade
 	      )
 	    {
 	      msg (ME, _("Dependent variable's values are not dichotomous."));
+              case_unref (c);
 	      goto error;
 	    }
 	}
@@ -578,10 +584,10 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
 
   bool converged = false;
 
-  /* Set the likelihoods to a negative sentinel value */
-  double likelihood = -1;
-  double prev_likelihood = -1;
-  double initial_likelihood = -1;
+  /* Set the log likelihoods to a sentinel value */
+  double log_likelihood = SYSMIS;
+  double prev_log_likelihood = SYSMIS;
+  double initial_log_likelihood = SYSMIS;
 
   struct lr_result work;
   work.n_missing = 0;
@@ -589,11 +595,12 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
   work.warn_bad_weight = true;
   work.cats = NULL;
   work.beta_hat = NULL;
+  work.hessian = NULL;
 
   /* Get the initial estimates of \beta and their standard errors.
      And perform other auxilliary initialisation.  */
   if (! initial_pass (cmd, &work, input))
-    return false;
+    goto error;
   
   for (i = 0; i < cmd->n_cat_predictors; ++i)
     {
@@ -607,7 +614,7 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
 	  msg (ME, _("Category %s does not have at least two distinct values. Logistic regression will not be run."),
 	       ds_cstr(&str));
 	  ds_destroy (&str);
-	  return false;
+	  goto error;
       	}
     }
 
@@ -623,6 +630,12 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
 					    NULL,
 					    NULL);
 
+  input = casereader_create_filter_missing (input,
+					    &cmd->dep_var,
+					    1,
+					    cmd->exclude,
+					    NULL,
+					    NULL);
 
   work.hessian = gsl_matrix_calloc (work.beta_hat->size, work.beta_hat->size);
 
@@ -643,7 +656,7 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
       v = xt_times_y_pi (cmd, &work, input,
 			 cmd->predictor_vars, cmd->n_predictor_vars,
 			 cmd->dep_var,
-			 &likelihood);
+			 &log_likelihood);
 
       {
 	/* delta = M.v */
@@ -666,29 +679,29 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
 	gsl_vector_free (delta);
       }
 
-      if ( prev_likelihood >= 0)
+      if (i > 0)
 	{
-	  if (-log (likelihood) > -(1.0 - cmd->lcon) * log (prev_likelihood))
+	  if (-log_likelihood > -(1.0 - cmd->lcon) * prev_log_likelihood)
 	    {
 	      msg (MN, _("Estimation terminated at iteration number %d because Log Likelihood decreased by less than %g%%"), i + 1, 100 * cmd->lcon);
 	      converged = true;
 	    }
 	}
       if (i == 0)
-	initial_likelihood = likelihood;
-      prev_likelihood = likelihood;
+	initial_log_likelihood = log_likelihood;
+      prev_log_likelihood = log_likelihood;
 
       if (converged)
 	break;
     }
-  casereader_destroy (input);
-  assert (initial_likelihood >= 0);
+
+
 
   if ( ! converged) 
     msg (MW, _("Estimation terminated at iteration number %d because maximum iterations has been reached"), i );
 
 
-  output_model_summary (&work, initial_likelihood, likelihood);
+  output_model_summary (&work, initial_log_likelihood, log_likelihood);
 
   if (work.cats)
     output_categories (cmd, &work);
@@ -696,12 +709,20 @@ run_lr (const struct lr_spec *cmd, struct casereader *input,
   output_classification_table (cmd, &work);
   output_variables (cmd, &work);
 
+  casereader_destroy (input);
   gsl_matrix_free (work.hessian);
   gsl_vector_free (work.beta_hat); 
-  
   categoricals_destroy (work.cats);
 
   return true;
+
+ error:
+  casereader_destroy (input);
+  gsl_matrix_free (work.hessian);
+  gsl_vector_free (work.beta_hat); 
+  categoricals_destroy (work.cats);
+
+  return false;
 }
 
 struct variable_node
@@ -730,6 +751,7 @@ lookup_variable (const struct hmap *map, const struct variable *var, unsigned in
 int
 cmd_logistic (struct lexer *lexer, struct dataset *ds)
 {
+  int i;
   /* Temporary location for the predictor variables.
      These may or may not include the categorical predictors */
   const struct variable **pred_vars;
@@ -855,12 +877,12 @@ cmd_logistic (struct lexer *lexer, struct dataset *ds)
 		  lr.print |= PRINT_CI;
 		  if (lex_force_match (lexer, T_LPAREN))
 		    {
-		      if (! lex_force_int (lexer))
+		      if (! lex_force_num (lexer))
 			{
 			  lex_error (lexer, NULL);
 			  goto error;
 			}
-		      lr.confidence = lex_integer (lexer);
+		      lr.confidence = lex_number (lexer);
 		      lex_get (lexer);
 		      if ( ! lex_force_match (lexer, T_RPAREN))
 			{
@@ -1081,6 +1103,10 @@ cmd_logistic (struct lexer *lexer, struct dataset *ds)
     ok = proc_commit (ds) && ok;
   }
 
+  for (i = 0 ; i < lr.n_cat_predictors; ++i)
+    {
+      interaction_destroy (lr.cat_predictors[i]);
+    }
   free (lr.predictor_vars);
   free (lr.cat_predictors);
   free (lr.indep_vars);
@@ -1089,6 +1115,10 @@ cmd_logistic (struct lexer *lexer, struct dataset *ds)
 
  error:
 
+  for (i = 0 ; i < lr.n_cat_predictors; ++i)
+    {
+      interaction_destroy (lr.cat_predictors[i]);
+    }
   free (lr.predictor_vars);
   free (lr.cat_predictors);
   free (lr.indep_vars);
@@ -1138,8 +1168,8 @@ output_depvarmap (const struct lr_spec *cmd, const struct lr_result *res)
   tab_text (t,  0, 1 + heading_rows,  0, ds_cstr (&str));
 
 
-  tab_double (t, 1, 0 + heading_rows, 0, map_dependent_var (cmd, res, &res->y0), &F_8_0);
-  tab_double (t, 1, 1 + heading_rows, 0, map_dependent_var (cmd, res, &res->y1), &F_8_0);
+  tab_double (t, 1, 0 + heading_rows, 0, map_dependent_var (cmd, res, &res->y0), NULL, RC_INTEGER);
+  tab_double (t, 1, 1 + heading_rows, 0, map_dependent_var (cmd, res, &res->y1), NULL, RC_INTEGER);
   ds_destroy (&str);
 
   tab_submit (t);
@@ -1249,9 +1279,9 @@ output_variables (const struct lr_spec *cmd,
 	      gsl_blas_dgemv (CblasTrans, 1.0, subhessian, &vv.vector, 0, temp);
 	      gsl_blas_ddot (temp, &vv.vector, &wald);
 
-	      tab_double (t, 4, row, 0, wald, 0);
-	      tab_double (t, 5, row, 0, df, &F_8_0);
-	      tab_double (t, 6, row, 0, gsl_cdf_chisq_Q (wald, df), 0);
+	      tab_double (t, 4, row, 0, wald, NULL, RC_OTHER);
+	      tab_double (t, 5, row, 0, df, NULL, RC_INTEGER);
+	      tab_double (t, 6, row, 0, gsl_cdf_chisq_Q (wald, df), NULL, RC_PVALUE);
 
 	      idx_correction ++;
 	      summary = true;
@@ -1280,22 +1310,26 @@ output_variables (const struct lr_spec *cmd,
 	  tab_text (t, 1, row, TAB_LEFT | TAT_TITLE, _("Constant"));
 	}
 
-      tab_double (t, 2, row, 0, b, 0);
-      tab_double (t, 3, row, 0, sqrt (sigma2), 0);
-      tab_double (t, 4, row, 0, wald, 0);
-      tab_double (t, 5, row, 0, df, &F_8_0);
-      tab_double (t, 6, row, 0, gsl_cdf_chisq_Q (wald, df), 0);
-      tab_double (t, 7, row, 0, exp (b), 0);
+      tab_double (t, 2, row, 0, b, NULL, RC_OTHER);
+      tab_double (t, 3, row, 0, sqrt (sigma2), NULL, RC_OTHER);
+      tab_double (t, 4, row, 0, wald, NULL, RC_OTHER);
+      tab_double (t, 5, row, 0, df, NULL, RC_INTEGER);
+      tab_double (t, 6, row, 0, gsl_cdf_chisq_Q (wald, df), NULL, RC_PVALUE);
+      tab_double (t, 7, row, 0, exp (b), NULL, RC_OTHER);
 
       if (cmd->print & PRINT_CI)
 	{
+	  int last_ci = nr;
 	  double wc = gsl_cdf_ugaussian_Pinv (0.5 + cmd->confidence / 200.0);
 	  wc *= sqrt (sigma2);
 
-	  if (idx < cmd->n_predictor_vars)
+	  if (cmd->constant)
+	    last_ci--;
+
+	  if (row < last_ci)
 	    {
-	      tab_double (t, 8, row, 0, exp (b - wc), 0);
-	      tab_double (t, 9, row, 0, exp (b + wc), 0);
+	      tab_double (t, 8, row, 0, exp (b - wc), NULL, RC_OTHER);
+	      tab_double (t, 9, row, 0, exp (b + wc), NULL, RC_OTHER);
 	    }
 	}
     }
@@ -1307,7 +1341,7 @@ output_variables (const struct lr_spec *cmd,
 /* Show the model summary box */
 static void
 output_model_summary (const struct lr_result *res,
-		      double initial_likelihood, double likelihood)
+		      double initial_log_likelihood, double log_likelihood)
 {
   const int heading_columns = 0;
   const int heading_rows = 1;
@@ -1329,15 +1363,15 @@ output_model_summary (const struct lr_result *res,
 
   tab_text (t,  0, 0, TAB_LEFT | TAT_TITLE, _("Step 1"));
   tab_text (t,  1, 0, TAB_CENTER | TAT_TITLE, _("-2 Log likelihood"));
-  tab_double (t,  1, 1, 0, -2 * log (likelihood), 0);
+  tab_double (t,  1, 1, 0, -2 * log_likelihood, NULL, RC_OTHER);
 
 
   tab_text (t,  2, 0, TAB_CENTER | TAT_TITLE, _("Cox & Snell R Square"));
-  cox =  1.0 - pow (initial_likelihood /likelihood, 2 / res->cc);
-  tab_double (t,  2, 1, 0, cox, 0);
+  cox =  1.0 - exp((initial_log_likelihood - log_likelihood) * (2 / res->cc));
+  tab_double (t,  2, 1, 0, cox, NULL, RC_OTHER);
 
   tab_text (t,  3, 0, TAB_CENTER | TAT_TITLE, _("Nagelkerke R Square"));
-  tab_double (t,  3, 1, 0, cox / ( 1.0 - pow (initial_likelihood, 2 / res->cc)), 0);
+  tab_double (t,  3, 1, 0, cox / ( 1.0 - exp(initial_log_likelihood * (2 / res->cc))), NULL, RC_OTHER);
 
 
   tab_submit (t);
@@ -1374,15 +1408,15 @@ case_processing_summary (const struct lr_result *res)
   tab_text (t,  0, 2, TAB_LEFT | TAT_TITLE, _("Missing Cases"));
   tab_text (t,  0, 3, TAB_LEFT | TAT_TITLE, _("Total"));
 
-  tab_double (t,  1, 1, 0, res->n_nonmissing, &F_8_0);
-  tab_double (t,  1, 2, 0, res->n_missing, &F_8_0);
+  tab_double (t,  1, 1, 0, res->n_nonmissing, NULL, RC_INTEGER);
+  tab_double (t,  1, 2, 0, res->n_missing, NULL, RC_INTEGER);
 
   total = res->n_nonmissing + res->n_missing;
-  tab_double (t,  1, 3, 0, total , &F_8_0);
+  tab_double (t,  1, 3, 0, total , NULL, RC_INTEGER);
 
-  tab_double (t,  2, 1, 0, 100 * res->n_nonmissing / (double) total, 0);
-  tab_double (t,  2, 2, 0, 100 * res->n_missing / (double) total, 0);
-  tab_double (t,  2, 3, 0, 100 * total / (double) total, 0);
+  tab_double (t,  2, 1, 0, 100 * res->n_nonmissing / (double) total, NULL, RC_OTHER);
+  tab_double (t,  2, 2, 0, 100 * res->n_missing / (double) total, NULL, RC_OTHER);
+  tab_double (t,  2, 3, 0, 100 * total / (double) total, NULL, RC_OTHER);
 
   tab_submit (t);
 }
@@ -1420,6 +1454,8 @@ output_categories (const struct lr_spec *cmd, const struct lr_result *res)
   nr = heading_rows + total_cats;
 
   t = tab_create (nc, nr);
+  tab_set_format (t, RC_WEIGHT, wfmt);
+
   tab_title (t, _("Categorical Variables' Codings"));
 
   tab_headers (t, heading_columns, 0, heading_rows, 0);
@@ -1477,11 +1513,11 @@ output_categories (const struct lr_spec *cmd, const struct lr_result *res)
 	  
 	  tab_text   (t, 1, heading_rows + r, 0, ds_cstr (&str));
 	  ds_destroy (&str);
-       	  tab_double (t, 2, heading_rows + r, 0, *freq, wfmt);
+       	  tab_double (t, 2, heading_rows + r, 0, *freq, NULL, RC_WEIGHT);
 
 	  for (x = 0; x < df; ++x)
 	    {
-	      tab_double (t, heading_columns + 1 + x, heading_rows + r, 0, (cat == x), &F_8_0);
+	      tab_double (t, heading_columns + 1 + x, heading_rows + r, 0, (cat == x), NULL, RC_INTEGER);
 	    }
 	  ++r;
 	}
@@ -1508,6 +1544,7 @@ output_classification_table (const struct lr_spec *cmd, const struct lr_result *
   const int nr = heading_rows + 3;
 
   struct tab_table *t = tab_create (nc, nr);
+  tab_set_format (t, RC_WEIGHT, wfmt);
 
   ds_init_empty (&sv0);
   ds_init_empty (&sv1);
@@ -1559,17 +1596,17 @@ output_classification_table (const struct lr_spec *cmd, const struct lr_result *
   ds_destroy (&sv0);
   ds_destroy (&sv1);
 
-  tab_double (t, heading_columns, 3,     0, res->tn, wfmt);
-  tab_double (t, heading_columns + 1, 4, 0, res->tp, wfmt);
+  tab_double (t, heading_columns, 3,     0, res->tn, NULL, RC_WEIGHT);
+  tab_double (t, heading_columns + 1, 4, 0, res->tp, NULL, RC_WEIGHT);
 
-  tab_double (t, heading_columns + 1, 3, 0, res->fp, wfmt);
-  tab_double (t, heading_columns,     4, 0, res->fn, wfmt);
+  tab_double (t, heading_columns + 1, 3, 0, res->fp, NULL, RC_WEIGHT);
+  tab_double (t, heading_columns,     4, 0, res->fn, NULL, RC_WEIGHT);
 
-  tab_double (t, heading_columns + 2, 3, 0, 100 * res->tn / (res->tn + res->fp), 0);
-  tab_double (t, heading_columns + 2, 4, 0, 100 * res->tp / (res->tp + res->fn), 0);
+  tab_double (t, heading_columns + 2, 3, 0, 100 * res->tn / (res->tn + res->fp), NULL, RC_OTHER);
+  tab_double (t, heading_columns + 2, 4, 0, 100 * res->tp / (res->tp + res->fn), NULL, RC_OTHER);
 
   tab_double (t, heading_columns + 2, 5, 0, 
-	      100 * (res->tp + res->tn) / (res->tp  + res->tn + res->fp + res->fn), 0);
+	      100 * (res->tp + res->tn) / (res->tp  + res->tn + res->fp + res->fn), NULL, RC_OTHER);
 
 
   tab_submit (t);