Remove ability to pass offset through ... (#580)

Author: DavisVaughan

R/convert_data.R

@@ -19,8 +19,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`.
+#' @param ... Additional arguments passed to [stats::model.frame()].
 #' @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
@@ -55,13 +54,6 @@
     mf_call[[names(dots)[i]]] <- get_expr(dots[[i]])
   }
 
-  # For new data, save the expression to create offsets (if any)
-  if (any(names(dots) == "offset")) {
-    offset_expr <- get_expr(dots[["offset"]])
-  } else {
-    offset_expr <- NULL
-  }
-
   mod_frame <- eval_tidy(mf_call)
   mod_terms <- attr(mod_frame, "terms")
 
@@ -81,14 +73,9 @@
     rlang::abort("`weights` must be a numeric vector")
   }
 
-  offset <- as.vector(model.offset(mod_frame))
-  if (!is.null(offset)) {
-    if (length(offset) != nrow(mod_frame)) {
-      rlang::abort(
-        glue::glue("The offset data should have {nrow(mod_frame)} elements.")
-      )
-    }
-  }
+  # TODO: Do we actually use the offset when fitting?
+  # Extract any inline offsets specified in the formula from the model frame
+  offset <- model.offset(mod_frame)
 
   if (indicators != "none") {
     if (indicators == "one_hot") {
@@ -127,7 +114,6 @@
         offset = offset,
         terms = mod_terms,
         xlevels = .getXlevels(mod_terms, mod_frame),
-        offset_expr = offset_expr,
         options = options
       )
   } else {
@@ -144,7 +130,6 @@
         offset = offset,
         terms = mod_terms,
         xlevels = .getXlevels(mod_terms, mod_frame),
-        offset_expr = offset_expr,
         options = options
       )
   }
@@ -168,33 +153,6 @@
   mod_terms <- object$terms
   mod_terms <- delete.response(mod_terms)
 
-  # Calculate offset(s). These can show up in-line in the formula
-  # (in multiple places) and might also be as its own argument. If
-  # there is more than one offset, we add them together.
-
-  offset_cols <- attr(mod_terms, "offset")
-
-  # If offset was done at least once in-line
-  if (!is.null(offset_cols)) {
-    offset <- rep(0, nrow(new_data))
-    for (i in offset_cols) {
-      offset <- offset +
-        eval_tidy(
-          attr(mod_terms, "variables")[[i + 1]],
-          new_data
-        ) # use na.action here and below?
-    }
-  } else {
-    offset <- NULL
-  }
-
-  if (!is.null(object$offset_expr)) {
-    if (is.null(offset)) {
-      offset <- rep(0, nrow(new_data))
-    }
-    offset <- offset + eval_tidy(object$offset_expr, new_data)
-  }
-
   new_data <-
     model.frame(
       mod_terms,
@@ -208,6 +166,11 @@
     .checkMFClasses(cl, new_data)
   }
 
+  # TODO: Do we actually use the returned offsets anywhere for prediction?
+  # Extract offset from model frame. Multiple offsets will be added together.
+  # Offsets might have been supplied through the formula.
+  offset <- model.offset(new_data)
+
   if (object$options$indicators != "none") {
     if (object$options$indicators == "one_hot") {
       local_one_hot_contrasts()
@@ -322,7 +285,7 @@ local_one_hot_contrasts <- function(frame = rlang::caller_env()) {
 }
 
 check_form_dots <- function(x) {
-  good_args <- c("subset", "weights", "offset")
+  good_args <- c("subset", "weights")
   good_names <- names(x) %in% good_args
   if (any(!good_names)) {
     rlang::abort(

R/fit_helpers.R

@@ -138,14 +138,15 @@ form_xy <- function(object, control, env,
 
   res <- xy_xy(
     object = object,
-    env = env, #weights! offsets!
+    env = env, #weights!
     control = control,
     target = target
   )
   data_obj$y_var <- all.vars(env$formula[[2]])
   data_obj$x <- NULL
   data_obj$y <- NULL
   data_obj$weights <- NULL
+  # TODO: Should we be using the offset that we remove here?
   data_obj$offset <- NULL
   res$preproc <- data_obj
   res

tests/testthat/test_convert_data.R

@@ -86,35 +86,6 @@ test_that("numeric x and y, weights", {
   expect_null(observed$offset)
 })
 
-test_that("numeric x and y, offset", {
-  expected <- lm(
-    mpg ~ . - disp,
-    data = mtcars,
-    offset = disp,
-    x = TRUE,
-    y = TRUE
-  )
-  observed <-
-    .convert_form_to_xy_fit(
-      mpg ~ . - disp,
-      data = mtcars,
-      offset = log(disp),
-      indicators = "traditional",
-      remove_intercept = TRUE
-    )
-  expect_equal(format_x_for_test(expected$x), observed$x)
-  expect_equivalent(mtcars$mpg, observed$y)
-  expect_equal(expected$terms, observed$terms)
-  expect_equal(expected$xlevels, observed$xlevels)
-  expect_equal(log(mtcars$disp), observed$offset)
-  expect_null(observed$weights)
-
-  new_obs <-
-    .convert_form_to_xy_new(observed, new_data = mtcars[1:6, ])
-  expect_equal(mtcars[1:6, -c(1, 3)], new_obs$x)
-  expect_equal(log(mtcars$disp)[1:6], new_obs$offset)
-})
-
 test_that("numeric x and y, offset in-line", {
   expected <- lm(mpg ~ cyl + hp +  offset(log(disp)),
                  data = mtcars,
@@ -402,14 +373,6 @@ test_that("bad args", {
       remove_intercept = TRUE
     )
   )
-  expect_error(
-    .convert_form_to_xy_fit(
-      mpg ~ ., data = mtcars,
-      offset = 1:10,
-      indicators = "traditional",
-      remove_intercept = TRUE
-    )
-  )
 })
 
 test_that("numeric x and y, matrix composition", {