Fix for Issue #266 (#267)

* Fix for Issue #266

fix: added fail safe for when `Inf` or `-Inf` are found in transformed `newdata` data frame.

Changes them to `NaN` which can be safely handled by downstream functions

* Fix for Issue #266

tests: added test to maintain coverage

R/predict.R

@@ -405,6 +405,9 @@ predict.mixo_pls <-
                     newdata[which(!is.na(ind.match))] = lapply(which(!is.na(ind.match)), function(x){sweep(newdata[[x]], 2, STATS = attr(X[[x]], "scaled:center"))})
                 if (scale)
                     newdata[which(!is.na(ind.match))] = lapply(which(!is.na(ind.match)), function(x){sweep(newdata[[x]], 2, FUN = "/", STATS = attr(X[[x]], "scaled:scale"))})
+                if (any(unlist(lapply(newdata[which(!is.na(ind.match))], function(x){any(is.infinite(x))})))) {
+                  newdata[which(!is.na(ind.match))] <- lapply(which(!is.na(ind.match)), function(x){df <- newdata[[x]]; df[which(is.infinite(df))] <- NaN; return(df)})
+                }
 
                 means.Y = matrix(attr(Y, "scaled:center"),nrow=nrow(newdata[[1]]),ncol=q,byrow=TRUE);
                 if (scale)

tests/testthat/test-auroc.R

@@ -21,3 +21,27 @@ test_that("auroc works", {
     rbind(0.9981, 7.124e-09))
 
  })
+
+
+
+test_that("Safely handles zero var (non-zero center) features", {
+
+  X1 <- data.frame(matrix(rnorm(100000, 5, 5), nrow = 100))
+  X2 <- data.frame(matrix(rnorm(150000, 5, 5), nrow = 100))
+  Y <- c(rep("A", 50), rep("B", 50))
+
+  X <- list(block1=X1, block2=X2)
+
+  list.keepX <- list(block1=c(15, 15), block2=c(30,30))
+
+  X$block1[,1] <- rep(1, 100)
+  model = suppressWarnings(block.splsda(X = X, Y = Y, ncomp = 2,
+                                        keepX = list.keepX, design = "full"))
+
+  set.seed(9425)
+  auc.splsda = .quiet(auroc(model))
+
+  .expect_numerically_close(auc.splsda$block1$comp1[[1]], 0.815)
+  .expect_numerically_close(auc.splsda$block2$comp2[[2]], 2.22e-16)
+
+})