fixed the code so that the averages are updated at each tier

topepo · Jul 14, 2015 · f2ad135 · f2ad135
1 parent 6d48268
commit f2ad135
Showing 1 changed file with 25 additions and 10 deletions.
diff --git a/pkg/caret/R/findCorrelation.R b/pkg/caret/R/findCorrelation.R
@@ -17,25 +17,40 @@ findCorrelation <- function(x, cutoff = 0.90, verbose = FALSE)
   maxAbsCorOrder <- order(apply(tmp, 2, averageCorr), decreasing = TRUE)
   x <- x[maxAbsCorOrder, maxAbsCorOrder]
   newOrder <- originalOrder[maxAbsCorOrder]
+  rm(tmp)
 
-  deletecol <- rep(F, varnum)
+  deletecol <- rep(FALSE, varnum)
+
+  x2 <- x
+  diag(x2) <- NA
 
   for (i in 1:(varnum - 1)) {
+    if(!any(x2[!is.na(x2)] > cutoff)){
+      if (verbose) cat("All correlations <=", cutoff, "\n")
+      break()
+    }
     if (deletecol[i]) next
     for (j in (i + 1):varnum) {
       if (!deletecol[i] & !deletecol[j]) {
-        if(verbose)
-          cat("Considering row\t", newOrder[i], 
-              "column\t", newOrder[j], 
-              "value\t", round(x[i,j], 3), "\n")  
+
         if (x[i, j] > cutoff) {
-          if (mean(x[i, -i]) > mean(x[-j, j])) {
-            deletecol[i] <- T
-            if (verbose) cat("  Flagging column\t", newOrder[i], "\n")
+          mn1 <- mean(x2[i,], na.rm = TRUE)
+          mn2 <- mean(x2[-j,], na.rm = TRUE)
+          if(verbose) cat("Compare row", newOrder[i], 
+                          " and column ", newOrder[j], 
+                          "with corr ", round(x[i,j], 3), "\n")  
+          if (verbose) cat("  Means: ", round(mn1, 3), "vs", round(mn2, 3))
+          if (mn1 > mn2) {
+            deletecol[i] <- TRUE
+            x2[i, ] <- NA
+            x2[, i] <- NA
+            if (verbose) cat(" so flagging column", newOrder[i], "\n")
           }
           else {
-            deletecol[j] <- T
-            if (verbose) cat("  Flagging column\t", newOrder[j], "\n")
+            deletecol[j] <- TRUE
+            x2[j, ] <- NA
+            x2[, j] <- NA
+            if (verbose) cat(" so flagging column", newOrder[j], "\n")
           }
         }
       }