Remove all mentions of contrasts as an argument

R/convert_data.R

@@ -20,7 +20,7 @@
 #' @param data A data frame containing all relevant variables (e.g. outcome(s),
 #'   predictors, case weights, etc).
 #' @param ... Additional arguments passed to [stats::model.frame()] and
-#'   specification of `offset` and `contrasts`.
+#'   specification of `offset`.
 #' @param na.action A function which indicates what should happen when the data
 #'   contain NAs.
 #' @param indicators A string describing whether and how to create
@@ -57,13 +57,6 @@
     mf_call[[names(dots)[i]]] <- get_expr(dots[[i]])
   }
 
-  # setup contrasts
-  if (any(names(dots) == "contrasts")) {
-    contrasts <- eval_tidy(dots[["contrasts"]])
-  } else {
-    contrasts <- NULL
-  }
-
   # For new data, save the expression to create offsets (if any)
   if (any(names(dots) == "offset")) {
     offset_expr <- get_expr(dots[["offset"]])
@@ -101,13 +94,10 @@
 
   if (indicators != "none") {
     if (indicators == "one_hot") {
-      old_contr <- options("contrasts")$contrasts
-      on.exit(options(contrasts = old_contr))
-      new_contr <- old_contr
-      new_contr["unordered"] <- "contr_one_hot"
-      options(contrasts = new_contr)
+      local_one_hot_contrasts()
     }
-    x <- model.matrix(mod_terms, mod_frame, contrasts)
+
+    x <- model.matrix(mod_terms, mod_frame)
   } else {
     # this still ignores -vars in formula
     x <- model.frame(mod_terms, data)
@@ -124,7 +114,6 @@
     list(
       indicators = indicators,
       composition = composition,
-      contrasts = contrasts,
       remove_intercept = remove_intercept
     )
 
@@ -223,14 +212,10 @@
 
   if (object$options$indicators != "none") {
     if (object$options$indicators == "one_hot") {
-      old_contr <- options("contrasts")$contrasts
-      on.exit(options(contrasts = old_contr))
-      new_contr <- old_contr
-      new_contr["unordered"] <- "contr_one_hot"
-      options(contrasts = new_contr)
+      local_one_hot_contrasts()
     }
-    new_data <-
-      model.matrix(mod_terms, new_data, contrasts.arg = object$contrasts)
+
+    new_data <- model.matrix(mod_terms, new_data)
   }
 
   if (object$options$remove_intercept) {
@@ -332,8 +317,15 @@
 
 # ------------------------------------------------------------------------------
 
+local_one_hot_contrasts <- function(frame = rlang::caller_env()) {
+  contrasts <- getOption("contrasts")
+  contrasts["unordered"] <- "contr_one_hot"
+
+  rlang::local_options(contrasts = contrasts, .frame = frame)
+}
+
 check_form_dots <- function(x) {
-  good_args <- c("subset", "weights", "contrasts", "offset")
+  good_args <- c("subset", "weights", "offset")
   good_names <- names(x) %in% good_args
   if (any(!good_names)) {
     rlang::abort(

R/fit.R

@@ -43,6 +43,13 @@
 #' If the model engine has not been set, the model's default engine will be used
 #'  (as discussed on each model page). If the `verbosity` option of
 #'  [control_parsnip()] is greater than zero, a warning will be produced.
+#'
+#' If you would like to use an alternative method for generating contrasts when
+#' supplying a formula to `fit()`, set the global option `contrasts` to your
+#' preferred method. For example, you might set it to:
+#' `options(contrasts = c(unordered = "contr.helmert", ordered = "contr.poly"))`.
+#' See the help page for [stats::contr.treatment()] for more possible contrast
+#' types.
 #' @examples
 #' # Although `glm()` only has a formula interface, different
 #' # methods for specifying the model can be used

tests/testthat/test_convert_data.R

@@ -456,6 +456,30 @@ test_that("numeric x and multivariate y, matrix composition", {
   expect_equal(as.matrix(mtcars[1:6,-(1:2)]), new_obs$x)
 })
 
+test_that("global `contrasts` option is respected", {
+  contrasts <- getOption("contrasts")
+  contrasts["unordered"] <- "contr.helmert"
+
+  rlang::local_options(contrasts = contrasts)
+
+  # Fit time
+  fit_result <- .convert_form_to_xy_fit(
+    num_pending ~ class + compounds,
+    data = hpc
+  )
+  fit_data <- fit_result$x
+
+  expect_identical(names(fit_data), c("class1", "class2", "class3", "compounds"))
+  expect_true(all(fit_data$class1 %in% c(-1, 0, 1)))
+
+  # Predict time
+  predict_result <- .convert_form_to_xy_new(fit_result, hpc)
+  predict_data <- predict_result$x
+
+  expect_identical(names(predict_data), c("class1", "class2", "class3", "compounds"))
+  expect_true(all(predict_data$class1 %in% c(-1, 0, 1)))
+})
+
 # ------------------------------------------------------------------------------
 
 context("Testing xy -> formula conversion")