From 7af4340caa87077c50d4baa83ef35f6ff712f7d4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 5 Apr 2024 09:45:12 +0200 Subject: [PATCH] Fix for compare_parameters(effects = "random") (#338) * Fix for compare_parameters(effects = "random") * fix * add test * lintr, fix test --- DESCRIPTION | 2 +- NEWS.md | 4 ++ R/plot.compare_parameters.R | 43 ++++++++------ .../plot-compare-parameters-works.svg | 56 +++++++++++++++++++ tests/testthat/test-plot.compare_parameters.R | 24 ++++++++ 5 files changed, 112 insertions(+), 17 deletions(-) create mode 100644 tests/testthat/_snaps/plot.compare_parameters/plot-compare-parameters-works.svg create mode 100644 tests/testthat/test-plot.compare_parameters.R diff --git a/DESCRIPTION b/DESCRIPTION index 14684c70f..4ffccd9ea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: see Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2' -Version: 0.8.3.5 +Version: 0.8.3.6 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index 565575a7e..e6b1fa880 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,10 @@ * `plot()` for `check_predictions()` now supports Bayesian regression models from *brms* and *rstanarm*. +## Bug fixes + +* Corrected order of models for `plot.compare_parameters()`. + # see 0.8.3 ## Major changes diff --git a/R/plot.compare_parameters.R b/R/plot.compare_parameters.R index fdc9205e6..684d7e1d0 100644 --- a/R/plot.compare_parameters.R +++ b/R/plot.compare_parameters.R @@ -75,9 +75,13 @@ plot.see_compare_parameters <- function(x, x$Component <- factor(x$Component, levels = unique(x$Component)) } - + # show/hide intercepts if (!show_intercept) { x <- x[!.is_intercept(x$Parameter), ] + # sanity check - any data left? + if (nrow(x) == 0) { + insight::format_warning("No data left after removing intercepts. Returning empty plot. Try `show_intercept = TRUE`.") # nolint + } } if (isTRUE(sort) || (!is.null(sort) && sort == "ascending")) { @@ -123,19 +127,19 @@ plot.see_compare_parameters <- function(x, # largest data points that are within this range. Thereby we have the pretty # values we can use as breaks and labels for the scale... if (exponentiated_coefs) { - range <- 2^(-24:16) - x_low <- which.min(min(x$CI_low) > range) - 1L - x_high <- which.max(max(x$CI_high) < range) + exp_range <- 2^(-24:16) + x_low <- which.min(min(x$CI_low) > exp_range) - 1L + x_high <- which.max(max(x$CI_high) < exp_range) if (add_values) { # add some space to the right panel for text new_range <- pretty(2 * max(x$CI_high)) - x_high <- which.max(max(new_range) < range) + x_high <- which.max(max(new_range) < exp_range) } p <- p + scale_x_continuous( trans = "log", - breaks = range[x_low:x_high], - limits = c(range[x_low], range[x_high]), - labels = sprintf("%g", range[x_low:x_high]) + breaks = exp_range[x_low:x_high], + limits = c(exp_range[x_low], exp_range[x_high]), + labels = sprintf("%g", exp_range[x_low:x_high]) ) } @@ -188,7 +192,7 @@ plot.see_compare_parameters <- function(x, #' @export data_plot.see_compare_parameters <- function(x, ...) { - col_coefficient <- which(grepl("^(Coefficient|Log-Odds|Log-Mean|Odds Ratio|Risk Ratio|IRR)\\.", colnames(x))) + col_coefficient <- grep("^(Coefficient|Log-Odds|Log-Mean|Odds Ratio|Risk Ratio|IRR)\\.", colnames(x)) col_ci_low <- which(startsWith(colnames(x), "CI_low.")) col_ci_high <- which(startsWith(colnames(x), "CI_high.")) col_p <- which(startsWith(colnames(x), "p.")) @@ -210,15 +214,22 @@ data_plot.see_compare_parameters <- function(x, ...) { values_to = "CI_high", columns = colnames(x)[col_ci_high] )["CI_high"] + dataplot <- cbind(out1, out2, out3) + + # if we have effects = "random", we probably don't have p-values. so + # check if this column exists, and if not, we skip it... + if (length(col_p) != 0) { + out4 <- .reshape_to_long( + x, + values_to = "p", + columns = colnames(x)[col_p] + )["p"] + dataplot <- cbind(dataplot, out4) + } - out4 <- .reshape_to_long( - x, - values_to = "p", - columns = colnames(x)[col_p] - )["p"] - - dataplot <- cbind(out1, out2, out3, out4) dataplot$group <- gsub("(.*)\\.(.*)", "\\2", dataplot$group) + # make factor, so order in legend is preserved + dataplot$group <- factor(dataplot$group, levels = unique(dataplot$group)) rownames(dataplot) <- NULL diff --git a/tests/testthat/_snaps/plot.compare_parameters/plot-compare-parameters-works.svg b/tests/testthat/_snaps/plot.compare_parameters/plot-compare-parameters-works.svg new file mode 100644 index 000000000..65ff1e2dd --- /dev/null +++ b/tests/testthat/_snaps/plot.compare_parameters/plot-compare-parameters-works.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +SD (Intercept) + +0.00 +0.25 +0.50 +0.75 +1.00 +Estimate +Parameter + +Model + + + + +gmod_glmer +gmod_glmmTMB +plot.compare_parameters works + + diff --git a/tests/testthat/test-plot.compare_parameters.R b/tests/testthat/test-plot.compare_parameters.R new file mode 100644 index 000000000..586540b43 --- /dev/null +++ b/tests/testthat/test-plot.compare_parameters.R @@ -0,0 +1,24 @@ +test_that("`plot()` for compare_parameters", { + skip_if_not_installed("glmmTMB") + skip_if_not_installed("lme4") + skip_if_not_installed("parameters") + gdat <- readRDS(system.file("vignette_data", "gophertortoise.rds", package = "glmmTMB")) + form <- shells ~ prev + offset(log(Area)) + factor(year) + (1 | Site) + gmod_glmer <- lme4::glmer(form, family = poisson, data = gdat) + gprior <- data.frame( + prior = "gamma(1e8, 2.5)", + class = "theta", + coef = "", + stringsAsFactors = FALSE + ) + gmod_glmmTMB <- glmmTMB::glmmTMB(form, family = poisson, priors = gprior, data = gdat) + + cp <- parameters::compare_parameters(gmod_glmer, gmod_glmmTMB, effects = "random") + expect_warning(plot(cp), "No data left") + + skip_if_not_installed("vdiffr") + vdiffr::expect_doppelganger( + title = "plot.compare_parameters works", + fig = plot(cp, show_intercept = TRUE) + ) +})