make residuals compatible, add tests

Author: strengejacke

R/check_model_diagnostics.R

@@ -301,7 +301,7 @@
   d <- data.frame(Predicted = predicted)
 
   # residuals based on simulated residuals - but we want normally distributed residuals
-  d$Residuals <- stats::residuals(simres, quantileFunction = stats::qnorm, ...)
+  d$Residuals <- stats::residuals(simres, quantile_function = stats::qnorm, ...)
   d$Res2 <- d$Residuals^2
   d$StdRes <- insight::get_residuals(model, type = "pearson")
 

R/simulate_residuals.R

@@ -110,11 +110,24 @@ plot.performance_simres <- function(x, ...) {
 #' @rdname simulate_residuals
 #' @export
 residuals.performance_simres <- function(object, quantile_function = NULL, outlier_values = NULL, ...) {
+  # check for DHARMa argument names
+  dots <- list(...)
+  if (!is.null(dots$quantileFunction)) {
+    quantile_function <- dots$quantileFunction
+  }
+  if (!is.null(dots$outlierValues)) {
+    outlier_values <- dots$outlierValues
+  }
+
   if (is.null(quantile_function)) {
     res <- object$scaledResiduals
   } else {
     res <- quantile_function(object$scaledResiduals)
     if (!is.null(outlier_values)) {
+      # check for correct length of outlier_values
+      if (length(outlier_values) != 2) {
+        insight::format_error("`outlier_values` must be a vector of length 2.")
+      }
       res[res == -Inf] <- outlier_values[1]
       res[res == Inf] <- outlier_values[2]
     }

tests/testthat/test-check_residuals.R

@@ -1,4 +1,4 @@
-test_that("check_residuals", {
+test_that("check_residuals and simulate_residuals", {
   skip_on_cran()
   skip_if_not_installed("DHARMa")
   set.seed(123)
@@ -16,7 +16,46 @@ test_that("check_residuals", {
       "  particular models."
     )
   )
+  # check raw residuals
+  expect_equal(
+    head(residuals(res)),
+    c(0.55349, 0.44012, 0.39826, 0.9825, 0.90753, 0.05809),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+  expect_equal(
+    head(residuals(res, quantile_function = stats::qnorm)),
+    c(0.13448, -0.15068, -0.25785, 2.10826, 1.3257, -1.57097),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+  # compare to DHARMa
+  res_d <- DHARMa::simulateResiduals(m, n = 250, plot = FALSE)
+  expect_equal(
+    head(residuals(res)),
+    head(residuals(res_d)),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+  expect_equal(
+    head(residuals(res, quantile_function = stats::qnorm)),
+    head(residuals(res_d, quantileFunction = stats::qnorm)),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+  # DHARMa args work in residuals.permormance_simres
+  expect_equal(
+    residuals(res, quantileFunction = stats::qnorm, outlierValues = c(-3, 3)),
+    residuals(res_d, quantileFunction = stats::qnorm, outlierValues = c(-3, 3)),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+  # outlier_values works
+  expect_identical(sum(is.infinite(residuals(res, quantile_function = stats::qnorm))), 3L)
+  expect_identical(sum(is.infinite(residuals(res, quantile_function = stats::qnorm, outlier_values = c(-100, 100)))), 0L)
+  expect_error(residuals(res, quantile_function = stats::qnorm, outlier_values = 1:3), regex = "`outlier_values` must be")
 
+  # check_residuals
   out <- check_residuals(res)
   expect_equal(out, 0.01884602, ignore_attr = TRUE, tolerance = 1e-4)
   expect_identical(