Skip to content

Commit

Permalink
Merge pull request #255 from larmarange/execution_time
Browse files Browse the repository at this point in the history
new argument `model_matrix_attr`
  • Loading branch information
larmarange authored Jul 1, 2024
2 parents 9142435 + ca28f72 commit b8bd70b
Show file tree
Hide file tree
Showing 13 changed files with 43 additions and 27 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@ Imports:
Suggests:
betareg,
biglm,
biglmm,
brms (>= 2.13.0),
broom.mixed,
cmprsk,
Expand Down
11 changes: 11 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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**
Expand Down
2 changes: 2 additions & 0 deletions R/model_get_model_frame.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
}

Expand Down
2 changes: 2 additions & 0 deletions R/model_get_model_matrix.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
}

Expand Down
12 changes: 11 additions & 1 deletion R/tidy_and_attach.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) {
Expand All @@ -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
Expand Down
5 changes: 5 additions & 0 deletions R/tidy_plus_plus.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 = " * ",
Expand Down Expand Up @@ -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,
...
)

Expand Down
1 change: 0 additions & 1 deletion data-raw/DATASET.R
Original file line number Diff line number Diff line change
Expand Up @@ -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.",
Expand Down
Binary file modified data/supported_models.rda
Binary file not shown.
1 change: 0 additions & 1 deletion man/supported_models.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 5 additions & 0 deletions man/tidy_attach_model.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 5 additions & 0 deletions man/tidy_plus_plus.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 2 additions & 1 deletion tests/testthat/test-attach_and_detach.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ test_that("Attach and Detach models works", {
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)
Expand Down Expand Up @@ -33,3 +33,4 @@ test_that("tidy_and_attach() handles models without exponentiate arguments", {
expect_error(mod %>% tidy_and_attach(exponentiate = TRUE))
expect_error(mod %>% tidy_and_attach(), NA)
})

Check warning on line 36 in tests/testthat/test-attach_and_detach.R

View workflow job for this annotation

GitHub Actions / lint

file=tests/testthat/test-attach_and_detach.R,line=36,col=1,[trailing_blank_lines_linter] Trailing blank lines are superfluous.
22 changes: 0 additions & 22 deletions tests/testthat/test-tidy_plus_plus.R
Original file line number Diff line number Diff line change
Expand Up @@ -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()
Expand Down

0 comments on commit b8bd70b

Please sign in to comment.