From 2456d1baa0cffb39315e4ca06f71c8ace82250ee Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 5 Apr 2024 00:59:43 +0200 Subject: [PATCH 1/4] Fix for compare_parameters(effects = "random") --- R/plot.compare_parameters.R | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/R/plot.compare_parameters.R b/R/plot.compare_parameters.R index fdc9205e6..0e4ca892e 100644 --- a/R/plot.compare_parameters.R +++ b/R/plot.compare_parameters.R @@ -210,14 +210,19 @@ 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) rownames(dataplot) <- NULL From 0e4b7aa40670ac5187637aa01779fd7dbb71b6b3 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 5 Apr 2024 08:16:19 +0200 Subject: [PATCH 2/4] fix --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ R/plot.compare_parameters.R | 8 +++++++- 3 files changed, 12 insertions(+), 2 deletions(-) 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 0e4ca892e..56659ebb6 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.") + } } if (isTRUE(sort) || (!is.null(sort) && sort == "ascending")) { @@ -224,6 +228,8 @@ data_plot.see_compare_parameters <- function(x, ...) { } 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 From 0ded4a4bc102fe9439d14f1a67d718102122ec54 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 5 Apr 2024 08:26:10 +0200 Subject: [PATCH 3/4] add test --- R/plot.compare_parameters.R | 2 +- .../plot-compare-parameters-works.svg | 56 +++++++++++++++++++ tests/testthat/test-plot.compare_parameters.R | 24 ++++++++ 3 files changed, 81 insertions(+), 1 deletion(-) 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/R/plot.compare_parameters.R b/R/plot.compare_parameters.R index 56659ebb6..a9ac08616 100644 --- a/R/plot.compare_parameters.R +++ b/R/plot.compare_parameters.R @@ -80,7 +80,7 @@ plot.see_compare_parameters <- function(x, 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.") + insight::format_warning("No data left after removing intercepts. Returning empty plot. Try `show_intercept = TRUE`.") # nolint } } 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..9d14f48f8 --- /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(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) + ) +}) From b547b781188f22e20279a2abe3444a966c0180e0 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 5 Apr 2024 08:55:43 +0200 Subject: [PATCH 4/4] lintr, fix test --- R/plot.compare_parameters.R | 16 ++++++++-------- tests/testthat/test-plot.compare_parameters.R | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/plot.compare_parameters.R b/R/plot.compare_parameters.R index a9ac08616..684d7e1d0 100644 --- a/R/plot.compare_parameters.R +++ b/R/plot.compare_parameters.R @@ -127,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]) ) } @@ -192,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.")) diff --git a/tests/testthat/test-plot.compare_parameters.R b/tests/testthat/test-plot.compare_parameters.R index 9d14f48f8..586540b43 100644 --- a/tests/testthat/test-plot.compare_parameters.R +++ b/tests/testthat/test-plot.compare_parameters.R @@ -11,7 +11,7 @@ test_that("`plot()` for compare_parameters", { coef = "", stringsAsFactors = FALSE ) - gmod_glmmTMB <- glmmTMB(form, family = poisson, priors = gprior, data = gdat) + 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")