plot.parameters_simulate formatting VS parameters_model formatting (#367

)

* plot.parameters_simulate formatting VS  parameters_model formatting
Fixes #278

* add test

* news

* fix test

* fix GAM issues

* add show_direction arg

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.9.0.3
+Version: 0.9.0.4
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -93,6 +93,7 @@ Suggests:
     lme4,
     logspline,
     MASS,
+    mclogit,
     mclust,
     merDeriv,
     mgcv,

NEWS.md

@@ -8,6 +8,16 @@
 - `plot()` for `model_parameters()` now also plots group-levels of random effects
   (i.e. for mixed models, when `model_parameters(x, ..., group_level = TRUE)`).
 
+- `plot()` for `model_parameters()` gets a `show_direction` argument, to turn
+  off the direction of the effect in the plot.
+
+- `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

R/plot.parameters_model.R

@@ -21,6 +21,9 @@
 #' @param show_density Should the compatibility density (i.e., posterior,
 #'   bootstrap, or confidence density) of each parameter be shown?
 #'   (default: `FALSE`)
+#' @param show_direction Should the "direction" of coefficients (e.g., positive
+#' or negative coefficients) be highlighted using different colors?
+#' (default: `TRUE`)
 #' @param log_scale Should exponentiated coefficients (e.g., odds-ratios) be
 #'   plotted on a log scale? (default: `FALSE`)
 #' @param n_columns For models with multiple components (like fixed and random,
@@ -29,6 +32,14 @@
 #'
 #' @return A ggplot2-object.
 #'
+#' @note By default, coefficients and their confidence intervals are colored
+#' depending on whether they show a "positive" or "negative" association with
+#' the outcome. E.g., in case of linear models, colors simply distinguish positive
+#' or negative coefficients. For logistic regression models that are shown on the
+#' odds ratio scale, colors distinguish odds ratios above or below 1. Use
+#' `show_direction = FALSE` to disable this feature and only show a one-colored
+#' forest plot.
+#'
 #' @examples
 #' library(parameters)
 #' m <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars)
@@ -48,11 +59,21 @@ plot.see_parameters_model <- function(x,
                                       show_estimate = TRUE,
                                       show_interval = TRUE,
                                       show_density = FALSE,
+                                      show_direction = TRUE,
                                       log_scale = FALSE,
                                       ...) {
   # 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,16 +387,26 @@ 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()
     }
 
-    p <- ggplot2::ggplot(x, ggplot2::aes(
-      y = .data$Parameter, x = .data$Coefficient,
-      size = rev(.data$CI), color = .data$group
-    )) +
+    # should positive/negative coefficients be highlighted?
+    if (show_direction) {
+      p <- ggplot2::ggplot(x, ggplot2::aes(
+        y = .data$Parameter, x = .data$Coefficient,
+        size = rev(.data$CI), color = .data$group
+      ))
+    } else {
+      p <- ggplot2::ggplot(x, ggplot2::aes(
+        y = .data$Parameter, x = .data$Coefficient,
+        size = rev(.data$CI)
+      ))
+    }
+
+    p <- p +
       ggplot2::geom_vline(ggplot2::aes(xintercept = y_intercept), linetype = "dotted") +
       theme_modern(legend.position = "none") +
       color_scale
@@ -401,16 +432,23 @@ 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()
     }
 
+    if (show_direction) {
     p <- ggplot2::ggplot(x, ggplot2::aes(y = .data$Parameter, x = .data$Coefficient, color = .data$group)) +
       ggplot2::geom_vline(ggplot2::aes(xintercept = y_intercept), linetype = "dotted") +
       theme_modern(legend.position = "none") +
       color_scale
+    } else {
+    p <- ggplot2::ggplot(x, ggplot2::aes(y = .data$Parameter, x = .data$Coefficient)) +
+      ggplot2::geom_vline(ggplot2::aes(xintercept = y_intercept), linetype = "dotted") +
+      theme_modern(legend.position = "none") +
+      color_scale
+    }
 
     if (show_density) {
       p <- p + density_layer

R/plot.parameters_simulate.R

@@ -50,6 +50,9 @@ data_plot.parameters_simulate <- function(x,
       out$Component[grepl(paste0(i, "$"), out$Parameter)] <- i
       out$Parameter <- gsub(paste0(i, "$"), "", out$Parameter)
     }
+  } else if ("Response" %in% colnames(x)) {
+    out$Component <- rep(x$Response, each = nrow(out) / nrow(x))
+    out$Parameter <- rep(x$Parameter, each = nrow(out) / nrow(x))
   }
 
   out
@@ -93,7 +96,9 @@ plot.see_parameters_simulate <- function(x,
                                          ci = 0.95,
                                          ...) {
   is_mlm <- !is.null(attributes(x)$object_class) && "mlm" %in% attributes(x)$object_class
-  if (is.null(n_columns) && isTRUE(is_mlm)) n_columns <- 1
+  if (is.null(n_columns) && (isTRUE(is_mlm) || "Response" %in% colnames(x))) {
+    n_columns <- 1
+  }
 
   # check for defaults
   if (missing(centrality) && !is.null(attributes(x)$centrality)) {

tests/testthat/test-plot.parameters_model.R

@@ -8,6 +8,10 @@ test_that("`plot.see_parameters_model()` works", {
     title = "plot.model_parameters_1",
     fig = plot(result)
   )
+  vdiffr::expect_doppelganger(
+    title = "plot.model_parameters_no_dir",
+    fig = plot(result, show_direction = FALSE)
+  )
 })
 
 test_that("`plot.see_parameters_model()` random parameters works", {
@@ -69,7 +73,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 +84,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)
+  )
+})

tests/testthat/test-plot.simulate_parameters.R

@@ -0,0 +1,42 @@
+skip_if(TRUE)
+
+## FIXME: currently does not retrieve the data
+
+skip_on_cran()
+skip_if_offline()
+skip_if_not_installed("mclogit")
+skip_if_not_installed("parameters")
+skip_if_not_installed("vdiffr")
+
+test_that("`plot()` for simulate_parameters", {
+  pict <- base::readRDS(url("https://slcladal.github.io/data/pict.rda", "rb"))
+  suppressWarnings({
+    m1.mn <- mclogit::mblogit(
+      formula = Response ~ Gender + Group,
+      random = ~ 1 | Item,
+      data = pict
+    )
+  })
+  set.seed(1234)
+  ms <- parameters::simulate_parameters(m1.mn)
+  set.seed(1234)
+  vdiffr::expect_doppelganger(
+    title = "plot.simulate_parameters works",
+    fig = plot(ms)
+  )
+  set.seed(1234)
+  vdiffr::expect_doppelganger(
+    title = "plot.simulate_parameters works-2",
+    fig = plot(ms, stack = FALSE)
+  )
+  set.seed(1234)
+  vdiffr::expect_doppelganger(
+    title = "plot.simulate_parameters works-3",
+    fig = plot(ms, stack = FALSE, show_intercept = TRUE, normalize_height = TRUE)
+  )
+  set.seed(1234)
+  vdiffr::expect_doppelganger(
+    title = "plot.simulate_parameters works-4",
+    fig = plot(ms, stack = TRUE, show_intercept = TRUE, normalize_height = TRUE)
+  )
+})