Merge pull request #129 from topepo/mixOmics

importance scores for PLS models from the mixOmics package.

DESCRIPTION

@@ -32,6 +32,7 @@ BugReports: https://github.com/koalaverse/vip/issues
 Encoding: UTF-8
 VignetteBuilder: knitr
 LazyData: true
+biocViews: mixOmics
 Imports: 
     ggplot2 (>= 0.9.0),
     gridExtra,
@@ -58,6 +59,7 @@ Suggests:
     keras,
     knitr,
     lattice,
+    mixOmics,
     mlbench,
     mlr,
     mlr3,

NAMESPACE

@@ -23,6 +23,8 @@ S3method(vi_model,earth)
 S3method(vi_model,gbm)
 S3method(vi_model,glmnet)
 S3method(vi_model,lm)
+S3method(vi_model,mixo_pls)
+S3method(vi_model,mixo_spls)
 S3method(vi_model,ml_model_decision_tree_classification)
 S3method(vi_model,ml_model_decision_tree_regression)
 S3method(vi_model,ml_model_gbt_classification)

R/vi_model.R

@@ -14,6 +14,10 @@
 #' argument in \code{\link[glmnet:predict.glmnet]{coef.glmnet}}). See the section on
 #' \code{\link[glmnet]{glmnet}} in the details below.
 #'
+#' @param ncomp An integer for the number of partial least squares components
+#' to be used in the importance calculations. If more components are requested
+#' than were used in the model, all of the model's components are used.
+#'
 #' @param ... Additional optional arguments to be passed on to other methods.
 #'
 #' @return A tidy data frame (i.e., a \code{"tibble"} object) with two columns:
@@ -876,6 +880,56 @@ vi_model.mvr <- function(object, ...) {
 
 }
 
+# Package: mixOmics  -----------------------------------------------------------
+
+#' @rdname vi_model
+#'
+#' @export
+vi_model.mixo_pls <- function(object, ncomp = NULL, ...) {
+
+  # Check for dependency
+  if (!requireNamespace("mixOmics", quietly = TRUE)) {
+    stop("Bioconductor package \"mixOmics\" needed for this function to work. ",
+         "Please install it.", call. = FALSE)
+  }
+  if (is.null(ncomp)) {
+    ncomp <- object$ncomp
+  } else {
+    if (length(ncomp) != 1) {
+      stop("'ncomp' should be a single integer.")
+    }
+    if (!is.integer(ncomp)) {
+      ncomp <- as.integer(ncomp)
+    }
+  }
+
+  vis <- mixOmics::vip(object)
+  if (ncomp > ncol(vis)) {
+    warning(ncomp, " components were requested but only ", ncol(vis),
+            " are available. Results are for ", ncol(vis), ".")
+    ncomp <- ncol(vis)
+  }
+
+  tib <- tibble::tibble(
+    "Variable" = rownames(vis),
+    "Importance" = vis[,ncomp]
+  )
+
+  # Add variable importance type attribute
+  attr(tib, which = "type") <- "mixOmics"
+
+  # Add "vi" class
+  class(tib) <- c("vi", class(tib))
+
+  # Return results
+  tib
+
+}
+
+#' @rdname vi_model
+#'
+#' @export
+vi_model.mixo_spls <- vi_model.mixo_pls
 
 # Package: randomForest --------------------------------------------------------
 

inst/tinytest/test_pkg_mixOmics.R

@@ -0,0 +1,96 @@
+# Exits
+if (!requireNamespace("mixOmics", quietly = TRUE)) {
+  exit_file("Bioconductor package mixOmics missing")
+}
+
+# Load required packages
+suppressMessages({
+  library(mixOmics)
+})
+
+# Generate Friedman benchmark data
+friedman1 <- gen_friedman(seed = 101)
+friedman3 <- gen_friedman(seed = 101, n_bins = 3)
+
+# univariate regression
+pls_mo    <- mixOmics::pls(friedman1[, -1], friedman1[, 1, drop = FALSE], ncomp = 3)
+spls_mo   <- mixOmics::spls(friedman1[, -1], friedman1[, 1, drop = FALSE],  ncomp = 3)
+
+pls_mo_imp    <- mixOmics::vip(pls_mo)
+spls_mo_imp   <- mixOmics::vip(spls_mo)
+
+# classification
+plsda_mo    <- mixOmics::plsda(friedman3[, -1], friedman3$y, ncomp = 3)
+splsda_mo   <- mixOmics::splsda(friedman3[, -1], friedman3$y, ncomp = 3)
+
+plsda_mo_imp  <- mixOmics::vip(plsda_mo)
+splsda_mo_imp <- mixOmics::vip(splsda_mo)
+
+# Expectations for `vi_model()`
+
+for (i in 1:3) {
+
+  pls_vip_imp <- vi_model(pls_mo, ncomp = i)
+  expect_identical(
+    current = pls_vip_imp$Importance,
+    target = pls_mo_imp[,i]
+  )
+
+  spls_vip_imp <- vi_model(spls_mo, ncomp = i)
+  expect_identical(
+    current = spls_vip_imp$Importance,
+    target = spls_mo_imp[,i]
+  )
+
+  plsda_vip_imp <- vi_model(plsda_mo, ncomp = i)
+  expect_identical(
+    current = plsda_vip_imp$Importance,
+    target = plsda_mo_imp[,i]
+  )
+
+  splsda_vip_imp <- vi_model(splsda_mo, ncomp = i)
+  expect_identical(
+    current = splsda_vip_imp$Importance,
+    target = splsda_mo_imp[,i]
+  )
+
+}
+
+pls_vip_imp <- vi_model(pls_mo)
+expect_identical(
+  current = pls_vip_imp$Importance,
+  target = pls_mo_imp[,3]
+)
+
+spls_vip_imp <- vi_model(spls_mo)
+expect_identical(
+  current = spls_vip_imp$Importance,
+  target = spls_mo_imp[,3]
+)
+
+plsda_vip_imp <- vi_model(plsda_mo)
+expect_identical(
+  current = plsda_vip_imp$Importance,
+  target = plsda_mo_imp[,3]
+)
+
+splsda_vip_imp <- vi_model(splsda_mo)
+expect_identical(
+  current = splsda_vip_imp$Importance,
+  target = splsda_mo_imp[,3]
+)
+
+expect_error(
+  vi_model(pls_mo, ncomp = 1:3),
+  "should be a single integer"
+)
+
+
+expect_warning(
+  too_many <- vi_model(pls_mo, ncomp = 300),
+  "Results are for 3"
+)
+expect_identical(
+  current = too_many$Importance,
+  target = pls_mo_imp[,3]
+)