new argument model_matrix_attr

DESCRIPTION

@@ -31,7 +31,6 @@ Imports:
 Suggests: 
     betareg,
     biglm,
-    biglmm,
     brms (>= 2.13.0),
     broom.mixed,
     cmprsk,

NEWS.md

@@ -1,5 +1,16 @@
 # broom.helpers (development version)
 
+**New features**
+
+- new argument `model_matrix_attr` in `tidy_and_attach()` and `tidy_plus_plus()`
+  to attach model frame and model matrix to the model as attributes for saving
+  some execution time (#254)
+
+**Deprecated support**
+
+- `biglmm::bigglm()` not supported anymore as `bigglmm` has been removed from
+  CRAN
+
 # broom.helpers 1.15.0
 
 **New supported models**

R/model_get_model_frame.R

@@ -15,6 +15,8 @@
 #'   model_get_model_frame() %>%
 #'   head()
 model_get_model_frame <- function(model) {
+  if (!is.null(attr(model, "model_frame")))
+    return(attr(model, "model_frame"))
   UseMethod("model_get_model_frame")
 }
 

R/model_get_model_matrix.R

@@ -15,6 +15,8 @@
 #'   model_get_model_matrix() %>%
 #'   head()
 model_get_model_matrix <- function(model, ...) {
+  if (!is.null(attr(model, "model_matrix")))
+    return(attr(model, "model_matrix"))
   UseMethod("model_get_model_matrix")
 }
 

R/tidy_and_attach.R

@@ -18,6 +18,9 @@
 #' @param exponentiate logical indicating whether or not to exponentiate the
 #' coefficient estimates. This is typical for logistic, Poisson and Cox models,
 #' but a bad idea if there is no log or logit link; defaults to `FALSE`
+#' @param model_matrix_attr logical indicating whether model frame and model
+#' matrix should be added as attributes of `model` (respectively named
+#' `"model_frame"` and `"model_matrix"`) and passed through
 #' @param .attributes named list of additional attributes to be attached to `x`
 #' @param ... other arguments passed to `tidy_fun()`
 #' @family tidy_helpers
@@ -55,7 +58,8 @@ tidy_attach_model <- function(x, model, .attributes = NULL) {
 #' @export
 tidy_and_attach <- function(
     model, tidy_fun = tidy_with_broom_or_parameters,
-    conf.int = TRUE, conf.level = .95, exponentiate = FALSE, ...) {
+    conf.int = TRUE, conf.level = .95, exponentiate = FALSE,
+    model_matrix_attr = TRUE, ...) {
   # exponentiate cannot be used with lm models
   # but broom will not produce an error and will return unexponentiated estimates
   if (identical(class(model), "lm") && exponentiate) {
@@ -64,6 +68,12 @@ tidy_and_attach <- function(
 
   tidy_args <- list(...)
   tidy_args$x <- model
+
+  if (model_matrix_attr) {
+    attr(model, "model_frame") <- model %>% model_get_model_frame()
+    attr(model, "model_matrix") <- model %>% model_get_model_matrix()
+  }
+
   tidy_args$conf.int <- conf.int
   if (conf.int) tidy_args$conf.level <- conf.level
   tidy_args$exponentiate <- exponentiate

R/tidy_plus_plus.R

@@ -24,6 +24,9 @@
 #' @param exponentiate logical indicating whether or not to exponentiate the
 #' coefficient estimates. This is typical for logistic, Poisson and Cox models,
 #' but a bad idea if there is no log or logit link; defaults to `FALSE`.
+#' @param model_matrix_attr logical indicating whether model frame and model
+#' matrix should be added as attributes of `model` (respectively named
+#' `"model_frame"` and `"model_matrix"`) and passed through
 #' @param variable_labels a named list or a named vector of custom variable labels
 #' @param term_labels a named list or a named vector of custom term labels
 #' @param interaction_sep separator for interaction terms
@@ -126,6 +129,7 @@ tidy_plus_plus <- function(model,
                            conf.int = TRUE,
                            conf.level = .95,
                            exponentiate = FALSE,
+                           model_matrix_attr = TRUE,
                            variable_labels = NULL,
                            term_labels = NULL,
                            interaction_sep = " * ",
@@ -157,6 +161,7 @@ tidy_plus_plus <- function(model,
       conf.int = conf.int,
       conf.level = conf.level,
       exponentiate = exponentiate,
+      model_matrix_attr = model_matrix_attr,
       ...
     )
 

data-raw/DATASET.R

@@ -41,7 +41,6 @@ supported_models <-
     "`tidycmprsk::crr()`", "",
     "`plm::plm()`", "",
     "`biglm::bigglm()`", "",
-    "`biglmm::bigglm()`", "",
     "`parsnip::model_fit`", "Supported as long as the type of model and the engine is supported.",
     "`fixest::feglm()`", "May fail with R <= 4.0.",
     "`fixest::femlm()`", "May fail with R <= 4.0.",

tests/testthat/test-attach_and_detach.R

@@ -2,7 +2,7 @@
   mod <- lm(Sepal.Length ~ Sepal.Width + Species, data = iris)
   expect_identical(
     mod,
-    mod %>% tidy_and_attach() %>% tidy_get_model()
+    mod %>% tidy_and_attach(model_matrix_attr = FALSE) %>% tidy_get_model()
   )
 
   tb <- broom::tidy(mod)
@@ -33,3 +33,4 @@
   expect_error(mod %>% tidy_and_attach(exponentiate = TRUE))
   expect_error(mod %>% tidy_and_attach(), NA)
 })
+

tests/testthat/test-tidy_plus_plus.R

@@ -650,28 +650,6 @@ test_that("tidy_plus_plus() works with biglm::bigglm", {
   )
 })
 
-test_that("tidy_plus_plus() works with biglmm::bigglm", {
-  skip_on_cran()
-  skip_if_not_installed("biglmm")
-  skip_if(compareVersion(as.character(getRversion()), "3.6") < 0)
-
-  mod <- biglmm::bigglm(
-    response ~ age + trt,
-    data = as.data.frame(gtsummary::trial),
-    family = binomial()
-  )
-
-  expect_error(
-    res <- mod %>% tidy_plus_plus(),
-    NA
-  )
-
-  # check that reference rows are properly added
-  expect_equal(
-    res %>% dplyr::filter(variable == "trt") %>% purrr::pluck("reference_row"),
-    c(TRUE, FALSE)
-  )
-})
 
 test_that("tidy_plus_plus() works with parsnip::model_fit object", {
   skip_on_cran()