Fix for Issue #237 (#238)

fix: `plotVar()` can now utilise `block.pls` and `block.spls` objects which have a single Y feature (ie. (s)PLS1)

R/plotVar.R

@@ -453,6 +453,11 @@ plotVar <-
         if (any(sapply(cord.X, nrow) == 0))
             stop("No variable selected on at least one block")
 
+        if (any(sapply(cord.X, nrow) == 1)) {
+          cord.X <- cord.X[-which(sapply(cord.X, nrow) == 1)]
+        }
+
+
         #-- End: Retrieve variates from object
 
         #-- Names of labels X and Y

R/selectVar.R

@@ -137,6 +137,7 @@ selectVar.rgcca <- selectVar.mixo_pls
 get.name.and.value <- function(x,comp)
 {
     value <- data.frame(value.var = x[,comp])
+    rownames(value) <- rownames(x)
     value <- value[abs(value$value.var) > .Machine$double.eps,,drop=FALSE]
     value <- value[order(-abs(value$value.var)),,drop=FALSE]
 

tests/testthat/test-plotVar.R

@@ -27,3 +27,22 @@ test_that("plotVar works for pls with var.names", {
   expect_true(all(df$names %in% as.character(unlist(var.names))))
 
 })
+
+test_that("plotVar works in block.(s)PLS1 cases", {
+
+  data(breast.TCGA)
+  X <- list(miRNA = breast.TCGA$data.train$mirna[,1:10],
+            mRNA = breast.TCGA$data.train$mrna[,1:10])
+
+  Y <- matrix(breast.TCGA$data.train$protein[,4], ncol=1)
+  rownames(Y) <- rownames(X$miRNA)
+  colnames(Y) <- "response"
+
+  block.pls.result <- block.spls(X, Y, design = "full",
+                                 keepX = list(miRNA=c(3,3),
+                                              mRNA=c(3,3)))
+
+  plotVar.result <- plotVar(block.pls.result, plot = FALSE)
+
+  expect_equal(as.character(unique(plotVar.result$Block)), c("miRNA", "mRNA"))
+})