pass call to check_for_disaster()

tidymodels · Jan 21, 2025 · e2d17c0 · e2d17c0
1 parent 828cecd
commit e2d17c0
Show file tree

Hide file tree

Showing 8 changed files with 20 additions and 17 deletions.
diff --git a/R/C5.0.R b/R/C5.0.R
@@ -1,5 +1,5 @@
 
-c5_bagger <- function(rs, control, ...) {
+c5_bagger <- function(rs, control, ..., call) {
 
   opt <- rlang::dots_list(...)
   mod_spec <- make_c5_spec(opt)
@@ -17,7 +17,7 @@ c5_bagger <- function(rs, control, ...) {
       control = control
     ))
 
-  rs <- check_for_disaster(rs)
+  rs <- check_for_disaster(rs, call = call)
 
   rs <- filter_rs(rs)
 

diff --git a/R/bridge.R b/R/bridge.R
@@ -20,10 +20,10 @@ bagger_bridge <- function(processed, weights, base_model, seed, times, control,
   if (is.null(cost)) {
     res <- switch(
       base_model,
-      CART = cart_bagger(rs, control, ...),
-      C5.0 =   c5_bagger(rs, control, ...),
-      MARS = mars_bagger(rs, control, ...),
-      nnet = nnet_bagger(rs, control, ...)
+      CART = cart_bagger(rs, control, ..., call = call),
+      C5.0 =   c5_bagger(rs, control, ..., call = call),
+      MARS = mars_bagger(rs, control, ..., call = call),
+      nnet = nnet_bagger(rs, control, ..., call = call)
     )
   } else {
     res <- switch(

diff --git a/R/cart.R b/R/cart.R
@@ -1,5 +1,5 @@
 
-cart_bagger <- function(rs, control, ...) {
+cart_bagger <- function(rs, control, ..., call) {
   opt <- rlang::dots_list(...)
   is_classif <- is.factor(rs$splits[[1]]$data$.outcome)
   mod_spec <- make_cart_spec(is_classif, opt)
@@ -19,7 +19,7 @@ cart_bagger <- function(rs, control, ...) {
       )
     )
 
-  rs <- check_for_disaster(rs)
+  rs <- check_for_disaster(rs, call = call)
 
   rs <- filter_rs(rs)
 

diff --git a/R/cost_models.R b/R/cost_models.R
@@ -37,7 +37,7 @@ cost_sens_cart_bagger <- function(rs, control, cost, ..., call = rlang::caller_e
     opt$parms <- list(loss = cost)
   }
 
-  cart_bagger(rs = rs, control = control, !!!opt)
+  cart_bagger(rs = rs, control = control, call = call, !!!opt)
 }
 
 
@@ -54,5 +54,5 @@ cost_sens_c5_bagger <- function(rs, control, cost, ..., call = rlang::caller_env
   # Attach cost matrix to options
   opt$costs <-  cost
 
-  c5_bagger(rs = rs, control = control, !!!opt)
+  c5_bagger(rs = rs, control = control, call = call, !!!opt)
 }
diff --git a/R/mars.R b/R/mars.R
@@ -1,5 +1,5 @@
 
-mars_bagger <- function(rs, control, ...) {
+mars_bagger <- function(rs, control, ..., call) {
 
   opt <- rlang::dots_list(...)
   is_classif <- is.factor(rs$splits[[1]]$data$.outcome)
@@ -18,7 +18,7 @@ mars_bagger <- function(rs, control, ...) {
       control = control
     ))
 
-  rs <- check_for_disaster(rs)
+  rs <- check_for_disaster(rs, call = call)
 
   rs <- filter_rs(rs)
 

diff --git a/R/nnet.R b/R/nnet.R
@@ -1,5 +1,5 @@
 
-nnet_bagger <- function(rs, control, ...) {
+nnet_bagger <- function(rs, control, ..., call) {
   opt <- rlang::dots_list(...)
   is_classif <- is.factor(rs$splits[[1]]$data$.outcome)
   mod_spec <- make_nnet_spec(is_classif, opt)
@@ -19,7 +19,7 @@ nnet_bagger <- function(rs, control, ...) {
       )
     )
 
-  rs <- check_for_disaster(rs)
+  rs <- check_for_disaster(rs, call = call)
 
   rs <- filter_rs(rs)
 

diff --git a/R/validate.R b/R/validate.R
@@ -69,9 +69,12 @@ check_for_disaster <- function(x, call = rlang::caller_env()) {
     if (!is.na(msg)) {
       # escape any brackets in the error message
       msg <- cli::format_error("{msg}")
-      cli::cli_abort(c("All of the models failed. Example:", "x" = "{msg}"))
+      cli::cli_abort(
+        c("All of the models failed. Example:", "x" = "{msg}"),
+        call = call
+      )
     } else {
-      cli::cli_abort("All of the models failed.")
+      cli::cli_abort("All of the models failed.", call = call)
     }
   }
   x

diff --git a/tests/testthat/_snaps/validation.md b/tests/testthat/_snaps/validation.md
@@ -160,7 +160,7 @@
       set.seed(459394)
       bagger(a ~ ., data = bad_iris, base_model = "CART", times = 3)
     Condition
-      Error in `check_for_disaster()`:
+      Error in `bagger()`:
       ! All of the models failed. Example:
       x Error in cbind(yval2, yprob, nodeprob) : number of rows of matrices must match (see arg 2)