changes for cran submission

Author: topepo

.gitignore

@@ -4,3 +4,4 @@
 .DS_Store
 tests/testthat/derby.log
 tests/testthat/logs/
+*.history

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: parsnip
 Version: 0.0.1
 Title: A Common API to Modeling and Analysis Functions
-Description: A common interface is provided to allow users to specify a model without having to remember the different argument names across different functions or computational engines (e.g. R, Spark, Stan, etc). 
+Description: A common interface is provided to allow users to specify a model without having to remember the different argument names across different functions or computational engines (e.g. 'R', 'Spark', 'Stan', etc). 
 Authors@R: c(
     person("Max", "Kuhn", , "[email protected]", c("aut", "cre")),
     person("Davis", "Vaughan", , "[email protected]", c("aut")),

NAMESPACE

@@ -190,5 +190,4 @@ importFrom(utils,capture.output)
 importFrom(utils,getFromNamespace)
 importFrom(utils,globalVariables)
 importFrom(utils,head)
-importFrom(utils,installed.packages)
 importFrom(utils,stack)

R/engines.R

@@ -38,21 +38,43 @@ check_engine <- function(object) {
   object
 }
 
-#' @importFrom utils installed.packages
+# ------------------------------------------------------------------------------
+
+shhhh <- function(x)
+  suppressPackageStartupMessages(requireNamespace(x, quietly = TRUE))
+
+is_installed <- function(pkg) {
+  res <- try(shhhh(pkg), silent = TRUE)
+  res
+}
+
+#' @importFrom purrr map_lgl
 check_installs <- function(x) {
-  if (length(x$method$library) > 0) {
-    lib_inst <- rownames(installed.packages())
-    is_inst <- x$method$library %in% lib_inst
+  if (length(x$method$libs) > 0) {
+    is_inst <- map_lgl(x$method$libs, is_installed)
     if (any(!is_inst)) {
       stop(
         "This engine requires some package installs: ",
-        paste0("'", x$method$library[!is_inst], "'", collapse = ", "),
+        paste0("'", x$method$libs[!is_inst], "'", collapse = ", "),
         call. = FALSE
       )
     }
   }
 }
 
+load_libs <- function(x, quiet, attach = FALSE) {
+  for (pkg in x$method$libs) {
+    if (!attach) {
+      suppressPackageStartupMessages(requireNamespace(pkg, quietly = quiet))
+    } else {
+      library(pkg, character.only = TRUE)
+    }
+  }
+  invisible(x)
+}
+
+# ------------------------------------------------------------------------------
+
 #' Declare a computational engine and specific arguments
 #'
 #' `set_engine` is used to specify which package or system will be used

R/fit.R

@@ -120,7 +120,7 @@ fit.model_spec <-
 
     check_installs(object)  # TODO rewrite with pkgman
 
-    load_libs(object, control$verbosity < 2)
+    check_installs(object)
 
     interfaces <- paste(fit_interface, object$method$fit$interface, sep = "_")
 
@@ -199,7 +199,7 @@ fit_xy.model_spec <-
 
     check_installs(object)  # TODO rewrite with pkgman
 
-    load_libs(object, control$verbosity < 2)
+    check_installs(object)
 
     interfaces <- paste(fit_interface, object$method$fit$interface, sep = "_")
 

R/mars.R

@@ -110,6 +110,7 @@ update.mars <-
            num_terms = NULL, prod_degree = NULL, prune_method = NULL,
            fresh = FALSE, ...) {
     update_dot_check(...)
+
     args <- list(
       num_terms    = enquo(num_terms),
       prod_degree  = enquo(prod_degree),
@@ -180,6 +181,7 @@ check_args.mars <- function(object) {
 
 #' @importFrom purrr map_dfr
 earth_submodel_pred <- function(object, new_data, terms = 2:3, ...) {
+  load_libs(object, quiet = TRUE, attach = TRUE)
   map_dfr(terms, earth_reg_updater, object = object, newdata = new_data, ...)
 }
 
@@ -208,7 +210,9 @@ multi_predict._earth <-
   function(object, new_data, type = NULL, num_terms = NULL, ...) {
     if (any(names(enquos(...)) == "newdata"))
       stop("Did you mean to use `new_data` instead of `newdata`?", call. = FALSE)
-    
+
+    load_libs(object, quiet = TRUE, attach = TRUE)
+
     if (is.null(num_terms))
       num_terms <- object$fit$selected.terms[-1]
 
@@ -232,9 +236,6 @@ multi_predict._earth <-
     } else
       stop (msg, call. = FALSE)
 
-    if (!exists("earth"))
-      suppressPackageStartupMessages(attachNamespace("earth"))
-
     if (is.null(type)) {
       if (object$spec$mode == "classification")
         type <- "class"

R/misc.R

@@ -79,17 +79,6 @@ model_printer <- function(x, ...) {
   }
 }
 
-load_libs <- function(x, quiet, attach = FALSE) {
-  for (pkg in x$method$libs) {
-    if(attach) {
-    suppressPackageStartupMessages(requireNamespace(pkg, quietly = quiet))
-    } else {
-      library(pkg, character.only = TRUE)
-    }
-  }
-  invisible(x)
-}
-
 is_missing_arg <- function(x)
   identical(x, quote(missing_arg()))
 

tests/testthat/test_mars.R

@@ -217,11 +217,13 @@ test_that('submodel prediction', {
     set_engine("earth", keepxy = TRUE) %>%
     fit(mpg ~ ., data = mtcars[-(1:4), ])
 
+  parsnip:::load_libs(reg_fit$spec, quiet = TRUE, attach = TRUE)
   tmp_reg <- reg_fit$fit
   tmp_reg$call[["pmethod"]] <- eval_tidy(tmp_reg$call[["pmethod"]])
   tmp_reg$call[["keepxy"]]  <- eval_tidy(tmp_reg$call[["keepxy"]])
   tmp_reg$call[["nprune"]]  <- eval_tidy(tmp_reg$call[["nprune"]])
 
+
   pruned_reg <- update(tmp_reg, nprune = 5)
   pruned_reg_pred <- predict(pruned_reg, mtcars[1:4, -1])[,1]