diff --git a/NAMESPACE b/NAMESPACE index 4366caf0..05cc386a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,6 +73,7 @@ S3method(model_get_terms,glmmTMB) S3method(model_get_terms,model_fit) S3method(model_get_weights,default) S3method(model_get_weights,model_fit) +S3method(model_get_weights,svrepglm) S3method(model_get_weights,svyglm) S3method(model_get_xlevels,brmsfit) S3method(model_get_xlevels,default) diff --git a/NEWS.md b/NEWS.md index aa9d6ad2..d19e6bac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,8 @@ **Fix** - fix in `supported_models` +- bug fix when using `tidy_parameters()` for mixed models (#238) +- bug fix for `survey::svyglm()` models with replicate weights (#240) # broom.helpers 1.14.0 diff --git a/R/model_get_weights.R b/R/model_get_weights.R index 3c0e75d1..15df9a07 100644 --- a/R/model_get_weights.R +++ b/R/model_get_weights.R @@ -3,6 +3,10 @@ #' This function does not cover `lavaan` models (`NULL` is returned). #' #' @param model a model object +#' @note +#' For class `svrepglm` objects (glm on a survey object with replicate weights), +#' it will return the original sampling weights of the data, not the replicate +#' weights. #' @export #' @family model_helpers #' @examples @@ -69,6 +73,12 @@ model_get_weights.svyglm <- function(model) { stats::weights(model$survey.design) } +#' @export +#' @rdname model_get_weights +model_get_weights.svrepglm <- function(model) { + model$survey.design$pweights +} + #' @export #' @rdname model_get_weights model_get_weights.model_fit <- function(model) { diff --git a/R/tidy_disambiguate_terms.R b/R/tidy_disambiguate_terms.R index 6c0b66af..f5da92c3 100644 --- a/R/tidy_disambiguate_terms.R +++ b/R/tidy_disambiguate_terms.R @@ -52,12 +52,12 @@ tidy_disambiguate_terms <- function(x, sep = ".", model = tidy_get_model(x), qui if ("group" %in% names(x)) { x <- x %>% dplyr::mutate( + original_term = .data$term, term = dplyr::if_else( - is.na(.data$group), + is.na(.data$group) | .data$group == "", .data$term, paste(.data$group, .data$term, sep = sep) - ), - original_term = .data$term + ) ) } diff --git a/R/tidy_identify_variables.R b/R/tidy_identify_variables.R index 5f75d7e1..a8863c99 100644 --- a/R/tidy_identify_variables.R +++ b/R/tidy_identify_variables.R @@ -91,7 +91,7 @@ tidy_identify_variables <- function(x, model = tidy_get_model(x), x <- x %>% dplyr::mutate( var_type = dplyr::if_else( - .data$effect %in% c("ran_pars", "ran_vals"), + .data$effect %in% c("ran_pars", "ran_vals", "random"), .data$effect, .data$var_type ) diff --git a/man/model_get_weights.Rd b/man/model_get_weights.Rd index 7e4718d4..e7054891 100644 --- a/man/model_get_weights.Rd +++ b/man/model_get_weights.Rd @@ -4,6 +4,7 @@ \alias{model_get_weights} \alias{model_get_weights.default} \alias{model_get_weights.svyglm} +\alias{model_get_weights.svrepglm} \alias{model_get_weights.model_fit} \title{Get sampling weights used by a model} \usage{ @@ -13,6 +14,8 @@ model_get_weights(model) \method{model_get_weights}{svyglm}(model) +\method{model_get_weights}{svrepglm}(model) + \method{model_get_weights}{model_fit}(model) } \arguments{ @@ -21,6 +24,11 @@ model_get_weights(model) \description{ This function does not cover \code{lavaan} models (\code{NULL} is returned). } +\note{ +For class \code{svrepglm} objects (glm on a survey object with replicate weights), +it will return the original sampling weights of the data, not the replicate +weights. +} \examples{ mod <- lm(Sepal.Length ~ Sepal.Width, iris) mod \%>\% model_get_weights() diff --git a/tests/testthat/test-identify_variables.R b/tests/testthat/test-identify_variables.R index 2c1fcdb1..7e3c57b5 100644 --- a/tests/testthat/test-identify_variables.R +++ b/tests/testthat/test-identify_variables.R @@ -587,7 +587,7 @@ test_that("model_identify_variables() works with glmmTMB::glmmTMB", { mod <- suppressWarnings( glmmTMB::glmmTMB(count ~ mined + spp, - ziformula = ~ mined + site, + ziformula = ~ mined, family = poisson, data = glmmTMB::Salamanders ) @@ -597,15 +597,12 @@ test_that("model_identify_variables() works with glmmTMB::glmmTMB", { expect_equivalent( res$variable, c( - NA, "mined", "spp", "spp", "spp", "spp", "spp", "spp", "site", - "site", "site", "site", "site", "site", "site", "site", "site", - "site", "site", "site", "site", "site", "site", "site", "site", - "site", "site", "site", "site", "site" + NA, "mined", "spp", "spp", "spp", "spp", "spp", "spp" ) ) expect_error( mod %>% - tidy_and_attach(tidy_fun = broom.mixed::tidy) %>% + tidy_and_attach() %>% tidy_identify_variables(), NA ) diff --git a/tests/testthat/test-tidy_plus_plus.R b/tests/testthat/test-tidy_plus_plus.R index e73dcdd3..204160c9 100644 --- a/tests/testthat/test-tidy_plus_plus.R +++ b/tests/testthat/test-tidy_plus_plus.R @@ -178,6 +178,10 @@ test_that("tidy_plus_plus() works with lme4::lmer", { res <- mod %>% tidy_plus_plus(), NA ) + expect_error( + res <- mod %>% tidy_plus_plus(tidy_fun = tidy_parameters), + NA + ) }) @@ -311,6 +315,17 @@ test_that("tidy_plus_plus() works with survey::svyglm", { res <- mod %>% tidy_plus_plus(), NA ) + + df_rep <- survey::as.svrepdesign(df) + mod_rep <- survey::svyglm( + response ~ age + grade * trt, + df_rep, + family = quasibinomial + ) + expect_error( + res <- mod_rep %>% tidy_plus_plus(), + NA + ) }) test_that("tidy_plus_plus() works with survey::svycoxph", { @@ -910,7 +925,9 @@ test_that("tidy_post_fun argument of `tidy_plus_plus()`", { expect_true("titi" %in% names(res)) expect_true(res$titi[1] == "titi") - keep_2_rows <- function(res) {head(res, n = 2)} + keep_2_rows <- function(res) { + head(res, n = 2) + } expect_error( res <- tidy_plus_plus(mod, tidy_post_fun = keep_2_rows), NA diff --git a/vignettes/articles/marginal_tidiers.Rmd b/vignettes/articles/marginal_tidiers.Rmd index 81ca1e9c..7b4dea23 100644 --- a/vignettes/articles/marginal_tidiers.Rmd +++ b/vignettes/articles/marginal_tidiers.Rmd @@ -110,7 +110,7 @@ It is also possible to generate similar plots with `ggeffects::ggeffect()`. Plea ```{r} mod %>% ggeffects::ggeffect() %>% - plot() %>% + lapply(plot) %>% patchwork::wrap_plots() ```