Merge branch 'main' into rpart-1044

tidymodels · Jan 23, 2024 · df57ac5 · df57ac5
2 parents 5866aea + bf3f505
commit df57ac5
Show file tree

Hide file tree

Showing 31 changed files with 76 additions and 15 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -76,4 +76,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0
diff --git a/NAMESPACE b/NAMESPACE
@@ -5,6 +5,29 @@ S3method(.censoring_weights_graf,model_fit)
 S3method(augment,model_fit)
 S3method(autoplot,glmnet)
 S3method(autoplot,model_fit)
+S3method(check_args,C5_rules)
+S3method(check_args,bag_tree)
+S3method(check_args,boost_tree)
+S3method(check_args,cubist_rules)
+S3method(check_args,decision_tree)
+S3method(check_args,default)
+S3method(check_args,discrim_flexible)
+S3method(check_args,discrim_linear)
+S3method(check_args,discrim_regularized)
+S3method(check_args,linear_reg)
+S3method(check_args,logistic_reg)
+S3method(check_args,mars)
+S3method(check_args,mlp)
+S3method(check_args,multinom_reg)
+S3method(check_args,nearest_neighbor)
+S3method(check_args,pls)
+S3method(check_args,poisson_reg)
+S3method(check_args,rand_forest)
+S3method(check_args,surv_reg)
+S3method(check_args,survival_reg)
+S3method(check_args,svm_linear)
+S3method(check_args,svm_poly)
+S3method(check_args,svm_rbf)
 S3method(extract_fit_engine,model_fit)
 S3method(extract_parameter_dials,model_spec)
 S3method(extract_parameter_set_dials,model_spec)
@@ -180,6 +203,7 @@ export(bartMachine_interval_calc)
 export(boost_tree)
 export(case_weights_allowed)
 export(cforest_train)
+export(check_args)
 export(check_empty_ellipse)
 export(check_final_param)
 export(condense_control)

diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,10 @@
 
 * `rpart_train()` has been deprecated in favor of using `decision_tree()` with the `"rpart"` engine or `rpart::rpart()` directly (#1044).
 
+* Fixed bug in fitting some model types with the `"spark"` engine (#1045).
+
+* Fixed issue in `mlp()` metadata where the `stop_iter` engine argument had been mistakenly protected for the `"brulee"` engine. (#1050)
+
 * `.filter_eval_time()` was moved to the survival standalone file. 
 
 * Improved errors and documentation related to special terms in formulas. See `?model_formula` to learn more. (#770, #1014)

diff --git a/R/arguments.R b/R/arguments.R
@@ -328,7 +328,11 @@ min_cols <- function(num_cols, source) {
 #' @export
 #' @rdname min_cols
 min_rows <- function(num_rows, source, offset = 0) {
-  n <- nrow(source)
+  if (inherits(source, "tbl_spark")) {
+    n <- nrow_spark(source)
+  } else {
+    n <- nrow(source)
+  }
 
   if (num_rows > n - offset) {
     msg <- paste0(num_rows, " samples were requested but there were ", n,
@@ -340,3 +344,7 @@ min_rows <- function(num_rows, source, offset = 0) {
   as.integer(num_rows)
 }
 
+nrow_spark <- function(source) {
+  rlang::check_installed("sparklyr")
+  sparklyr::sdf_nrow(source)
+}
diff --git a/R/bag_tree.R b/R/bag_tree.R
@@ -84,6 +84,7 @@ update.bag_tree <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.bag_tree <- function(object) {
   if (object$engine == "C5.0" && object$mode == "regression")
     stop("C5.0 is classification only.", call. = FALSE)

diff --git a/R/boost_tree.R b/R/boost_tree.R
@@ -163,6 +163,7 @@ translate.boost_tree <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.boost_tree <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/c5_rules.R b/R/c5_rules.R
@@ -110,6 +110,7 @@ update.C5_rules <-
 
 # make work in different places
 
+#' @export
 check_args.C5_rules <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/cubist_rules.R b/R/cubist_rules.R
@@ -134,6 +134,7 @@ update.cubist_rules <-
 
 # make work in different places
 
+#' @export
 check_args.cubist_rules <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/decision_tree.R b/R/decision_tree.R
@@ -127,6 +127,7 @@ translate.decision_tree <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.decision_tree <- function(object) {
   if (object$engine == "C5.0" && object$mode == "regression")
     rlang::abort("C5.0 is classification only.")

diff --git a/R/discrim_flexible.R b/R/discrim_flexible.R
@@ -84,6 +84,7 @@ update.discrim_flexible <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.discrim_flexible <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/discrim_linear.R b/R/discrim_linear.R
@@ -79,6 +79,7 @@ update.discrim_linear <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.discrim_linear <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/discrim_regularized.R b/R/discrim_regularized.R
@@ -94,6 +94,7 @@ update.discrim_regularized <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.discrim_regularized <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/linear_reg.R b/R/linear_reg.R
@@ -105,6 +105,7 @@ update.linear_reg <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.linear_reg <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/logistic_reg.R b/R/logistic_reg.R
@@ -134,6 +134,7 @@ update.logistic_reg <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.logistic_reg <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/mars.R b/R/mars.R
@@ -104,6 +104,7 @@ translate.mars <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.mars <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/misc.R b/R/misc.R
@@ -282,10 +282,14 @@ show_fit <- function(model, eng) {
 
 # Check non-translated core arguments
 # Each model has its own definition of this
+#' @export
+#' @keywords internal
+#' @rdname add_on_exports
 check_args <- function(object) {
   UseMethod("check_args")
 }
 
+#' @export
 check_args.default <- function(object) {
   invisible(object)
 }

diff --git a/R/mlp.R b/R/mlp.R
@@ -125,6 +125,7 @@ translate.mlp <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.mlp <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/mlp_data.R b/R/mlp_data.R
@@ -433,16 +433,6 @@ set_model_arg(
   has_submodel = FALSE
 )
 
-
-set_model_arg(
-  model = "mlp",
-  eng = "brulee",
-  parsnip = "stop_iter",
-  original = "stop_iter",
-  func = list(pkg = "dials", fun = "stop_iter"),
-  has_submodel = FALSE
-)
-
 set_model_arg(
   model = "mlp",
   eng = "brulee",

diff --git a/R/multinom_reg.R b/R/multinom_reg.R
@@ -99,6 +99,7 @@ update.multinom_reg <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.multinom_reg <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/nearest_neighbor.R b/R/nearest_neighbor.R
@@ -97,6 +97,7 @@ positive_int_scalar <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.nearest_neighbor <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/pls.R b/R/pls.R
@@ -86,6 +86,7 @@ update.pls <-
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.pls <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/poisson_reg.R b/R/poisson_reg.R
@@ -100,6 +100,7 @@ translate.poisson_reg <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.poisson_reg <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)

diff --git a/R/rand_forest.R b/R/rand_forest.R
@@ -160,6 +160,7 @@ translate.rand_forest <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.rand_forest <- function(object) {
   # move translate checks here?
   invisible(object)

diff --git a/R/surv_reg.R b/R/surv_reg.R
@@ -82,6 +82,7 @@ translate.surv_reg <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.surv_reg <- function(object) {
 
   if (object$engine == "flexsurv") {

diff --git a/R/survival_reg.R b/R/survival_reg.R
@@ -81,7 +81,7 @@ translate.survival_reg <- function(x, engine = x$engine, ...) {
   x
 }
 
-
+#' @export
 check_args.survival_reg <- function(object) {
 
   if (object$engine == "flexsurv") {

diff --git a/R/svm_linear.R b/R/svm_linear.R
@@ -139,6 +139,7 @@ translate.svm_linear <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.svm_linear <- function(object) {
   invisible(object)
 }

diff --git a/R/svm_poly.R b/R/svm_poly.R
@@ -133,6 +133,7 @@ translate.svm_poly <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.svm_poly <- function(object) {
   invisible(object)
 }

diff --git a/R/svm_rbf.R b/R/svm_rbf.R
@@ -138,6 +138,7 @@ translate.svm_rbf <- function(x, engine = x$engine, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
 check_args.svm_rbf <- function(object) {
   invisible(object)
 }

diff --git a/R/tunable.R b/R/tunable.R
@@ -218,7 +218,7 @@ brulee_linear_engine_args <-
   brulee_mlp_engine_args %>%
   dplyr::filter(name %in% c("momentum", "batch_size", "stop_iter"))
 
-brulee_logistc_engine_args <-
+brulee_logistic_engine_args <-
   brulee_mlp_engine_args %>%
   dplyr::filter(name %in% c("momentum", "batch_size", "stop_iter", "class_weights"))
 
@@ -258,7 +258,7 @@ tunable.logistic_reg <- function(x, ...) {
     res$call_info[res$name == "mixture"] <-
       list(list(pkg = "dials", fun = "mixture", range = c(0.05, 1.00)))
   } else if (x$engine == "brulee") {
-    res <- add_engine_parameters(res, brulee_logistc_engine_args)
+    res <- add_engine_parameters(res, brulee_logistic_engine_args)
   }
   res
 }

diff --git a/man/add_on_exports.Rd b/man/add_on_exports.Rd
diff --git a/tests/testthat/test_boost_tree.R b/tests/testthat/test_boost_tree.R
@@ -28,6 +28,9 @@ test_that('bad input', {
 ## -----------------------------------------------------------------------------
 
 test_that('argument checks for data dimensions', {
+  skip_if_not_installed("sparklyr")
+  library(sparklyr)
+  skip_if(nrow(spark_installed_versions()) == 0)
 
   spec <-
     boost_tree(mtry = 1000, min_n = 1000, trees = 5) %>%
@@ -36,6 +39,10 @@ test_that('argument checks for data dimensions', {
 
   args <- translate(spec)$method$fit$args
   expect_equal(args$min_instances_per_node, expr(min_rows(1000, x)))
+
+  sc = spark_connect(master = "local")
+  cars = copy_to(sc, mtcars, overwrite = TRUE)
+  expect_equal(min_rows(10, cars), 10)
 })
 
 test_that('boost_tree can be fit with 1 predictor if validation is used', {
-Original file line number
+Diff line change
@@ Expand Up @@
       x
     }
+    #' @export
     check_args.survival_reg <- function(object) {
       if (object$engine == "flexsurv") {
@@ Expand Down @@