user code to determine required packages

Author: topepo

R/req_pkgs.R

@@ -0,0 +1,53 @@
+#' Determine required packages for a model
+#'
+#' @param x A model specification or fit.
+#' @param ... Not used.
+#' @return A character string of package names (if any).
+#' @details
+#' For a model specification, the engine must be set.
+#'
+#' The list does not include the `parsnip` package.
+#' @examples
+#' should_fail <- try(req_pkgs(linear_reg()), silent = TRUE)
+#' should_fail
+#'
+#' linear_reg() %>%
+#'   set_engine("glmnet") %>%
+#'   req_pkgs()
+#'
+#' linear_reg() %>%
+#'   set_engine("lm") %>%
+#'   fit(mpg ~ ., data = mtcars) %>%
+#'   req_pkgs()
+#' @export
+req_pkgs <- function(x, ...) {
+  UseMethod("req_pkgs")
+}
+
+#' @export
+#' @rdname req_pkgs
+req_pkgs.model_spec <- function(x, ...) {
+  if (is.null(x$engine)) {
+    rlang::abort("Please set an engine.")
+  }
+  get_pkgs(x)
+}
+
+#' @export
+#' @rdname req_pkgs
+req_pkgs.model_fit <- function(x, ...) {
+  get_pkgs(x$spec)
+}
+
+get_pkgs <- function(x) {
+  cls <- class(x)[1]
+  pkgs <-
+    get_from_env(paste0(cls, "_pkgs")) %>%
+    dplyr::filter(engine == x$engine)
+  res <- pkgs$pkg[[1]]
+  if (length(res) == 0) {
+    res <- character(0)
+  }
+  res
+}
+

man/req_pkgs.Rd

@@ -0,0 +1,41 @@
+
+context("checking for packages")
+load(test_path("mars_model.RData"))
+
+# ------------------------------------------------------------------------------
+
+test_that('required packages', {
+
+  expect_error(req_pkgs(linear_reg()), "Please set an engine")
+
+  glmn <-
+    linear_reg() %>%
+    set_engine("glmnet") %>%
+    req_pkgs()
+  expect_equal(glmn, "glmnet")
+
+  lm_fit <-
+    linear_reg() %>%
+    set_engine("lm") %>%
+    fit(mpg ~ ., data = mtcars) %>%
+    req_pkgs()
+  expect_equal(lm_fit, "stats")
+})
+
+# ------------------------------------------------------------------------------
+
+test_that('missing packages', {
+  has_earth <- parsnip:::is_installed("earth")
+
+  if (has_earth) {
+    expect_error(predict(mars_model, mtcars[1:3, -1]), regexp = NA)
+
+  } else {
+    expect_error(predict(mars_model, mtcars[1:3, -1]), regexp = "earth")
+    expect_true(any(names(sessionInfo()$loadedOnly) == "earth"))
+  }
+  mars_model$spec$method$libs <- "rootveggie"
+  expect_error(predict(mars_model, mtcars[1:3, -1]), regexp = "rootveggie")
+
+})
+