From 89174b6165b96ff461a0ff7aafcdeb0e6f15a4f5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 29 Sep 2024 14:50:28 +0200 Subject: [PATCH] fix GAM issues --- NEWS.md | 4 ++ R/plot.parameters_model.R | 13 ++++- .../plot-model-parameters-gam.svg | 57 +++++++++++++++++++ tests/testthat/test-plot.parameters_model.R | 17 +++++- 4 files changed, 88 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/_snaps/plot.parameters_model/plot-model-parameters-gam.svg diff --git a/NEWS.md b/NEWS.md index 63f12eda8..b67471409 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,10 @@ - `plot()` for `simulate_parameters()` now better copes with models that have multiple response levels (e.g. multinomial models). +## Bug fixes + +- Fixed issue in `plot()` for `parameters::model_parameters()` for GAM models. + # see 0.9.0 ## Changes diff --git a/R/plot.parameters_model.R b/R/plot.parameters_model.R index 3b4cf2b6a..4a9f0b0e6 100644 --- a/R/plot.parameters_model.R +++ b/R/plot.parameters_model.R @@ -53,6 +53,15 @@ plot.see_parameters_model <- function(x, # retrieve settings ---------------- model_attributes <- attributes(x)[!names(attributes(x)) %in% c("names", "row.names", "class")] + # for GAMs, remove smooth terms + if (!is.null(x$Component) && any(x$Component == "smooth_terms")) { + x <- x[x$Component != "smooth_terms", ] + # if we only have one component left, remove Component column + if (insight::n_unique(x$Component) == 1) { + x$Component <- NULL + } + } + # user wants to plot random effects (group levels)? if (isFALSE(model_attributes$ignore_group) && isTRUE(model_attributes$mixed_model) && @@ -366,7 +375,7 @@ plot.see_parameters_model <- function(x, x$CI <- as.character(x$CI) x$group <- factor(x$Coefficient < y_intercept, levels = c(FALSE, TRUE)) - if (all(x$group == "TRUE")) { + if (all(x$group == "TRUE", na.rm = TRUE)) { color_scale <- scale_color_material(reverse = TRUE) } else { color_scale <- scale_color_material() @@ -401,7 +410,7 @@ plot.see_parameters_model <- function(x, } else { # plot setup for regular model parameters x$group <- factor(x$Coefficient < y_intercept, levels = c(FALSE, TRUE)) - if (all(x$group == "TRUE")) { + if (all(x$group == "TRUE", na.rm = TRUE)) { color_scale <- scale_color_material(reverse = TRUE) } else { color_scale <- scale_color_material() diff --git a/tests/testthat/_snaps/plot.parameters_model/plot-model-parameters-gam.svg b/tests/testthat/_snaps/plot.parameters_model/plot-model-parameters-gam.svg new file mode 100644 index 000000000..9465c96d0 --- /dev/null +++ b/tests/testthat/_snaps/plot.parameters_model/plot-model-parameters-gam.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +disp +gear +cyl + +-2 +-1 +0 +1 +Coefficient +plot.model_parameters_gam + + diff --git a/tests/testthat/test-plot.parameters_model.R b/tests/testthat/test-plot.parameters_model.R index a8c2a8cdd..e3799f37e 100644 --- a/tests/testthat/test-plot.parameters_model.R +++ b/tests/testthat/test-plot.parameters_model.R @@ -69,7 +69,7 @@ test_that("`plot.see_parameters_model()` random parameters works", { data(sleepstudy, package = "lme4") set.seed(12345) - sleepstudy$grp <- sample(1:5, size = 180, replace = TRUE) + sleepstudy$grp <- sample.int(5, size = 180, replace = TRUE) model <- lme4::lmer( Reaction ~ Days + (1 | grp) + (1 | Subject), data = sleepstudy @@ -80,3 +80,18 @@ test_that("`plot.see_parameters_model()` random parameters works", { fig = plot(out) ) }) + + +test_that("`plot.see_parameters_model()` random parameters works", { + skip_if_not_installed("vdiffr") + skip_if_not_installed("mgcv") + skip_if_not_installed("parameters") + + data(mtcars) + m <- mgcv::gam(mpg ~ s(wt) + cyl + gear + disp, data = mtcars) + result <- parameters::model_parameters(m) + vdiffr::expect_doppelganger( + title = "plot.model_parameters_gam", + fig = plot(result) + ) +})