Show the influential-observations plot in check_model() for glmmTMB models (#974)

Co-authored-by: Daniel <mail@danielluedecke.de>

Author: jmgirard

DESCRIPTION

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

NEWS.md

@@ -7,6 +7,15 @@
 
 ## Changes
 
+* `check_model()` now shows the plot of influential observations for models
+  from package *glmmTMB* with a gaussian, poisson, binomial, Gamma, or `nbinom2`
+  family, and without zero-inflation or a dispersion formula. The plot uses hat
+  values and a one-step approximation of Cook's distance, so the model is not
+  refit. For other *glmmTMB* models, the plot is skipped, and with
+  `verbose = TRUE` a message names the reason. For the same models,
+  `plot(check_outliers())` shows this plot with the Cook's distances from the
+  refits (#95).
+
 * `check_outliers()` now computes the default threshold for Cook's distance as
   `qf(0.5, p, n - p)`, as the documentation states. Here `p` is the number of
   fixed effects of the conditional model, and `n` is the number of

R/check_model.R

@@ -126,6 +126,9 @@
 #' This plot is used to identify influential observations. If any points in this
 #' plot fall outside of Cook’s distance (the dashed lines) then it is considered
 #' an influential observation. See [`check_outliers()`] for further details.
+#' For models from package *glmmTMB*, this plot uses a one-step approximation
+#' of Cook's distance from the hat values, while [`check_outliers()`] computes
+#' Cook's distance by refitting the model without each observation.
 #'
 #' @section Multicollinearity:
 #' This plot checks for potential collinearity among predictors. In a nutshell,
@@ -949,24 +952,17 @@ check_model.DHARMa <- check_model.performance_simres
 
   # outliers --------------
   if (any(c("all", "outliers") %in% check)) {
-    # glmmTMB needs one refit per row for Cook's distance, which is too slow here
     if (inherits(model, "glmmTMB")) {
-      if (verbose) {
-        insight::format_alert(paste(
-          "The check for influential observations is skipped for models of class",
-          "`glmmTMB`, because Cook's distance needs one model refit per observation.",
-          "Use `check_outliers()` to compute it."
-        ))
-      }
+      dat$INFLUENTIAL <- .check_model_influential_glmmTMB(model, verbose)
     } else {
       dat$OUTLIERS <- .safe(check_outliers(model, method = "cook"))
+      if (is.null(dat$OUTLIERS)) {
+        threshold <- NULL
+      } else {
+        threshold <- attributes(dat$OUTLIERS)$threshold$cook
+      }
+      dat$INFLUENTIAL <- .safe(.model_diagnostic_outlier(model, threshold = threshold))
     }
-    if (is.null(dat$OUTLIERS)) {
-      threshold <- NULL
-    } else {
-      threshold <- attributes(dat$OUTLIERS)$threshold$cook
-    }
-    dat$INFLUENTIAL <- .safe(.model_diagnostic_outlier(model, threshold = threshold))
   }
 
   # posterior predictive checks --------------
@@ -1023,24 +1019,17 @@ check_model.DHARMa <- check_model.performance_simres
 
   # outliers --------------
   if (any(c("all", "outliers") %in% check)) {
-    # glmmTMB needs one refit per row for Cook's distance, which is too slow here
     if (inherits(model, "glmmTMB")) {
-      if (verbose) {
-        insight::format_alert(paste(
-          "The check for influential observations is skipped for models of class",
-          "`glmmTMB`, because Cook's distance needs one model refit per observation.",
-          "Use `check_outliers()` to compute it."
-        ))
-      }
+      dat$INFLUENTIAL <- .check_model_influential_glmmTMB(model, verbose)
     } else {
       dat$OUTLIERS <- .safe(check_outliers(model, method = "cook"))
+      if (is.null(dat$OUTLIERS)) {
+        threshold <- NULL
+      } else {
+        threshold <- attributes(dat$OUTLIERS)$threshold$cook
+      }
+      dat$INFLUENTIAL <- .safe(.model_diagnostic_outlier(model, threshold = threshold))
     }
-    if (is.null(dat$OUTLIERS)) {
-      threshold <- NULL
-    } else {
-      threshold <- attributes(dat$OUTLIERS)$threshold$cook
-    }
-    dat$INFLUENTIAL <- .safe(.model_diagnostic_outlier(model, threshold = threshold))
   }
 
   # posterior predictive checks --------------
@@ -1068,6 +1057,44 @@ check_model.DHARMa <- check_model.performance_simres
 }
 
 
+# data for the influential observations panel of glmmTMB models ----------
+
+# Cook's distance from `check_outliers()` needs one refit per row for glmmTMB,
+# so the panel uses hat values and a one-step Cook's distance, with the
+# threshold that `check_outliers()` uses
+.check_model_influential_glmmTMB <- function(model, verbose = TRUE) {
+  unsupported <- .safe(
+    .glmmTMB_influence_unsupported(model),
+    "a structure that cannot be read"
+  )
+  if (!is.null(unsupported)) {
+    if (verbose) {
+      insight::format_alert(paste0(
+        "The check for influential observations is skipped for this `glmmTMB` ",
+        "model, because hat values are not available for models with ",
+        unsupported,
+        "."
+      ))
+    }
+    return(NULL)
+  }
+  # without the threshold of `check_outliers()`, for example when n - p < 1,
+  # the contour lines would not match it
+  threshold <- .safe(.check_outliers_cook_threshold(model))
+  out <- NULL
+  if (!is.null(threshold)) {
+    out <- .safe(.model_diagnostic_outlier(model, threshold = threshold))
+  }
+  if (is.null(out) && verbose) {
+    insight::format_alert(paste(
+      "The check for influential observations is skipped for this `glmmTMB`",
+      "model, because its hat values and Cook's distances could not be computed."
+    ))
+  }
+  out
+}
+
+
 # compile plots for checks of Bayesian models  ------------------------
 
 .check_assumptions_stan <- function(model, ...) {