From fe0744c5a42f625c6ebaf68e9585a1c4b6a83682 Mon Sep 17 00:00:00 2001 From: Joseph Larmarange Date: Mon, 1 Jul 2024 16:38:27 +0200 Subject: [PATCH] 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 fix #254 --- NEWS.md | 6 ++++++ R/model_get_model_frame.R | 2 ++ R/model_get_model_matrix.R | 2 ++ R/tidy_and_attach.R | 12 +++++++++++- R/tidy_plus_plus.R | 5 +++++ man/tidy_attach_model.Rd | 5 +++++ man/tidy_plus_plus.Rd | 5 +++++ 7 files changed, 36 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index bc80bdef..92604da6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # 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) + # broom.helpers 1.15.0 **New supported models** diff --git a/R/model_get_model_frame.R b/R/model_get_model_frame.R index f16e9f3c..f0f3043f 100644 --- a/R/model_get_model_frame.R +++ b/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") } diff --git a/R/model_get_model_matrix.R b/R/model_get_model_matrix.R index 1004c6b2..1c446c12 100644 --- a/R/model_get_model_matrix.R +++ b/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") } diff --git a/R/tidy_and_attach.R b/R/tidy_and_attach.R index 1482b0aa..e6544691 100644 --- a/R/tidy_and_attach.R +++ b/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 diff --git a/R/tidy_plus_plus.R b/R/tidy_plus_plus.R index 643870e5..6e2d0a00 100644 --- a/R/tidy_plus_plus.R +++ b/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, ... ) diff --git a/man/tidy_attach_model.Rd b/man/tidy_attach_model.Rd index 7a18cf22..a293dd36 100644 --- a/man/tidy_attach_model.Rd +++ b/man/tidy_attach_model.Rd @@ -15,6 +15,7 @@ tidy_and_attach( conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, + model_matrix_attr = TRUE, ... ) @@ -40,6 +41,10 @@ interval in the tidied output} 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 \code{FALSE}} +\item{model_matrix_attr}{logical indicating whether model frame and model +matrix should be added as attributes of \code{model} (respectively named +\code{"model_frame"} and \code{"model_matrix"}) and passed through} + \item{...}{other arguments passed to \code{tidy_fun()}} } \description{ diff --git a/man/tidy_plus_plus.Rd b/man/tidy_plus_plus.Rd index 06659034..1ffe72b8 100644 --- a/man/tidy_plus_plus.Rd +++ b/man/tidy_plus_plus.Rd @@ -10,6 +10,7 @@ tidy_plus_plus( conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, + model_matrix_attr = TRUE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", @@ -50,6 +51,10 @@ tidy_plus_plus( 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 \code{FALSE}.} +\item{model_matrix_attr}{logical indicating whether model frame and model +matrix should be added as attributes of \code{model} (respectively named +\code{"model_frame"} and \code{"model_matrix"}) and passed through} + \item{variable_labels}{a named list or a named vector of custom variable labels} \item{term_labels}{a named list or a named vector of custom term labels}