Merge pull request #504 from utkarshpawade/fix/kde-correction-empty-vector

Validate user-provided pit at the entry point

Author: jgabry

NEWS.md

@@ -1,6 +1,6 @@
 # bayesplot (development version)
 
-
+* Validate user-provided `pit` values in `ppc_loo_pit_data()` and `ppc_loo_pit_qq()`, rejecting non-numeric inputs, missing values, and values outside `[0, 1]`.
 * New `show_marginal` argument to `ppd_*()` functions to show the PPD - the marginal predictive distribution by @mattansb (#425)
 * `ppc_ecdf_overlay()`, `ppc_ecdf_overlay_grouped()`, and `ppd_ecdf_overlay()` now always use `geom_step()`. The `discrete` argument is deprecated.
 * Fixed missing `drop = FALSE` in `nuts_params.CmdStanMCMC()`.

R/ppc-loo.R

@@ -302,7 +302,10 @@ ppc_loo_pit_data <-
            boundary_correction = TRUE,
            grid_len = 512) {
     if (!is.null(pit)) {
-      stopifnot(is.numeric(pit), is_vector_or_1Darray(pit))
+      pit <- validate_pit(pit)
+      if (boundary_correction && length(pit) < 2L) {
+        abort("At least 2 PIT values are required when 'boundary_correction' is TRUE.")
+      }
       inform("'pit' specified so ignoring 'y','yrep','lw' if specified.")
     } else {
       suggested_package("rstantools")
@@ -348,7 +351,7 @@ ppc_loo_pit_qq <- function(y,
 
   compare <- match.arg(compare)
   if (!is.null(pit)) {
-    stopifnot(is.numeric(pit), is_vector_or_1Darray(pit))
+    pit <- validate_pit(pit)
     inform("'pit' specified so ignoring 'y','yrep','lw' if specified.")
   } else {
     suggested_package("rstantools")
@@ -795,14 +798,6 @@ ppc_loo_ribbon <-
   # Generate boundary corrected values via a linear convolution using a
   # 1-D Gaussian window filter. This method uses the "reflection method"
   # to estimate these pvalues and helps speed up the code
-  if (any(is.infinite(x))) {
-    warn(paste(
-      "Ignored", sum(is.infinite(x)),
-      "Non-finite PIT values are invalid for KDE boundary correction method"
-    ))
-    x <- x[is.finite(x)]
-  }
-
   if (grid_len < 100) {
     grid_len <- 100
   }
@@ -819,6 +814,10 @@ ppc_loo_ribbon <-
   # 1-D Convolution
   bc_pvals <- .linear_convolution(x, bw, grid_counts, grid_breaks, grid_len)
 
+  if (all(is.na(bc_pvals))) {
+    abort("KDE boundary correction produced all NA values.")
+  }
+
   # Generate vector of x-axis values for plotting based on binned relative freqs
   n_breaks <- length(grid_breaks)
 

tests/testthat/test-ppc-loo.R

@@ -59,17 +59,50 @@ test_that("ppc_loo_pit_overlay works with boundary_correction=FALSE", {
   expect_gg(p1)
 })
 
-test_that(".kde_correction warns when PIT values are non-finite", {
-  set.seed(123)
-  pit_vals <- c(stats::runif(500), Inf)
-  expect_warning(
-    out <- .kde_correction(pit_vals, bw = "nrd0", grid_len = 128),
-    "Non-finite PIT values are invalid"
+test_that("ppc_loo_pit_data validates user-provided pit values", {
+  expect_error(
+    ppc_loo_pit_data(pit = c(0.5, Inf)),
+    "between 0 and 1"
+  )
+  expect_error(
+    ppc_loo_pit_data(pit = c(-1, 0.5)),
+    "between 0 and 1"
+  )
+  expect_error(
+    ppc_loo_pit_data(pit = c(0.5, NA)),
+    "NAs not allowed"
+  )
+  expect_error(
+    ppc_loo_pit_data(pit = "not numeric"),
+    "is.numeric"
+  )
+  expect_error(
+    ppc_loo_pit_data(pit = c(Inf, -Inf, Inf)),
+    "between 0 and 1"
+  )
+  expect_error(
+    ppc_loo_pit_data(pit = 0.5, boundary_correction = TRUE),
+    "At least 2 PIT values"
+  )
+})
+
+test_that("ppc_loo_pit_qq validates user-provided pit values", {
+  expect_error(
+    ppc_loo_pit_qq(pit = c(0.5, Inf)),
+    "between 0 and 1"
+  )
+  expect_error(
+    ppc_loo_pit_qq(pit = c(-1, 0.5)),
+    "between 0 and 1"
+  )
+  expect_error(
+    ppc_loo_pit_qq(pit = c(0.5, NA)),
+    "NAs not allowed"
+  )
+  expect_error(
+    ppc_loo_pit_qq(pit = "not numeric"),
+    "is.numeric"
   )
-  expect_type(out, "list")
-  expect_true(all(c("xs", "bc_pvals") %in% names(out)))
-  expect_equal(length(out$xs), 128)
-  expect_equal(length(out$bc_pvals), 128)
 })
 
 test_that("ppc_loo_pit_qq returns ggplot object", {