From ee4aab43a77e9ea098b583a1e64240377dc617f0 Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 13:20:04 -0700
Subject: [PATCH 1/7] add condense_control function

---
 NAMESPACE               |  1 +
 R/condense_control.R    | 43 +++++++++++++++++++++++++++++++++++++++++
 _pkgdown.yml            |  1 +
 man/condense_control.Rd | 32 ++++++++++++++++++++++++++++++
 4 files changed, 77 insertions(+)
 create mode 100644 R/condense_control.R
 create mode 100644 man/condense_control.Rd

diff --git a/NAMESPACE b/NAMESPACE
index d6dc187bd..1158e37fe 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -155,6 +155,7 @@ export(check_empty_ellipse)
 export(check_final_param)
 export(check_model_doesnt_exist)
 export(check_model_exists)
+export(condense_control)
 export(contr_one_hot)
 export(control_parsnip)
 export(convert_stan_interval)
diff --git a/R/condense_control.R b/R/condense_control.R
new file mode 100644
index 000000000..0b30e3de7
--- /dev/null
+++ b/R/condense_control.R
@@ -0,0 +1,43 @@
+#' Condense control object into strictly smaller control object
+#'
+#' This function is used to help the hierarchy of control functions used
+#' throughout the tidymodels packages. It is now assumed that each control
+#' function is either a subset or a superset of another control function.
+#'
+#' @param x A control object to be condensed.
+#' @param ref A control object that is used to determine what element should be
+#'   kept.
+#'
+#' @return A control object with the same elements and classes of `ref`, with
+#'   values of `x`.
+#' @keywords internal
+#' @export
+#'
+#' @examples
+#' ctrl <- control_parsnip(catch = TRUE)
+#' ctrl$allow_par <- TRUE
+#' str(ctrl)
+#'
+#' ctrl <- condense_control(ctrl, control_parsnip())
+#' str(ctrl)
+condense_control <- function(x, ref) {
+  mismatch <- setdiff(names(ref), names(x))
+  if (length(mismatch)) {
+    rlang::abort(
+      c(
+        glue::glue(
+          "Object of class `{class(x)[1]}` cannot be corresed to ",
+          "object of class `{class(ref)[1]}`."
+        ),
+        "The following arguments are missing:",
+        glue::glue_collapse(
+          glue::single_quote(mismatch),
+          sep = ", ", last = ", and"
+        )
+      )
+    )
+  }
+  res <- x[names(ref)]
+  class(res) <- class(ref)
+  res
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 8e36a6d1d..f15ab3825 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -94,6 +94,7 @@ reference:
 
   - title: Developer tools
     contents:
+      - condense_control
       - contr_one_hot
       - set_new_model
       - maybe_matrix
diff --git a/man/condense_control.Rd b/man/condense_control.Rd
new file mode 100644
index 000000000..865102bb9
--- /dev/null
+++ b/man/condense_control.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/condense_control.R
+\name{condense_control}
+\alias{condense_control}
+\title{Condense control object into strictly smaller control object}
+\usage{
+condense_control(x, ref)
+}
+\arguments{
+\item{x}{A control object to be condensed.}
+
+\item{ref}{A control object that is used to determine what element should be
+kept.}
+}
+\value{
+A control object with the same elements and classes of \code{ref}, with
+values of \code{x}.
+}
+\description{
+This function is used to help the hierarchy of control functions used
+throughout the tidymodels packages. It is now assumed that each control
+function is either a subset or a superset of another control function.
+}
+\examples{
+ctrl <- control_parsnip(catch = TRUE)
+ctrl$allow_par <- TRUE
+str(ctrl)
+
+ctrl <- condense_control(ctrl, control_parsnip())
+str(ctrl)
+}
+\keyword{internal}

From 6ebd0ad0b225a7c339d238285b593b606de99a36 Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 13:25:30 -0700
Subject: [PATCH 2/7] add tests for condense_control

---
 tests/testthat/_snaps/condense_control.md | 10 ++++++++++
 tests/testthat/test_condense_control.R    | 20 ++++++++++++++++++++
 2 files changed, 30 insertions(+)
 create mode 100644 tests/testthat/_snaps/condense_control.md
 create mode 100644 tests/testthat/test_condense_control.R

diff --git a/tests/testthat/_snaps/condense_control.md b/tests/testthat/_snaps/condense_control.md
new file mode 100644
index 000000000..d37f2c7c6
--- /dev/null
+++ b/tests/testthat/_snaps/condense_control.md
@@ -0,0 +1,10 @@
+# condense_control works
+
+    Code
+      condense_control(control_parsnip(), ctrl)
+    Condition
+      Error in `condense_control()`:
+      ! Object of class `control_parsnip` cannot be corresed to object of class `control_parsnip`.
+      * The following arguments are missing:
+      * 'allow_par'
+
diff --git a/tests/testthat/test_condense_control.R b/tests/testthat/test_condense_control.R
new file mode 100644
index 000000000..213369e67
--- /dev/null
+++ b/tests/testthat/test_condense_control.R
@@ -0,0 +1,20 @@
+test_that("condense_control works", {
+  ctrl <- control_parsnip()
+
+  expect_equal(
+    condense_control(ctrl, ctrl),
+    ctrl
+  )
+
+  ctrl$allow_par <- TRUE
+  ctrl$catch <- TRUE
+
+  expect_equal(
+    condense_control(ctrl, control_parsnip()),
+    control_parsnip(catch = TRUE)
+  )
+
+  expect_snapshot(error = TRUE,
+    condense_control(control_parsnip(), ctrl)
+  )
+})

From ed84834deca90a44d5c8c665b3e8285deeb3032f Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 13:54:51 -0700
Subject: [PATCH 3/7] use condense_control function

---
 R/fit.R                    | 9 +++------
 tests/testthat/test_misc.R | 6 ++++--
 2 files changed, 7 insertions(+), 8 deletions(-)

diff --git a/R/fit.R b/R/fit.R
index 24f1092d3..533cd3de0 100644
--- a/R/fit.R
+++ b/R/fit.R
@@ -112,9 +112,7 @@ fit.model_spec <-
     if (object$mode == "unknown") {
       rlang::abort("Please set the mode in the model specification.")
     }
-    if (!identical(class(control), class(control_parsnip()))) {
-      rlang::abort("The 'control' argument should have class 'control_parsnip'.")
-    }
+    control <- condense_control(control, control_parsnip())
     check_case_weights(case_weights, object)
 
     dots <- quos(...)
@@ -238,9 +236,8 @@ fit_xy.model_spec <-
       rlang::abort("Survival models must use the formula interface.")
     }
 
-    if (!identical(class(control), class(control_parsnip()))) {
-      rlang::abort("The 'control' argument should have class 'control_parsnip'.")
-    }
+    control <- condense_control(control, control_parsnip())
+
     if (is.null(colnames(x))) {
       rlang::abort("'x' should have column names.")
     }
diff --git a/tests/testthat/test_misc.R b/tests/testthat/test_misc.R
index 10c778926..8b464a392 100644
--- a/tests/testthat/test_misc.R
+++ b/tests/testthat/test_misc.R
@@ -76,13 +76,15 @@ test_that('control class', {
   x <- linear_reg() %>% set_engine("lm")
   ctrl <- control_parsnip()
   class(ctrl) <- c("potato", "chair")
+  # This doesn't error anymore because `condense_control()` doesn't care about
+  # classes, it cares about elements
   expect_error(
     fit(x, mpg ~ ., data = mtcars, control = ctrl),
-    "The 'control' argument should have class 'control_parsnip'"
+    NA
   )
   expect_error(
     fit_xy(x, x = mtcars[, -1], y = mtcars$mpg, control = ctrl),
-    "The 'control' argument should have class 'control_parsnip'"
+    NA
   )
 })
 

From 45defca8ad55a5574c4cfbb9ad1c17c8106a10be Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 13:55:05 -0700
Subject: [PATCH 4/7] update news about condense_control

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index a5f3a7615..613f6ca80 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,6 +4,8 @@
 
 * `fit_xy()` now fails when the model mode is unknown. 
 
+* `fit()` and `fit_xy()` doesn't error anymore if `control` argument isn't a `control_parsnip()` object. Will work as long as the object passed to `control` includes the same elements as `control_parsnip()`.
+
 # parsnip 1.0.1
 
 * Enabled passing additional engine arguments with the xgboost `boost_tree()` engine. To supply engine-specific arguments that are documented in `xgboost::xgb.train()` as arguments to be passed via `params`, supply the list elements directly as named arguments to `set_engine()`. Read more in `?details_boost_tree_xgboost` (#787).

From 7832e421f4f278906073261889432d119fa03ed4 Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 14:06:56 -0700
Subject: [PATCH 5/7] correct spacing

---
 R/condense_control.R                      | 2 +-
 tests/testthat/_snaps/condense_control.md | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/condense_control.R b/R/condense_control.R
index 0b30e3de7..3ac9f154f 100644
--- a/R/condense_control.R
+++ b/R/condense_control.R
@@ -32,7 +32,7 @@ condense_control <- function(x, ref) {
         "The following arguments are missing:",
         glue::glue_collapse(
           glue::single_quote(mismatch),
-          sep = ", ", last = ", and"
+          sep = ", ", last = ", and "
         )
       )
     )
diff --git a/tests/testthat/_snaps/condense_control.md b/tests/testthat/_snaps/condense_control.md
index d37f2c7c6..c1e2b5dba 100644
--- a/tests/testthat/_snaps/condense_control.md
+++ b/tests/testthat/_snaps/condense_control.md
@@ -6,5 +6,5 @@
       Error in `condense_control()`:
       ! Object of class `control_parsnip` cannot be corresed to object of class `control_parsnip`.
       * The following arguments are missing:
-      * 'allow_par'
+      * 'allow_par', and 'anotherone'
 

From bc81cf8e23f2bd4bf9524cf3952981ed1042ccdc Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 14:16:19 -0700
Subject: [PATCH 6/7] add missing updated test

---
 tests/testthat/test_condense_control.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/tests/testthat/test_condense_control.R b/tests/testthat/test_condense_control.R
index 213369e67..4da0c2d57 100644
--- a/tests/testthat/test_condense_control.R
+++ b/tests/testthat/test_condense_control.R
@@ -14,6 +14,7 @@ test_that("condense_control works", {
     control_parsnip(catch = TRUE)
   )
 
+  ctrl$anotherone <- 2
   expect_snapshot(error = TRUE,
     condense_control(control_parsnip(), ctrl)
   )

From 02943c984fa810e79c20303c456d1bb028786639 Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Wed, 14 Sep 2022 14:55:06 -0700
Subject: [PATCH 7/7] add reminder to add arguments to other control functions

---
 R/control_parsnip.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/control_parsnip.R b/R/control_parsnip.R
index 98787f1e0..58ddd9960 100644
--- a/R/control_parsnip.R
+++ b/R/control_parsnip.R
@@ -20,6 +20,8 @@
 #'
 #' @export
 control_parsnip <- function(verbosity = 1L, catch = FALSE) {
+  # Any added arguments should also be added in superset control functions
+  # in other packages
   res <- list(verbosity = verbosity, catch = catch)
   res <- check_control(res)
   class(res) <- "control_parsnip"