Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
@@ -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()`.
Expand Down
19 changes: 9 additions & 10 deletions R/ppc-loo.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Comment thread
utkarshpawade marked this conversation as resolved.
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")
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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
}
Comment thread
utkarshpawade marked this conversation as resolved.
Expand All @@ -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)

Expand Down
53 changes: 43 additions & 10 deletions tests/testthat/test-ppc-loo.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"
)
})
Comment thread
utkarshpawade marked this conversation as resolved.

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", {
Expand Down
Loading