Merge branch 'main' into palette_tol

easystats · Oct 15, 2024 · 6e03047 · 6e03047
2 parents d7c7bb1 + f1c24a5
commit 6e03047
Show file tree

Hide file tree

Showing 73 changed files with 3,359 additions and 245 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,28 +1,28 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.5.6
+Version: 0.9.0.6
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
              role = c("aut", "ctb"),
              email = "[email protected]",
-             comment = c(ORCID = "0000-0002-8895-3206", Twitter = "@strengejacke")),
+             comment = c(ORCID = "0000-0002-8895-3206")),
       person(given = "Dominique",
              family = "Makowski",
              role = c("aut", "inv"),
              email = "[email protected]",
-             comment = c(ORCID = "0000-0001-5375-9967", Twitter = "@Dom_Makowski")),
+             comment = c(ORCID = "0000-0001-5375-9967")),
       person(given = "Indrajeet",
              family = "Patil",
              role = c("aut", "cre"),
              email = "[email protected]",
-             comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")),
+             comment = c(ORCID = "0000-0003-1995-6531")),
       person(given = "Mattan S.",
              family = "Ben-Shachar",
              role = c("aut", "ctb"),
              email = "[email protected]",
-             comment = c(ORCID = "0000-0002-4287-4801", Twitter = "@mattansb")),
+             comment = c(ORCID = "0000-0002-4287-4801")),
       person(given = "Brenton M.",
              family = "Wiernik",
              role = c("aut", "ctb"),
@@ -46,8 +46,7 @@ Authors@R:
       person(given = "Jakob",
              family = "Bossek",
              role = "rev",
-             email = "[email protected]",
-             comment = c(Twitter = "@BossekJakob")))
+             email = "[email protected]"))
 Maintainer: Indrajeet Patil <[email protected]>
 Description: Provides plotting utilities supporting packages in the 'easystats'
     ecosystem (<https://github.com/easystats/easystats>) and some extra themes,
@@ -65,14 +64,15 @@ Depends:
 Imports:
     bayestestR (>= 0.14.0),
     correlation (>= 0.8.5),
-    datawizard (>= 0.12.2),
+    datawizard (>= 0.13.0),
     effectsize (>= 0.8.9),
-    ggplot2 (>= 3.5.1),
-    insight (>= 0.20.2),
+    ggplot2,
+    insight (>= 0.20.5),
     modelbased (>= 0.8.8),
-    parameters (>= 0.22.1),
-    performance (>= 0.12.2)
+    parameters (>= 0.22.2),
+    performance (>= 0.12.3)
 Suggests:
+    BH,
     brms,
     curl,
     DHARMa,
@@ -92,6 +92,7 @@ Suggests:
     lme4,
     logspline,
     MASS,
+    mclogit,
     mclust,
     merDeriv,
     mgcv,
@@ -120,4 +121,4 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/performance
+Remotes: easystats/performance, easystats/parameters
diff --git a/NEWS.md b/NEWS.md
@@ -2,8 +2,36 @@
 
 ## Changes
 
+- `plot()` for `p_function()` now checks the values of the `size_length`
+  argument, to give an informative error message when the input is not valid.
+
+- `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
+
 - New `plot()` method for `performance::check_dag()`.
 
+- Minor improvements to `plot()` for methods `p_direction()` and `p_significance()`,
+  which also support forthcoming changes in the *parameters* package.
+
+## Bug fixes
+
+- Fixed issue in `plot()` for `performance::check_model()` when package *qqplotr*
+  is not installed.
+
 # see 0.8.5
 
 ## Major Changes

diff --git a/R/plot.check_predictions.R b/R/plot.check_predictions.R
@@ -340,7 +340,7 @@ plot.see_performance_pp_check <- function(x,
   x$key[nrow(x)] <- "Observed data"
   x <- datawizard::data_to_long(x, select = -1:-2, names_to = "x", values_to = "count")
   if (insight::n_unique(x$x) > 8) {
-    x$x <- datawizard::to_numeric(x$x)
+    x$x <- datawizard::to_numeric(x$x, dummy_factors = TRUE)
   }
 
   p1 <- p2 <- NULL
@@ -536,7 +536,7 @@ plot.see_performance_pp_check <- function(x,
       size = ggplot2::guide_legend(reverse = TRUE)
     )
 
-  return(p)
+  p
 }
 
 

diff --git a/R/plot.equivalence_test.R b/R/plot.equivalence_test.R
@@ -110,7 +110,7 @@ plot.see_equivalence_test <- function(x,
   }
 
   # get labels
-  labels <- .clean_parameter_names(tmp$predictor, grid = !is.null(n_columns))
+  axis_labels <- .clean_parameter_names(tmp$predictor, grid = !is.null(n_columns))
 
   tmp <- .fix_facet_names(tmp)
 
@@ -126,11 +126,11 @@ plot.see_equivalence_test <- function(x,
 
   fill.color <- fill.color[sort(unique(match(x$ROPE_Equivalence, c("Accepted", "Rejected", "Undecided"))))]
 
-  add.args <- lapply(match.call(expand.dots = FALSE)$`...`, function(x) x)
+  add.args <- lapply(match.call(expand.dots = FALSE)[["..."]], function(x) x)
   if ("colors" %in% names(add.args)) fill.color <- eval(add.args[["colors"]])
   if ("x.title" %in% names(add.args)) x.title <- eval(add.args[["x.title"]])
   if ("legend.title" %in% names(add.args)) legend.title <- eval(add.args[["legend.title"]])
-  if ("labels" %in% names(add.args)) labels <- eval(add.args[["labels"]])
+  if ("labels" %in% names(add.args)) axis_labels <- eval(add.args[["labels"]])
 
   rope.line.alpha <- 1.25 * rope_alpha
   if (rope.line.alpha > 1) rope.line.alpha <- 1
@@ -170,7 +170,7 @@ plot.see_equivalence_test <- function(x,
     ) +
     scale_fill_manual(values = fill.color) +
     labs(x = x.title, y = NULL, fill = legend.title) +
-    scale_y_discrete(labels = labels) +
+    scale_y_discrete(labels = axis_labels) +
     theme(legend.position = "bottom")
 
   if (!is.null(n_columns)) {
@@ -193,10 +193,8 @@ plot.see_equivalence_test <- function(x,
         p <- p + facet_wrap(~Component, scales = "free", ncol = n_columns)
       }
     }
-  } else {
-    if (length(unique(tmp$HDI)) > 1L) {
-      p <- p + facet_wrap(~HDI, scales = "free", ncol = n_columns)
-    }
+  } else if (length(unique(tmp$HDI)) > 1L) {
+    p <- p + facet_wrap(~HDI, scales = "free", ncol = n_columns)
   }
 
   p
@@ -259,7 +257,7 @@ plot.see_equivalence_test_df <- function(x,
   tmp$predictor <- factor(tmp$predictor, levels = rev(unique(tmp$predictor)))
 
   # get labels
-  labels <- .clean_parameter_names(tmp$predictor, grid = !is.null(n_columns))
+  axis_labels <- .clean_parameter_names(tmp$predictor, grid = !is.null(n_columns))
 
   # check for user defined arguments
 
@@ -273,11 +271,11 @@ plot.see_equivalence_test_df <- function(x,
 
   fill.color <- fill.color[sort(unique(match(x$ROPE_Equivalence, c("Accepted", "Rejected", "Undecided"))))]
 
-  add.args <- lapply(match.call(expand.dots = FALSE)$`...`, function(x) x)
+  add.args <- lapply(match.call(expand.dots = FALSE)[["..."]], function(x) x)
   if ("colors" %in% names(add.args)) fill.color <- eval(add.args[["colors"]])
   if ("x.title" %in% names(add.args)) x.title <- eval(add.args[["x.title"]])
   if ("legend.title" %in% names(add.args)) legend.title <- eval(add.args[["legend.title"]])
-  if ("labels" %in% names(add.args)) labels <- eval(add.args[["labels"]])
+  if ("labels" %in% names(add.args)) axis_labels <- eval(add.args[["labels"]])
 
   rope.line.alpha <- 1.25 * rope_alpha
 
@@ -317,7 +315,7 @@ plot.see_equivalence_test_df <- function(x,
     ) +
     scale_fill_manual(values = fill.color) +
     labs(x = x.title, y = NULL, fill = legend.title) +
-    scale_y_discrete(labels = labels) +
+    scale_y_discrete(labels = axis_labels) +
     theme(legend.position = "bottom")
 
   if (length(unique(tmp$HDI)) > 1L) {
@@ -390,11 +388,10 @@ plot.see_equivalence_test_lm <- function(x,
 
   fill.color <- fill.color[sort(unique(match(x$ROPE_Equivalence, c("Accepted", "Rejected", "Undecided"))))]
 
-  add.args <- lapply(match.call(expand.dots = FALSE)$`...`, function(x) x)
+  add.args <- lapply(match.call(expand.dots = FALSE)[["..."]], function(x) x)
   if ("colors" %in% names(add.args)) fill.color <- eval(add.args[["colors"]])
   if ("x.title" %in% names(add.args)) x.title <- eval(add.args[["x.title"]])
   if ("legend.title" %in% names(add.args)) legend.title <- eval(add.args[["legend.title"]])
-  if ("labels" %in% names(add.args)) labels <- eval(add.args[["labels"]])
 
   rope.line.alpha <- 1.25 * rope_alpha
   if (rope.line.alpha > 1) rope.line.alpha <- 1

diff --git a/R/plot.p_direction.R b/R/plot.p_direction.R
@@ -27,17 +27,17 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
     data <- data[, x$Parameter, drop = FALSE]
     dataplot <- data.frame()
     for (i in names(data)) {
-      if (!is.null(params)) {
+      if (!is.null(params) && all(c("Effects", "Component") %in% colnames(params))) {
         dataplot <- rbind(
           dataplot,
           cbind(
-            .compute_densities_pd(data[[i]], name = i),
-            "Effects" = params$Effects[params$Parameter == i],
-            "Component" = params$Component[params$Parameter == i]
+            .compute_densities_pd(data[[i]], name = i, null = attr(x, "null")),
+            Effects = params$Effects[params$Parameter == i],
+            Component = params$Component[params$Parameter == i]
           )
         )
       } else {
-        dataplot <- rbind(dataplot, .compute_densities_pd(data[[i]], name = i))
+        dataplot <- rbind(dataplot, .compute_densities_pd(data[[i]], name = i, null = attr(x, "null")))
       }
     }
 
@@ -60,7 +60,7 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
     }
   } else {
     levels_order <- NULL
-    dataplot <- .compute_densities_pd(data[, 1], name = "Posterior")
+    dataplot <- .compute_densities_pd(data[, 1], name = "Posterior", null = attr(x, "null"))
   }
 
   dataplot <- do.call(
@@ -70,7 +70,7 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
       list(dataplot$y, dataplot$fill),
       function(df) {
         df$n <- nrow(df)
-        return(df)
+        df
       }
     )
   )
@@ -81,7 +81,7 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
       dataplot$y,
       function(df) {
         df$prop <- df$n / nrow(df)
-        return(df)
+        df
       }
     )
   )
@@ -108,10 +108,10 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
   dataplot <- .fix_facet_names(dataplot)
 
   attr(dataplot, "info") <- list(
-    "xlab" = "Possible parameter values",
-    "ylab" = ylab,
-    "legend_fill" = "Effect direction",
-    "title" = "Probability of Direction"
+    xlab = "Possible parameter values",
+    ylab = ylab,
+    legend_fill = "Effect direction",
+    title = "Probability of Direction"
   )
 
   class(dataplot) <- c("data_plot", "see_p_direction", class(dataplot))
@@ -121,11 +121,14 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
 
 
 #' @keywords internal
-.compute_densities_pd <- function(x, name = "Y") {
+.compute_densities_pd <- function(x, name = "Y", null = 0) {
   out <- .as.data.frame_density(
     stats::density(x)
   )
-  out$fill <- ifelse(out$x < 0, "Negative", "Positive")
+  if (is.null(null)) {
+    null <- 0
+  }
+  out$fill <- ifelse(out$x < null, "Negative", "Positive")
   out$height <- as.vector(
     (out$y - min(out$y, na.rm = TRUE)) /
       diff(range(out$y, na.rm = TRUE), na.rm = TRUE)
@@ -182,7 +185,7 @@ plot.see_p_direction <- function(x,
   params <- unique(x$y)
 
   # get labels
-  labels <- .clean_parameter_names(x$y, grid = !is.null(n_columns))
+  axis_labels <- .clean_parameter_names(x$y, grid = !is.null(n_columns))
 
   insight::check_if_installed("ggridges")
 
@@ -216,7 +219,7 @@ plot.see_p_direction <- function(x,
   if (length(unique(x$y)) == 1 && is.numeric(x$y)) {
     p <- p + scale_y_continuous(breaks = NULL, labels = NULL)
   } else {
-    p <- p + scale_y_discrete(labels = labels)
+    p <- p + scale_y_discrete(labels = axis_labels)
   }
 
 

diff --git a/R/plot.p_function.R b/R/plot.p_function.R
@@ -55,6 +55,12 @@ plot.see_p_function <- function(x,
   # make sure group is factor
   data_ci_segments$group <- as.factor(data_ci_segments$group)
 
+  # sanity check - size_line must be of length two, when we have more than
+  # one group (i.e. when we emphasize CI lines)
+  if (length(size_line) != 2 && insight::n_unique(data_ci_segments$group) == 2) {
+    insight::format_error("Length of `size_line` must of length 2, to match regular and emphasized interval lines.") # nolint
+  }
+
   # setup - no color/fill aes for ribbons when we have no facets
   if (!is.null(n_columns) || insight::n_unique(data_ribbon$Parameter) == 1) {
     p <- ggplot2::ggplot() +