Improve and add plots for (simulated) residuals

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.2.6
+Version: 0.8.2.7
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -2,9 +2,11 @@
 
 ## Major changes
 
-- New `plot()` method for simulated residuals (implemented in the _performance_ package).
+- New `plot()` method for simulated residuals (implemented in the _performance_
+  package).
 
-- `plot()` for `check_model()` was revised and now includes more accurate Q-Q plots for non-Gaussian models.
+- `plot()` for `check_model()` was revised and now includes more accurate Q-Q
+  plots for non-Gaussian models.
 
 ## Minor Changes
 

R/plot.check_normality.R

@@ -24,7 +24,7 @@
 #'
 #' @return A ggplot2-object.
 #'
 #' @seealso See also the vignette about [`check_model()`](https://easystats.github.io/performance/articles/check_model.html).
 #'
 #' @examplesIf require("performance")
 #' m <<- lm(mpg ~ wt + cyl + gear + disp, data = mtcars)
@@ -39,7 +39,7 @@
                                      type = c("qq", "pp", "density"),
                                      data = NULL,
                                      size_line = 0.8,
-                                     size_point = 2,
+                                     size_point = 1.5,
                                      alpha = 0.2,
                                      dot_alpha = 0.8,
                                      colors = c("#3aaf85", "#1b6ca8"),
@@ -80,6 +80,21 @@
         res_ <- abs(stats::rstandard(model, type = "deviance"))
         fitted_ <- stats::qnorm((stats::ppoints(length(res_)) + 1) / 2)[order(order(res_))]
         dat <- stats::na.omit(data.frame(x = fitted_, y = res_))
+      } else if (inherits(model, "performance_simres")) {
+        return(plot.see_performance_simres(
+          model,
+          size_line = size_line,
+          size_point = size_point,
+          alpha = alpha,
+          dot_alpha = dot_alpha,
+          colors = colors,
+          detrend = detrend,
+          transform = stats::qnorm,
+          ...
+        ))
+      } else if (is.numeric(model)) {
+        res_ <- sort(model[!is.infinite(model)])
+        dat <- stats::na.omit(data.frame(y = res_))
       } else {
         res_ <- sort(stats::rstudent(model), na.last = NA)
         dat <- stats::na.omit(data.frame(y = res_))
@@ -97,7 +112,14 @@
         model_class = class(model)[1]
       )
     } else if (type == "density") {
-      r <- suppressMessages(stats::residuals(model))
+      if (inherits(model, "performance_simres")) {
+        r <- stats::residuals(model, quantile_function = stats::qnorm)
+        r <- r[!is.infinite(r)]
+      } else if (is.numeric(model)) {
+        r <- model[!is.infinite(model) & !is.na(model)]
+      } else {
+        r <- suppressMessages(stats::residuals(model))
+      }
       dat <- as.data.frame(bayestestR::estimate_density(r))
       dat$curve <- stats::dnorm(
         seq(min(dat$x), max(dat$x), length.out = nrow(dat)),
@@ -240,7 +262,7 @@
         )
       },
       ggplot2::geom_qq(
         mapping = if (detrend) ggplot2::aes(y = ggplot2::after_stat(.data$sample) - ggplot2::after_stat(.data$theoretical)),
         shape = 16,
         na.rm = TRUE,
         stroke = 0,

R/plot.check_predictions.R

@@ -53,7 +53,7 @@
 #'
 #' @return A ggplot2-object.
 #'
 #' @seealso See also the vignette about [`check_model()`](https://easystats.github.io/performance/articles/check_model.html).
 #'
 #' @examplesIf require("performance")
 #' model <- lm(Sepal.Length ~ Species * Petal.Width + Petal.Length, data = iris)
@@ -84,7 +84,7 @@
   check_range <- isTRUE(attributes(x)$check_range)
   plot_type <- attributes(x)$type
 
   if (missing(type) && !is.null(plot_type) && plot_type %in% c("density", "discrete_dots", "discrete_interval", "discrete_both")) {
     type <- plot_type
   } else {
     type <- match.arg(type)
@@ -327,7 +327,7 @@
           color = .data$key
         ),
         position = ggplot2::position_nudge(x = 0.2),
-        size = size_line,
+        size = size_point,
         linewidth = size_line,
         stroke = 0,
         shape = 16

R/plot.performance_simres.R

@@ -12,9 +12,9 @@
 #'
 #' @return A ggplot2-object.
 #'
 #' @seealso See also the vignette about [`check_model()`](https://easystats.github.io/performance/articles/check_model.html).
 #'
 #' @examplesIf insight::check_if_installed("performance", "0.10.9.7") && require("glmmTMB") && require("qqplotr") && require("DHARMa")
 #' data(Salamanders, package = "glmmTMB")
 #' model <- glmmTMB::glmmTMB(
 #'   count ~ mined + spp + (1 | site),
@@ -32,16 +32,14 @@
 #' @export
 plot.see_performance_simres <- function(x,
                                         size_line = 0.8,
-                                        size_point = 1,
+                                        size_point = 1.5,
                                         alpha = 0.2,
                                         dot_alpha = 0.8,
                                         colors = c("#3aaf85", "#1b6ca8"),
                                         detrend = FALSE,
                                         transform = NULL,
                                         style = theme_lucid,
                                         ...) {
-  dp <- list(min = 0, max = 1, lower.tail = TRUE, log.p = FALSE)
-
   # need DHARMa to be installed
   insight::check_if_installed("DHARMa")
 
@@ -50,10 +48,21 @@
     x <- attributes(x)$data
   }
 
+  dp <- list(min = 0, max = 1, lower.tail = TRUE, log.p = FALSE)
+  dp_band <- list(min = 0, max = 1)
+  dfun <- "unif"
+
+  # prepare arguments, based on transformation
   if (is.null(transform)) {
     res <- stats::residuals(x)
   } else {
     res <- stats::residuals(x, quantileFunction = transform)
+    res <- res[!is.infinite(res)]
+    if (identical(transform, stats::qnorm)) {
+      dp <- list(mean = 0, sd = 1)
+      dp_band <- list(mean = 0, sd = 1)
+      dfun <- "norm"
+    }
   }
 
   # base plot information
@@ -66,20 +75,20 @@
   if (requireNamespace("qqplotr", quietly = TRUE)) {
     qq_stuff <- list(
       qqplotr::stat_qq_band(
-        distribution = "unif",
-        dparams = list(min = 0, max = 1),
+        distribution = dfun,
+        dparams = dp_band,
         alpha = alpha,
         detrend = detrend
       ),
       qqplotr::stat_qq_line(
-        distribution = "unif",
+        distribution = dfun,
         dparams = dp,
         size = size_line,
         colour = colors[1],
         detrend = detrend
       ),
       qqplotr::stat_qq_point(
-        distribution = "unif",
+        distribution = dfun,
         dparams = dp,
         size = size_point,
         alpha = dot_alpha,
@@ -98,7 +107,7 @@
       ggplot2::geom_qq(
         shape = 16,
         stroke = 0,
-        distribution = stats::qunif,
+        distribution = dfun,
         dparams = dp,
         size = size_point,
         colour = colors[2]
@@ -107,19 +116,30 @@
         linewidth = size_line,
         colour = colors[1],
         na.rm = TRUE,
-        distribution = stats::qunif,
+        distribution = dfun,
         dparams = dp
       )
     )
     y_lab <- "Sample Quantiles"
   }
 
+  if (is.null(transform)) {
+    p_title <- "Uniformity of Residuals"
+    p_x <- "Standard Uniform Distribution Quantiles"
+  } else if (identical(transform, stats::qnorm)) {
+    p_title <- "Normality of Residuals"
+    p_x <- "Standard Normal Distribution Quantiles"
+  } else {
+    p_title <- "Residuals Check"
+    p_x <- "Distribution of Quantiles"
+  }
+
   gg_init +
     qq_stuff +
     ggplot2::labs(
-      title = "Uniformity of Residuals",
+      title = p_title,
       subtitle = "Dots should fall along the line",
-      x = "Standard Uniform Distribution Quantiles",
+      x = p_x,
       y = y_lab
     ) +
     style(