binom CI hack for binned_performance

easystats · Oct 24, 2023 · c5c7277 · c5c7277
1 parent e2c16cd
commit c5c7277
Showing 1 changed file with 6 additions and 4 deletions.
diff --git a/R/binned_residuals.R b/R/binned_residuals.R
@@ -67,7 +67,8 @@ binned_residuals <- function(model, term = NULL, n_bins = NULL, ...) {
     pred <- mf[[term]]
   }
 
-  y <- .recode_to_zero(insight::get_response(model, verbose = FALSE)) - fv
+  y0 <- .recode_to_zero(insight::get_response(model, verbose = FALSE))
+  y <- y0 - fv
 
   if (is.null(n_bins)) n_bins <- round(sqrt(length(pred)))
 
@@ -84,23 +85,24 @@ binned_residuals <- function(model, term = NULL, n_bins = NULL, ...) {
     n <- length(items)
     sdev <- stats::sd(y[items], na.rm = TRUE)
 
+    bt <- binom.test(sum(y0[items]), n)
     data.frame(
       xbar = xbar,
       ybar = ybar,
       n = n,
       x.lo = model.range[1],
       x.hi = model.range[2],
       se = stats::qnorm(0.975) * sdev / sqrt(n),
-      ci_range = sdev / sqrt(n)
+      ci_range = sdev / sqrt(n),
+      CI_low = bt$conf.int[1] - fv,
+      CI_high = bt$conf.int[2] - fv
     )
   }))
 
   d <- do.call(rbind, d)
   d <- d[stats::complete.cases(d), ]
 
   # CIs
-  d$CI_low <- d$ybar - stats::qnorm(0.975) * d$ci_range
-  d$CI_high <- d$ybar + stats::qnorm(0.975) * d$ci_range
 
   gr <- abs(d$ybar) > abs(d$se)
   d$group <- "yes"