Fix #646

R/binned_residuals.R

@@ -29,6 +29,7 @@
 #'   time-consuming. By default, `show_dots = NULL`. In this case `binned_residuals()`
 #'   tries to guess whether performance will be poor due to a very large model
 #'   and thus automatically shows or hides dots.
+#' @param verbose Toggle warnings and messages.
 #' @param ... Currently not used.
 #'
 #' @return A data frame representing the data that is mapped in the accompanying
@@ -83,11 +84,20 @@ binned_residuals <- function(model,
                              ci_type = c("exact", "gaussian", "boot"),
                              residuals = c("deviance", "pearson", "response"),
                              iterations = 1000,
+                             verbose = TRUE,
                              ...) {
   # match arguments
   ci_type <- match.arg(ci_type)
   residuals <- match.arg(residuals)
 
+  # for non-bernoulli models, `"exact"` doesn't work
+  if (isFALSE(insight::model_info(model)$is_bernoulli)) {
+    ci_type <- "gaussian"
+    if (verbose) {
+      insight::format_alert("Using `ci_type = \"gaussian\"` because model is not bernoulli.")
+    }
+  }
+
   fitted_values <- stats::fitted(model)
   mf <- insight::get_data(model, verbose = FALSE)
 
@@ -186,7 +196,7 @@ binned_residuals <- function(model,
   }
   out <- out / n
 
-  quant <- stats::quantile(out, c((1 - ci) / 2, (1 + ci) / 2))
+  quant <- stats::quantile(out, c((1 - ci) / 2, (1 + ci) / 2), na.rm = TRUE)
   c(CI_low = quant[1L], CI_high = quant[2L])
 }
 

R/check_model.R

@@ -374,7 +374,7 @@ check_model.model_fit <- function(x,
   dat$INFLUENTIAL <- .influential_obs(model, threshold = threshold)
   dat$PP_CHECK <- .safe(check_predictions(model, ...))
   if (isTRUE(model_info$is_binomial)) {
-    dat$BINNED_RESID <- binned_residuals(model, ...)
+    dat$BINNED_RESID <- binned_residuals(model, verbose = verbose, ...)
   }
   if (isTRUE(model_info$is_count)) {
     dat$OVERDISPERSION <- .diag_overdispersion(model)

tests/testthat/test-binned_residuals.R

@@ -155,3 +155,22 @@ test_that("binned_residuals, bootstrapped CI", {
     tolerance = 1e-4
   )
 })
+
+test_that("binned_residuals, msg for non-bernoulli", {
+  skip_on_cran()
+  tot <- rep(10, 100)
+  suc <- rbinom(100, prob = 0.9, size = tot)
+
+  dat <- data.frame(tot, suc)
+  dat$prop <- suc / tot
+  dat$x1 <- as.factor(sample(1:5, 100, replace = TRUE))
+
+  mod <- glm(prop ~ x1,
+    family = binomial,
+    data = df,
+    weights = tot
+  )
+
+  expect_message(binned_residuals(mod1), regex = "Using `ci_type = \"gaussian\"`")
+  expect_silent(binned_residuals(mod1, verbose = FALSE))
+})