test and documentation update

Author: topepo

R/boost_tree.R

@@ -150,6 +150,7 @@ print.boost_tree <- function(x, ...) {
 #' @export
 #' @inheritParams boost_tree
 #' @param object A boosted tree model specification.
+#' @param ... Not used for `update`.
 #' @param fresh A logical for whether the arguments should be
 #'  modified in-place of or replaced wholesale.
 #' @return An updated model specification.
@@ -166,7 +167,9 @@ update.boost_tree <-
            mtry = NULL, trees = NULL, min_n = NULL,
            tree_depth = NULL, learn_rate = NULL,
            loss_reduction = NULL, sample_size = NULL,
-           fresh = FALSE) {
+           fresh = FALSE, ...) {
+    update_dot_check(...)
+
     args <- list(
       mtry = enquo(mtry),
       trees = enquo(trees),

R/engines.R

@@ -52,3 +52,35 @@ check_installs <- function(x) {
     }
   }
 }
+
+#' Declare a computational engine and specific arguments
+#'
+#' `set_engine` is used to specify which package or system will be used
+#'  to fit the model, along with any arguments specific to that software.
+#'
+#' @param object A model specification.
+#' @param engine A character string for the software that should
+#'  be used to fit the model. This is highly dependent on the type
+#'  of model (e.g. linear regression, random forest, etc.).
+#' @param ... Any optional arguments associated with the chosen computational
+#'  engine. These are captured as quosures and can be `varying()`.
+#' @return An updated model specification.
+#' @examples
+#' # First, set general arguments using the standardized names
+#' mod <-
+#'   logistic_reg(mixture = 1/3) %>%
+#'   # now say how you want to fit the model and another other options
+#'   set_engine("glmnet", nlambda = 10)
+#' translate(mod, engine = "glmnet")
+#' @export
+set_engine <- function(object, engine, ...) {
+  if (!is.character(engine) | length(engine) != 1)
+    stop("`engine` should be a single character value.", call. = FALSE)
+
+  object$engine <- engine
+  object <- check_engine(object)
+
+
+  object$others  <- enquos(...)
+  object
+}

R/fit.R

@@ -9,7 +9,8 @@
 #'  code by substituting arguments, and execute the model fit
 #'  routine.
 #'
-#' @param object An object of class `model_spec`
+#' @param object An object of class `model_spec` that has a chosen engine
+#'  (via [set_engine()]).
 #' @param formula An object of class "formula" (or one that can
 #'  be coerced to that class): a symbolic description of the model
 #'  to be fitted.
@@ -45,21 +46,20 @@
 #' library(dplyr)
 #' data("lending_club")
 #'
-#' lm_mod <- logistic_reg()
+#' lr_mod <- logistic_reg()
 #'
-#' lm_mod <- logistic_reg()
+#' lr_mod <- logistic_reg()
 #'
 #' using_formula <-
-#'   lm_mod %>%
-#'   fit(Class ~ funded_amnt + int_rate,
-#'       data = lending_club,
-#'       engine = "glm")
+#'   lr_mod %>%
+#'   set_engine("glm") %>%
+#'   fit(Class ~ funded_amnt + int_rate, data = lending_club)
 #'
 #' using_xy <-
-#'   lm_mod %>%
+#'   lr_mod %>%
+#'    set_engine("glm") %>%
 #'   fit_xy(x = lending_club[, c("funded_amnt", "int_rate")],
-#'          y = lending_club$Class,
-#'          engine = "glm")
+#'          y = lending_club$Class)
 #'
 #' using_formula
 #' using_xy
@@ -79,6 +79,7 @@
 #'  The return value will also have a class related to the fitted model (e.g.
 #'  `"_glm"`) before the base class of `"model_fit"`.
 #'
+#' @seealso [set_engine()], [fit_control()], `model_spec`, `model_fit`
 #' @param x A matrix or data frame of predictors.
 #' @param y A vector, matrix or data frame of outcome data.
 #' @rdname fit

R/linear_reg.R

@@ -154,8 +154,8 @@ print.linear_reg <- function(x, ...) {
 update.linear_reg <-
   function(object,
            penalty = NULL, mixture = NULL,
-           fresh = FALSE) {
-
+           fresh = FALSE, ...) {
+    update_dot_check(...)
     args <- list(
       penalty = enquo(penalty),
       mixture = enquo(mixture)

R/logistic_reg.R

@@ -153,8 +153,8 @@ print.logistic_reg <- function(x, ...) {
 update.logistic_reg <-
   function(object,
            penalty = NULL, mixture = NULL,
-           fresh = FALSE) {
-
+           fresh = FALSE, ...) {
+    update_dot_check(...)
     args <- list(
       penalty = enquo(penalty),
       mixture = enquo(mixture)

R/mars.R

@@ -109,8 +109,8 @@ print.mars <- function(x, ...) {
 update.mars <-
   function(object,
            num_terms = NULL, prod_degree = NULL, prune_method = NULL,
-           fresh = FALSE) {
-
+           fresh = FALSE, ...) {
+    update_dot_check(...)
     args <- list(
       num_terms    = enquo(num_terms),
       prod_degree  = enquo(prod_degree),
@@ -164,7 +164,7 @@ check_args.mars <- function(object) {
 
   if (!is_varying(args$prune_method) &&
       !is.null(args$prune_method) &&
-      is.character(args$prune_method))
+      !is.character(args$prune_method))
     stop("`prune_method` should be a single string value", call. = FALSE)
 
   invisible(object)

R/misc.R

@@ -190,3 +190,16 @@ names0 <- function (num, prefix = "x") {
   ind <- gsub(" ", "0", ind)
   paste0(prefix, ind)
 }
+
+
+# ------------------------------------------------------------------------------
+
+update_dot_check <- function(...) {
+  dots <- enquos(...)
+  if (length(dots) > 0)
+    stop("Extra arguments will be ignored: ",
+         paste0("`", names(dots), "`", collapse = ", "),
+         call. = FALSE)
+  invisible(NULL)
+}
+

R/mlp.R

@@ -144,8 +144,8 @@ update.mlp <-
   function(object,
            hidden_units = NULL, penalty = NULL, dropout = NULL,
            epochs = NULL, activation = NULL,
-           fresh = FALSE) {
-
+           fresh = FALSE, ...) {
+    update_dot_check(...)
     args <- list(
       hidden_units = enquo(hidden_units),
       penalty      = enquo(penalty),

R/model_object_docs.R

@@ -175,10 +175,12 @@ NULL
 #' @examples
 #'
 #' # Keep the `x` matrix if the data are not too big.
-#' spec_obj <- linear_reg(x = ifelse(.obs() < 500, TRUE, FALSE))
+#' spec_obj <-
+#'   linear_reg() %>%
+#'   set_engine("lm", x = ifelse(.obs() < 500, TRUE, FALSE))
 #' spec_obj
 #'
-#' fit_obj <- fit(spec_obj, mpg ~ ., data = mtcars, engine = "lm")
+#' fit_obj <- fit(spec_obj, mpg ~ ., data = mtcars)
 #' fit_obj
 #'
 #' nrow(fit_obj$fit$x)

R/multinom_reg.R

@@ -136,7 +136,8 @@ print.multinom_reg <- function(x, ...) {
 update.multinom_reg <-
   function(object,
            penalty = NULL, mixture = NULL,
-           fresh = FALSE) {
+           fresh = FALSE, ...) {
+    update_dot_check(...)
     args <- list(
       penalty = enquo(penalty),
       mixture = enquo(mixture)