Merge pull request #239 from larmarange/mixed_models

Bug fixes and improving results for mixed models

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)

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
 

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) {

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
+        )
       )
   }
 

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
           )

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
   )

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

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()
 ```