allow to limit x axis in check_predictions

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.17.0.2
+Version: 0.17.0.3
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -1,5 +1,18 @@
 # performance (devel)
 
+## Changes
+
+* `check_overdispersion()` gets a `residual_type` argument, to decide whether
+  overdispersion tests are based on simulated or "standard" residuals.
+
+* `check_model()` gains a `ppc_range` argument for posterior predictive checks
+  plot. Use this to zoom in on a specific region of interest, especially if the
+  response variable has a large range.
+
+* `check_predictions()` gains a `x_limits` argument for plots. Use this to zoom
+  in on a specific region of interest, especially if the response variable has
+  a large range.
+
 ## Bug fixes
 
 * The overdispersion plot in `check_model()` now uses simulated residuals (based

R/check_model.R

@@ -53,6 +53,9 @@
 #' @param maximum_dots Limits the number of data points for models with many
 #' observations, to reduce the time for rendering the plot. Defaults to a
 #' maximum of 2000 data points to render
+#' @param ppc_range An integer vector of length two specifying the x-axis limits
+#' for the posterior predictive checks plot. Use this to zoom in on a specific
+#' region of interest, especially if the response variable has a large range.
 #' @param verbose If `FALSE` (default), suppress most warning messages.
 #' @param ... Arguments passed down to the individual check functions, especially
 #' to `check_predictions()` and `binned_residuals()`.
@@ -248,6 +251,7 @@ check_model.default <- function(
   base_size = 10,
   alpha = 0.2,
   alpha_dot = 0.8,
+  ppc_range = NULL,
   colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
   theme = see::theme_lucid(),
   verbose = FALSE,
@@ -397,6 +401,7 @@ check_model.default <- function(
   attr(assumptions_data, "overdisp_type") <- list(...)$plot_type
   attr(assumptions_data, "bandwidth") <- bandwidth
   attr(assumptions_data, "type") <- type
+  attr(assumptions_data, "ppc_range") <- ppc_range
   attr(assumptions_data, "maximum_dots") <- maximum_dots
   attr(assumptions_data, "model_class") <- class(model)[1]
   assumptions_data
@@ -442,6 +447,7 @@ check_model.stanreg <- function(
   base_size = 10,
   alpha = 0.2,
   alpha_dot = 0.8,
+  ppc_range = NULL,
   colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
   theme = see::theme_lucid(),
   verbose = FALSE,
@@ -475,6 +481,7 @@ check_model.stanreg <- function(
     type = type,
     residual_type = residual_type,
     maximum_dots = maximum_dots,
+    ppc_range = ppc_range,
     verbose = verbose,
     ...
   )
@@ -504,6 +511,7 @@ check_model.model_fit <- function(
   base_size = 10,
   alpha = 0.2,
   alpha_dot = 0.8,
+  ppc_range = NULL,
   colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
   theme = see::theme_lucid(),
   verbose = FALSE,
@@ -537,6 +545,7 @@ check_model.model_fit <- function(
     bandwidth = bandwidth,
     type = type,
     residual_type = residual_type,
+    ppc_range = ppc_range,
     verbose = verbose,
     ...
   )
@@ -562,6 +571,7 @@ check_model.performance_simres <- function(
   base_size = 10,
   alpha = 0.2,
   alpha_dot = 0.8,
+  ppc_range = NULL,
   colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
   theme = see::theme_lucid(),
   verbose = FALSE,
@@ -595,6 +605,7 @@ check_model.performance_simres <- function(
     bandwidth = bandwidth,
     type = type,
     residual_type = "simulated",
+    ppc_range = ppc_range,
     verbose = verbose,
     ...
   )

R/check_predictions.R

@@ -37,6 +37,9 @@
 #' `"discrete_dots"`, `"discrete_interval"` or `"discrete_both"` (the `discrete_*`
 #' options are appropriate for models with discrete - binary, integer or ordinal
 #' etc. - outcomes).
+#' @param x_limits An integer vector of length two specifying the x-axis limits
+#' for the plot. Use this to zoom in on a specific region of interest,
+#' especially if the response variable has a large range.
 #' @param verbose Toggle warnings.
 #' @param ... Additional arguments passed on to downstream functions. For
 #' frequentist models, these are forwarded to `simulate()`; for Bayesian models
@@ -111,6 +114,7 @@ check_predictions.default <- function(
   re_formula = NULL,
   bandwidth = "nrd",
   type = "density",
+  x_limits = NULL,
   verbose = TRUE,
   object = NULL,
   ...
@@ -162,6 +166,7 @@ check_predictions.default <- function(
     type = type,
     verbose = verbose,
     model_info = minfo,
+    x_limits = x_limits,
     ...
   )
 }
@@ -329,6 +334,7 @@ pp_check.lm <- function(
   type = "density",
   verbose = TRUE,
   model_info = NULL,
+  x_limits = NULL,
   ...
 ) {
   # we need the formula and the response values to check for matrix responses
@@ -347,13 +353,29 @@ pp_check.lm <- function(
       type,
       verbose,
       model_info,
+      x_limits,
       ...
     ))
   }
 
   # else, proceed as usual
   out <- .safe(stats::simulate(object, nsim = iterations, re.form = re_formula, ...))
 
+  # if it fails, try insight methods
+  if (is.null(out)) {
+    out <- .safe({
+      sims <- insight::get_simulated(
+        object,
+        iterations = iterations,
+        re.form = re_formula,
+        ...
+      )
+      # get_simulated returns "iter_" columms, so we rename here
+      colnames(sims) <- gsub("^iter_(\\d+)", "sim_\\1", colnames(sims))
+      sims
+    })
+  }
+
   # validation check, for mixed models, where re.form = NULL (default) might fail
   out <- .check_re_formula(out, object, iterations, re_formula, verbose, ...)
 
@@ -426,6 +448,8 @@ pp_check.lm <- function(
   attr(out, "bandwidth") <- bandwidth
   attr(out, "model_info") <- minfo
   attr(out, "type") <- type
+  attr(out, "x_limits") <- x_limits
+
   class(out) <- c("performance_pp_check", "see_performance_pp_check", class(out))
   out
 }
@@ -440,6 +464,7 @@ pp_check.glm <- function(
   type = "density",
   verbose = TRUE,
   model_info = NULL,
+  x_limits = NULL,
   ...
 ) {
   # we need the formula and the response values to check for matrix responses
@@ -458,6 +483,7 @@ pp_check.glm <- function(
       type,
       verbose,
       model_info,
+      x_limits,
       ...
     ))
   }
@@ -527,6 +553,8 @@ pp_check.glm <- function(
   attr(out, "bandwidth") <- bandwidth
   attr(out, "model_info") <- minfo
   attr(out, "type") <- type
+  attr(out, "x_limits") <- x_limits
+
   class(out) <- c(
     "performance_pp_check",
     "see_performance_pp_check",