Added proper convergence criteria for rotation phase
[pspp-builds.git] / src / language / stats / factor.c
index d3bba77eaa3c68aac1136e4817c958daa8ceefc9..83dc13de7ed5a28f92e16cd8e24e2a2a02c77b25 100644 (file)
@@ -163,6 +163,8 @@ struct cmd_factor
   double econverge;
   int iterations;
 
+  double rconverge;
+
   /* Format */
   double blank;
   bool sort;
@@ -539,11 +541,41 @@ clone_matrix (const gsl_matrix *m)
 }
 
 
+static double 
+initial_sv (const gsl_matrix *fm)
+{
+  int j, k;
+
+  double sv = 0.0;
+  for (j = 0 ; j < fm->size2; ++j)
+    {
+      double l4s = 0;
+      double l2s = 0;
+
+      for (k = j + 1 ; k < fm->size2; ++k)
+       {
+         double lambda = gsl_matrix_get (fm, k, j);
+         double lambda_sq = lambda * lambda;
+         double lambda_4 = lambda_sq * lambda_sq;
+
+         l4s += lambda_4;
+         l2s += lambda_sq;
+       }
+      sv += ( fm->size1 * l4s - (l2s * l2s) ) / (fm->size1 * fm->size1 );
+    }
+  return sv;
+}
+
 static void
-rotate (const gsl_matrix *unrot, const gsl_vector *communalities, enum rotation_type rot_type, gsl_matrix *result)
+rotate (const struct cmd_factor *cf, const gsl_matrix *unrot,
+       const gsl_vector *communalities,
+       gsl_matrix *result,
+       gsl_vector *rotated_loadings
+       )
 {
   int j, k;
   int i;
+  double prev_sv;
 
   /* First get a normalised version of UNROT */
   gsl_matrix *normalised = gsl_matrix_calloc (unrot->size1, unrot->size2);
@@ -571,11 +603,19 @@ rotate (const gsl_matrix *unrot, const gsl_vector *communalities, enum rotation_
 
   gsl_matrix_free (h_sqrt_inv);
 
+
   /* Now perform the rotation iterations */
-  for (i = 0 ; i < 25 ; ++i)
+
+  prev_sv = initial_sv (normalised);
+  for (i = 0 ; i < cf->iterations ; ++i)
     {
+      double sv = 0.0;
       for (j = 0 ; j < normalised->size2; ++j)
        {
+         /* These variables relate to the convergence criterium */
+         double l4s = 0;
+         double l2s = 0;
+
          for (k = j + 1 ; k < normalised->size2; ++k)
            {
              int p;
@@ -585,6 +625,7 @@ rotate (const gsl_matrix *unrot, const gsl_vector *communalities, enum rotation_
              double d = 0.0;
              double x, y;
              double phi;
+
              for (p = 0; p < normalised->size1; ++p)
                {
                  double jv = gsl_matrix_get (normalised, p, j);
@@ -598,18 +639,38 @@ rotate (const gsl_matrix *unrot, const gsl_vector *communalities, enum rotation_
                  d += 2 * u * v;
                }
 
-             rotation_coeff [rot_type] (&x, &y, a, b, c, d, normalised);
+             rotation_coeff [cf->rotation] (&x, &y, a, b, c, d, normalised);
 
              phi = atan2 (x,  y) / 4.0 ;
-         
+
+             /* Don't bother rotating if the angle is small */
+             if ( fabs (sin (phi) ) <= pow (10.0, -15.0))
+                 continue;
+
              for (p = 0; p < normalised->size1; ++p)
                {
                  double *lambda0 = gsl_matrix_ptr (normalised, p, j);
                  double *lambda1 = gsl_matrix_ptr (normalised, p, k);
                  drot_go (phi, lambda0, lambda1);
                }
+
+             /* Calculate the convergence criterium */
+             {
+               double lambda = gsl_matrix_get (normalised, k, j);
+               double lambda_sq = lambda * lambda;
+               double lambda_4 = lambda_sq * lambda_sq;
+
+               l4s += lambda_4;
+               l2s += lambda_sq;
+             }
            }
+         sv += ( normalised->size1 * l4s - (l2s * l2s) ) / (normalised->size1 * normalised->size1 );
        }
+
+      if ( fabs (sv - prev_sv) <= cf->rconverge)
+       break;
+
+      prev_sv = sv;
     }
 
   gsl_blas_dgemm (CblasNoTrans,  CblasNoTrans, 1.0,
@@ -618,15 +679,20 @@ rotate (const gsl_matrix *unrot, const gsl_vector *communalities, enum rotation_
   gsl_matrix_free (h_sqrt);
 
 
-  /* reflect negative sums */
+  /* reflect negative sums and populate the rotated loadings vector*/
   for (i = 0 ; i < result->size2; ++i)
     {
+      double ssq = 0.0;
       double sum = 0.0;
       for (j = 0 ; j < result->size1; ++j)
        {
+         double s = gsl_matrix_get (result, j, i);
+         ssq += s * s;
          sum += gsl_matrix_get (result, j, i);
        }
 
+      gsl_vector_set (rotated_loadings, i, ssq);
+
       if ( sum < 0 )
        for (j = 0 ; j < result->size1; ++j)
          {
@@ -634,8 +700,6 @@ rotate (const gsl_matrix *unrot, const gsl_vector *communalities, enum rotation_
            *lambda = - *lambda;
          }
     }
-
-  //  dump_matrix (result);
 }
 
 
@@ -712,11 +776,14 @@ cmd_factor (struct lexer *lexer, struct dataset *ds)
   factor.min_eigen = SYSMIS;
   factor.iterations = 25;
   factor.econverge = 0.001;
+
   factor.blank = 0;
   factor.sort = false;
   factor.plot = 0;
   factor.rotation = ROT_VARIMAX;
 
+  factor.rconverge = 0.0001;
+
   factor.wv = dict_get_weight (dict);
 
   lex_match (lexer, '/');
@@ -844,6 +911,16 @@ cmd_factor (struct lexer *lexer, struct dataset *ds)
                      lex_force_match (lexer, ')');
                    }
                }
+             else if (lex_match_id (lexer, "RCONVERGE"))
+               {
+                 if ( lex_force_match (lexer, '('))
+                   {
+                     lex_force_num (lexer);
+                     factor.rconverge = lex_number (lexer);
+                     lex_get (lexer);
+                     lex_force_match (lexer, ')');
+                   }
+               }
              else if (lex_match_id (lexer, "ITERATE"))
                {
                  if ( lex_force_match (lexer, '('))
@@ -1041,6 +1118,9 @@ cmd_factor (struct lexer *lexer, struct dataset *ds)
        }
     }
 
+  if ( factor.rotation == ROT_NONE )
+    factor.print &= ~PRINT_ROTATION;
+
   if ( ! run_factor (ds, &factor)) 
     goto error;
 
@@ -1293,7 +1373,8 @@ show_factor_matrix (const struct cmd_factor *factor, struct idata *idata, const
 static void
 show_explained_variance (const struct cmd_factor * factor, struct idata *idata,
                         const gsl_vector *initial_eigenvalues,
-                        const gsl_vector *extracted_eigenvalues)
+                        const gsl_vector *extracted_eigenvalues,
+                        const gsl_vector *rotated_loadings)
 {
   size_t i;
   int c = 0;
@@ -1309,6 +1390,8 @@ show_explained_variance (const struct cmd_factor * factor, struct idata *idata,
   double e_total = 0.0;
   double e_cum = 0.0;
 
+  double r_cum = 0.0;
+
   int nc = heading_columns;
 
   if (factor->print & PRINT_EXTRACTION)
@@ -1396,7 +1479,6 @@ show_explained_variance (const struct cmd_factor * factor, struct idata *idata,
       e_total = i_total;
     }
 
-
   for (i = 0 ; i < factor->n_vars; ++i)
     {
       const double i_lambda = gsl_vector_get (initial_eigenvalues, i);
@@ -1405,12 +1487,16 @@ show_explained_variance (const struct cmd_factor * factor, struct idata *idata,
       const double e_lambda = gsl_vector_get (extracted_eigenvalues, i);
       double e_percent = 100.0 * e_lambda / e_total ;
 
+      const double r_lambda = gsl_vector_get (rotated_loadings, i);
+      double r_percent = 100.0 * r_lambda / e_total ;
+
       c = 0;
 
       tab_text_format (t, c++, i + heading_rows, TAB_LEFT | TAT_TITLE, _("%d"), i + 1);
 
       i_cum += i_percent;
       e_cum += e_percent;
+      r_cum += r_percent;
 
       /* Initial Eigenvalues */
       if (factor->print & PRINT_INITIAL)
@@ -1420,6 +1506,7 @@ show_explained_variance (const struct cmd_factor * factor, struct idata *idata,
        tab_double (t, c++, i + heading_rows, 0, i_cum, NULL);
       }
 
+
       if (factor->print & PRINT_EXTRACTION)
        {
          if (i < idata->n_extractions)
@@ -1430,6 +1517,17 @@ show_explained_variance (const struct cmd_factor * factor, struct idata *idata,
              tab_double (t, c++, i + heading_rows, 0, e_cum, NULL);
            }
        }
+
+      if (factor->print & PRINT_ROTATION)
+       {
+         if (i < idata->n_extractions)
+           {
+             tab_double (t, c++, i + heading_rows, 0, r_lambda, NULL);
+             tab_double (t, c++, i + heading_rows, 0, r_percent, NULL);
+             tab_double (t, c++, i + heading_rows, 0, r_cum, NULL);
+           }
+      }
+
     }
 
   tab_submit (t);
@@ -1686,6 +1784,9 @@ do_factor (const struct cmd_factor *factor, struct casereader *r)
     }
     
   {
+    gsl_matrix *rotated_factors = NULL;
+    gsl_vector *rotated_loadings = NULL;
+
     const gsl_vector *extracted_eigenvalues = NULL;
     gsl_vector *initial_communalities = gsl_vector_alloc (factor->n_vars);
     gsl_vector *extracted_communalities = gsl_vector_alloc (factor->n_vars);
@@ -1745,7 +1846,16 @@ do_factor (const struct cmd_factor *factor, struct casereader *r)
 
     show_communalities (factor, initial_communalities, extracted_communalities);
 
-    show_explained_variance (factor, idata, idata->eval, extracted_eigenvalues);
+
+    if ( factor->rotation != ROT_NONE)
+      {
+       rotated_factors = gsl_matrix_calloc (factor_matrix->size1, factor_matrix->size2);
+       rotated_loadings = gsl_vector_calloc (factor_matrix->size2);
+
+       rotate (factor, factor_matrix, extracted_communalities, rotated_factors, rotated_loadings);
+      }
+
+    show_explained_variance (factor, idata, idata->eval, extracted_eigenvalues, rotated_loadings);
 
     factor_matrix_workspace_free (fmw);
 
@@ -1757,10 +1867,6 @@ do_factor (const struct cmd_factor *factor, struct casereader *r)
 
     if ( factor->rotation != ROT_NONE)
       {
-       gsl_matrix *rotated_factors = gsl_matrix_calloc (factor_matrix->size1, factor_matrix->size2);
-
-       rotate (factor_matrix, extracted_communalities, factor->rotation, rotated_factors);
-
        show_factor_matrix (factor, idata,
                            factor->extraction == EXTRACTION_PC ? _("Rotated Component Matrix") : _("Rotated Factor Matrix"),
                            rotated_factors);
@@ -1769,6 +1875,7 @@ do_factor (const struct cmd_factor *factor, struct casereader *r)
       }
 
 
+
     gsl_vector_free (initial_communalities);
     gsl_vector_free (extracted_communalities);
   }
@@ -1779,3 +1886,6 @@ do_factor (const struct cmd_factor *factor, struct casereader *r)
 
   casereader_destroy (r);
 }
+
+
+