From 474028c5b757fa04f8d0de8431f0d9410c289adb Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 12 Jun 2025 17:09:55 +0200 Subject: [PATCH 1/4] Improve efficiency for brms/rstanarm --- DESCRIPTION | 2 +- R/methods_brms.R | 3 ++- R/methods_glmmTMB.R | 5 ++++- R/methods_rstanarm.R | 2 +- R/utils_model_parameters.R | 27 +++++++++++++++++++++++++-- 5 files changed, 33 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 18eb34fa0..5e291adce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.26.0.1 +Version: 0.26.0.2 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/R/methods_brms.R b/R/methods_brms.R index fbe2d91d9..6729f6021 100644 --- a/R/methods_brms.R +++ b/R/methods_brms.R @@ -161,11 +161,12 @@ model_parameters.brmsfit <- function(model, exponentiate, ci_method = ci_method, group_level = group_level, + modelinfo = modelinfo, verbose = verbose, ... ) - attr(params, "parameter_info") <- insight::clean_parameters(model) + attr(params, "parameter_info") <- .get_cleaned_parameters(params, model) attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model)) attr(params, "dpars") <- insight::find_auxiliary(model, verbose = FALSE) class(params) <- unique(c("parameters_model", "see_parameters_model", class(params))) diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index 03091c931..c0086211e 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -209,6 +209,8 @@ model_parameters.glmmTMB <- function(model, c("all", "conditional", "zi", "zero_inflated", "dispersion") ) + modelinfo <- insight::model_info(model, verbose = FALSE) + # group level estimates ================================================= # ======================================================================= @@ -238,7 +240,7 @@ model_parameters.glmmTMB <- function(model, # fix argument, if model has only conditional component cs <- stats::coef(summary(model)) - has_zeroinf <- insight::model_info(model, verbose = FALSE)$is_zero_inflated + has_zeroinf <- modelinfo$is_zero_inflated has_disp <- is.list(cs) && !is.null(cs$disp) if (!has_zeroinf && !has_disp && component != "conditional") { @@ -348,6 +350,7 @@ model_parameters.glmmTMB <- function(model, group_level = group_level, include_info = include_info, wb_component = wb_component, + modelinfo = modelinfo, ... ) diff --git a/R/methods_rstanarm.R b/R/methods_rstanarm.R index 3ff801d5d..0edadad2d 100644 --- a/R/methods_rstanarm.R +++ b/R/methods_rstanarm.R @@ -72,7 +72,7 @@ model_parameters.stanreg <- function(model, ... ) - attr(params, "parameter_info") <- insight::clean_parameters(model) + attr(params, "parameter_info") <- .get_cleaned_parameters(params, model) attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model)) class(params) <- c("parameters_model", "see_parameters_model", class(params)) diff --git a/R/utils_model_parameters.R b/R/utils_model_parameters.R index cf60e29a3..3c1151573 100644 --- a/R/utils_model_parameters.R +++ b/R/utils_model_parameters.R @@ -16,12 +16,17 @@ verbose = TRUE, group_level = FALSE, wb_component = FALSE, + modelinfo = NULL, ...) { # capture additional arguments dot.arguments <- list(...) # model info - info <- .safe(suppressWarnings(insight::model_info(model, verbose = FALSE))) + if (is.null(modelinfo)) { + info <- .safe(suppressWarnings(insight::model_info(model, verbose = FALSE))) + } else { + info <- modelinfo + } if (is.null(info)) { info <- list(family = "unknown", link_function = "unknown") @@ -359,6 +364,23 @@ } +#' this function extracts the table with cleaned parameter names, extracted +#' from `insight::clean_parameters()`. it first checks whether this object +#' is saved as attribute, and if not, calls `insight::clean_parameters()`. +#' +#' @keywords internal +#' @noRd +.get_cleaned_parameters <- function(params, model) { + # check if we have cleaned parameters as attributes + cp <- attributes(params)$clean_parameters + # if not, add + if (is.null(cp)) { + cp <- insight::clean_parameters(model) + } + cp +} + + #' this function extract "prettified" parameter names, using #' `insight::clean_parameters()`, and matches them with the parameter names. #' the result is a named vector, added as attributes to the output @@ -367,7 +389,8 @@ #' @noRd .add_pretty_names <- function(params, model) { attr(params, "model_class") <- class(model) - cp <- insight::clean_parameters(model) + # check if we have cleaned parameters as attributes + cp <- .get_cleaned_parameters(params, model) clean_params <- cp[cp$Parameter %in% params$Parameter, ] named_clean_params <- stats::setNames( From d9f6ca5f2dba3b8717aef765386060c6bfcd2fc8 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 12 Jun 2025 17:11:28 +0200 Subject: [PATCH 2/4] use dev versions --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 5e291adce..037d69b88 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -227,3 +227,4 @@ Config/testthat/parallel: true Config/Needs/website: easystats/easystatstemplate Config/Needs/check: stan-dev/cmdstanr Config/rcmdcheck/ignore-inconsequential-notes: true +Remotes: easystats/insight, easystats/bayestestR From 09200c90bfd08a70c8937ef56951fd46dba89b6b Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 13 Jun 2025 09:09:26 +0200 Subject: [PATCH 3/4] skip failing test --- tests/testthat/test-model_parameters.mediate.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/testthat/test-model_parameters.mediate.R b/tests/testthat/test-model_parameters.mediate.R index ef0e8e6a8..1d100fd45 100644 --- a/tests/testthat/test-model_parameters.mediate.R +++ b/tests/testthat/test-model_parameters.mediate.R @@ -30,6 +30,11 @@ test_that("model_parameters.mediate-2", { test_that("model_parameters.mediate-3", { skip_on_cran() + + ## FIXME: bug in the latest CRAN version of the mediation package + # maintainer contacted on 13. June 2025 + skip_if(TRUE) + jobs$job_disc <- as.factor(jobs$job_disc) b.ord <- MASS::polr( job_disc ~ treat + econ_hard + sex + age, From 1a9a01e49ef6d04b912a49e770a9b31b5c19e4e7 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 13 Jun 2025 10:53:25 +0200 Subject: [PATCH 4/4] test --- tests/testthat/test-pool_parameters.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-pool_parameters.R b/tests/testthat/test-pool_parameters.R index 1818c588e..2b8fe489e 100644 --- a/tests/testthat/test-pool_parameters.R +++ b/tests/testthat/test-pool_parameters.R @@ -143,7 +143,7 @@ test_that("pooled parameters, glmmTMB, zero-inflated", { ziformula = ~mined, family = poisson() ))) - mice_summ <- summary(mice::pool(m_mice, dfcom = Inf)) + mice_summ <- suppressWarnings(summary(mice::pool(m_mice, dfcom = Inf))) expect_equal(out$Coefficient, mice_summ$estimate, tolerance = 1e-3) expect_equal(out$SE, mice_summ$std.error, tolerance = 1e-3) expect_equal(out$p, mice_summ$p.value, tolerance = 1e-3)