workshop protected arguments warning

R/arguments.R

@@ -20,11 +20,12 @@ check_eng_args <- function(args, obj, core_args) {
   protected_args <- unique(c(obj$protect, core_args))
   common_args <- intersect(protected_args, names(args))
   if (length(common_args) > 0) {
-    args <- args[!(names(args) %in% common_args)]
-    common_args <- paste0(common_args, collapse = ", ")
     cli::cli_warn(
-      "The argument{?s} {.arg {common_args}} cannot be manually
-       modified and {?was/were} removed."
+      c(
+        "The argument{?s} {.arg {common_args}} cannot be manually modified
+         and {?was/were} removed."
+      ),
+      class = "parsnip_protected_arg_warning"
     )
   }
   args

tests/testthat/_snaps/arguments.md

@@ -0,0 +1,25 @@
+# warns informatively about protected arguments
+
+    Code
+      .res <- check_eng_args(args = list(a = 1, b = 2, c = 3, e = 5), obj = obj,
+      core_args = core_args)
+    Condition
+      Warning:
+      The arguments `a`, `b`, and `c` cannot be manually modified and were removed.
+
+---
+
+    Code
+      .res <- check_eng_args(args = list(b = 2, c = 3, e = 5), obj = obj, core_args = core_args)
+    Condition
+      Warning:
+      The arguments `b` and `c` cannot be manually modified and were removed.
+
+---
+
+    Code
+      .res <- check_eng_args(args = list(c = 3, e = 5), obj = obj, core_args = core_args)
+    Condition
+      Warning:
+      The argument `c` cannot be manually modified and was removed.
+

tests/testthat/_snaps/mlp.md

@@ -32,25 +32,6 @@
       x Engine "wat?" is not supported for `mlp()`
       i See `show_engines("mlp")`.
 
----
-
-    Code
-      translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x))
-    Condition
-      Warning:
-      The argument `formula` cannot be manually modified and was removed.
-    Output
-      Single Layer Neural Network Model Specification (regression)
-      
-      Main Arguments:
-        hidden_units = 5
-      
-      Computational engine: nnet 
-      
-      Model fit template:
-      nnet::nnet(formula = missing_arg(), data = missing_arg(), size = 5, 
-          trace = FALSE, linout = TRUE)
-
 # check_args() works
 
     Code

tests/testthat/_snaps/multinom_reg.md

@@ -40,26 +40,6 @@
       Error in `set_engine()`:
       ! Missing engine. Possible mode/engine combinations are: classification {glmnet, spark, keras, nnet, brulee}.
 
----
-
-    Code
-      translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[, 1:3],
-      y = hpc$class))
-    Condition
-      Warning:
-      The argument `x, y` cannot be manually modified and was removed.
-    Output
-      Multinomial Regression Model Specification (classification)
-
-      Main Arguments:
-        penalty = 0.1
-
-      Computational engine: glmnet 
-
-      Model fit template:
-      glmnet::glmnet(x = missing_arg(), y = missing_arg(), weights = missing_arg(), 
-          family = "multinomial")
-
 # check_args() works
 
     Code

tests/testthat/_snaps/nullmodel.md

@@ -15,22 +15,6 @@
       x Engine "wat?" is not supported for `null_model()`
       i See `show_engines("null_model")`.
 
----
-
-    Code
-      translate(null_model(mode = "regression") %>% set_engine("parsnip", x = hpc[, 1:
-        3], y = hpc$class))
-    Condition
-      Warning:
-      The argument `x, y` cannot be manually modified and was removed.
-    Output
-      Null Model Specification (regression)
-
-      Computational engine: parsnip 
-
-      Model fit template:
-      parsnip::nullmodel(x = missing_arg(), y = missing_arg())
-
 # nullmodel execution
 
     Code

tests/testthat/test-arguments.R

@@ -0,0 +1,37 @@
+test_that("warns informatively about protected arguments", {
+  obj <- list(protect = c("a", "b"))
+  core_args <- c("c", "d")
+
+  expect_snapshot(
+    .res <- check_eng_args(
+      args = list(a = 1, b = 2, c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    )
+  )
+
+  expect_snapshot(
+    .res <- check_eng_args(
+      args = list(b = 2, c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    )
+  )
+
+  expect_snapshot(
+    .res <- check_eng_args(
+      args = list(c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    )
+  )
+
+  expect_warning(
+    check_eng_args(
+      args = list(a = 1, b = 2, c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    ),
+    class = "parsnip_protected_arg_warning"
+  )
+})

tests/testthat/test-mlp.R

@@ -11,7 +11,10 @@ test_that('updating', {
 test_that('bad input', {
   expect_snapshot(error = TRUE, mlp(mode = "time series"))
   expect_snapshot(error = TRUE, translate(mlp(mode = "classification") %>% set_engine("wat?")))
-  expect_snapshot(translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)))
+  expect_warning(
+    translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)),
+    class = "parsnip_protected_arg_warning"
+  )
 })
 
 test_that("nnet_softmax", {

tests/testthat/test-multinom_reg.R

@@ -13,16 +13,21 @@ test_that('bad input', {
   expect_snapshot(error = TRUE, multinom_reg(mode = "regression"))
   expect_snapshot(error = TRUE, translate(multinom_reg(penalty = 0.1) %>% set_engine("wat?")))
   expect_snapshot(error = TRUE, multinom_reg(penalty = 0.1) %>% set_engine())
-  expect_snapshot(translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)))
+  expect_warning(
+    translate(
+      multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)
+    ),
+    class = "parsnip_protected_arg_warning"
+  )
 })
 
 test_that('check_args() works', {
   skip_if_not_installed("keras")
-  
+
   expect_snapshot(
     error = TRUE,
     {
-      spec <- multinom_reg(mixture = -1) %>% 
+      spec <- multinom_reg(mixture = -1) %>%
         set_engine("keras") %>%
         set_mode("classification")
       fit(spec, class ~ ., hpc)
@@ -31,7 +36,7 @@ test_that('check_args() works', {
   expect_snapshot(
     error = TRUE,
     {
-      spec <- multinom_reg(penalty = -1) %>% 
+      spec <- multinom_reg(penalty = -1) %>%
         set_engine("keras") %>%
         set_mode("classification")
       fit(spec, class ~ ., hpc)

tests/testthat/test-nullmodel.R

@@ -3,10 +3,11 @@ hpc <- hpc_data[1:150, c(2:5, 8)] %>% as.data.frame()
 test_that('bad input', {
   expect_snapshot(error = TRUE, translate(null_model(mode = "regression") %>% set_engine()))
   expect_snapshot(error = TRUE, translate(null_model() %>% set_engine("wat?")))
-  expect_snapshot(
+  expect_warning(
     translate(
       null_model(mode = "regression") %>% set_engine("parsnip", x = hpc[,1:3], y = hpc$class)
-    )
+    ),
+    class = "parsnip_protected_arg_warning"
   )
 })