diff --git a/DESCRIPTION b/DESCRIPTION index def576fa6..341742774 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.21.3.8 +Version: 0.21.3.9 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index 4231e793d..fdf73cf56 100644 --- a/NEWS.md +++ b/NEWS.md @@ -24,6 +24,9 @@ * `print(include_reference = TRUE)` for `model_parameters()` did not work when run inside a pipe-chain. +* Fixed issues with `format()` for objects returned by `compare_parameters()` + that included mixed models. + # parameters 0.21.3 ## Changes diff --git a/R/compare_parameters.R b/R/compare_parameters.R index 203d10915..70048b324 100644 --- a/R/compare_parameters.R +++ b/R/compare_parameters.R @@ -98,7 +98,7 @@ compare_parameters <- function(..., names(models) <- model_names } } else { - model_names <- match.call(expand.dots = FALSE)$`...` + model_names <- match.call(expand.dots = FALSE)[["..."]] if (length(names(model_names)) > 0) { model_names <- names(model_names) } else if (any(vapply(model_names, is.call, TRUE))) { @@ -275,14 +275,14 @@ compare_models <- compare_parameters } } else { match_pretty_names <- att$pretty_names[x$Parameter] - if (!anyNA(match_pretty_names)) { - x$Parameter <- att$pretty_names[x$Parameter] - } else { + if (anyNA(match_pretty_names)) { match_pretty_names <- match(names(att$pretty_names), x$Parameter) match_pretty_names <- match_pretty_names[!is.na(match_pretty_names)] if (length(match_pretty_names)) { x$Parameter[match_pretty_names] <- att$pretty_names[x$Parameter[match_pretty_names]] } + } else { + x$Parameter <- att$pretty_names[x$Parameter] } } } diff --git a/R/format.R b/R/format.R index 68bbab5d9..c160924c9 100644 --- a/R/format.R +++ b/R/format.R @@ -426,6 +426,13 @@ format.compare_parameters <- function(x, formatted_table <- split(out, f = split_by) formatted_table <- lapply(names(formatted_table), function(tab) { i <- formatted_table[[tab]] + # check if data frame is empty - this may happen if not all combinations + # of split_by factors are present in the data (e.g., zero-inflated mixed + # models, that have random effects for the count, but not for the zero- + # inflation component) + if (nrow(i) == 0L) { + return(NULL) + } # remove unique columns if (insight::n_unique(i$Component) == 1L) i$Component <- NULL if (insight::n_unique(i$Effects) == 1L) i$Effects <- NULL @@ -447,6 +454,9 @@ format.compare_parameters <- function(x, i }) + # remove empty tables + formatted_table <- insight::compact_list(formatted_table) + # for HTML, bind data frames if (identical(format, "html")) { # fix non-equal length of columns and bind data frames diff --git a/R/utils_format.R b/R/utils_format.R index 968e01e29..9b140cb04 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -328,9 +328,12 @@ } -.add_reference_level <- function(params) { - # check if we have a model object, else return parameter table - model <- .get_object(params) +.add_reference_level <- function(params, model = NULL) { + if (is.null(model)) { + # check if we have a model object, if not provided by user + model <- .get_object(params) + } + # no model object provided? Try to get data from model call if (is.null(model)) { # get data from model call model_data <- .safe(eval(attributes(params)$model_call$data)) diff --git a/tests/testthat/test-format_model_parameters.R b/tests/testthat/test-format_model_parameters.R index 1e7b1ebfc..6e007f864 100644 --- a/tests/testthat/test-format_model_parameters.R +++ b/tests/testthat/test-format_model_parameters.R @@ -173,3 +173,32 @@ withr::with_options( }) } ) + +skip_if_not_installed("lme4") +skip_if_not_installed("glmmTMB") + +test_that("format, compare_parameters, mixed models", { + data(mtcars) + data(Salamanders, package = "glmmTMB") + model1 <- lme4::lmer(mpg ~ wt + (1 | gear), data = mtcars) + model2 <- glmmTMB::glmmTMB( + count ~ spp + mined + (1 | site), + ziformula = ~mined, + family = poisson(), + data = Salamanders + ) + out <- compare_parameters(model1, model2, effects = "all", component = "all") + f <- format(out) + expect_length(f, 3) + f <- format(out, format = "html") + expect_identical( + f$Component, + c( + "Fixed Effects", "Fixed Effects", "Fixed Effects", "Fixed Effects", + "Fixed Effects", "Fixed Effects", "Fixed Effects", "Fixed Effects", + "Fixed Effects", "Fixed Effects (Zero-Inflation Component)", + "Fixed Effects (Zero-Inflation Component)", "Random Effects", + "Random Effects", "Random Effects" + ) + ) +})