Merge pull request #510 from utkarshpawade/test/ppc-error-loo-data-coverage

Add test coverage for ppc_error_data and ppc_loo_pit_data

Author: jgabry

.gitignore

@@ -16,3 +16,4 @@ release-prep.R
 
 # vscode/positron/etc settings
 .vscode/*
+Rplots.pdf

NEWS.md

@@ -1,5 +1,6 @@
 # bayesplot (development version)
 
+* Added unit tests for `ppc_error_data()` and `ppc_loo_pit_data()` covering output structure, argument handling, and edge cases.
 * Added vignette sections demonstrating `*_data()` companion functions for building custom ggplot2 visualizations (#435)
 * Extract `drop_singleton_values()` helper in `mcmc_nuts_treedepth()` to remove duplicated filtering logic.
 * Eliminate redundant data processing in `mcmc_areas_data()` by reusing the prepared MCMC array for both interval and density computation.

tests/testthat/test-ppc-errors.R

@@ -1,7 +1,7 @@
+skip_if_not_installed("rstantools")
 source(test_path("data-for-ppc-tests.R"))
 
 test_that("ppc_error_hist and ppc_error_scatter return ggplot object", {
-  skip_if_not_installed("rstantools")
   expect_gg(ppc_error_hist(y, yrep[1:5, ], binwidth = 0.1))
   expect_gg(ppc_error_scatter(y, yrep[1:5, ]))
 
@@ -13,14 +13,12 @@ test_that("ppc_error_hist and ppc_error_scatter return ggplot object", {
 })
 
 test_that("ppc_error_hist_grouped returns ggplot object", {
-  skip_if_not_installed("rstantools")
   expect_gg(ppc_error_hist_grouped(y, yrep[1:5, ], group, binwidth = 0.1))
   expect_gg(ppc_error_hist_grouped(y, yrep[1,, drop = FALSE], group,
                                    freq = FALSE, binwidth = 1))
 })
 
 test_that("ppc_error_scatter_avg returns ggplot2 object", {
-  skip_if_not_installed("rstantools")
   expect_gg(ppc_error_scatter_avg(y, yrep))
   expect_gg(ppc_error_scatter_avg(y, yrep[1:5, ]))
 
@@ -30,7 +28,6 @@ test_that("ppc_error_scatter_avg returns ggplot2 object", {
 })
 
 test_that("ppc_error_scatter_avg same as ppc_error_scatter if nrow(yrep) = 1", {
-  skip_if_not_installed("rstantools")
   p1 <- ppc_error_scatter_avg(y2, yrep2)
   p2 <- ppc_error_scatter(y2, yrep2)
   d1 <- p1$data
@@ -42,8 +39,6 @@ test_that("ppc_error_scatter_avg same as ppc_error_scatter if nrow(yrep) = 1", {
 })
 
 test_that("ppc_error_scatter_avg_vs_x returns ggplot2 object", {
-  skip_if_not_installed("rstantools")
-
   # expect warning
   expect_warning(expect_gg(ppc_error_scatter_avg_vs_x(y, yrep, x = rnorm(length(y)))),
                  "'ppc_error_scatter_avg_vs_x' is deprecated.")
@@ -52,7 +47,6 @@ test_that("ppc_error_scatter_avg_vs_x returns ggplot2 object", {
 })
 
 test_that("ppc_error_binned returns ggplot object", {
-  skip_if_not_installed("rstantools")
   load(test_path("data-for-binomial.rda"))
   expect_gg(ppc_error_binned(y, Ey))
   expect_gg(ppc_error_binned(y[1:5], Ey[, 1:5]))
@@ -73,6 +67,24 @@ test_that("bin_errors works for edge cases", {
   expect_equal(ans, val)
 })
 
+# ppc_error_data tests -----------------------------------------------------
+
+test_that("ppc_error_data returns exact structure and computed errors", {
+  d <- ppc_error_data(y, yrep)
+  expect_named(d, c("y_id", "y_name", "y_obs", "rep_id", "rep_label", "value"))
+  third_rep <- d[d$rep_id == 3, ]
+  expected_errors <- y - yrep[3, ]
+  expect_equal(third_rep$value, expected_errors)
+  expect_equal(third_rep$y_obs, y)
+})
+
+test_that("ppc_error_data with group returns exact structure", {
+  d <- ppc_error_data(y, yrep, group = group)
+  expect_named(d, c("group", "y_id", "y_name", "y_obs", "rep_id", "rep_label", "value"))
+  expect_identical(levels(d$group), levels(group))
+  expect_equal(d$group[d$rep_id == 1], group)
+})
+
 
 # Visual tests -----------------------------------------------------------------
 

tests/testthat/test-ppc-loo.R

@@ -352,3 +352,50 @@ test_that("ppc_loo_pit_ecdf renders correctly", {
   )
   vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (ecdf difference)", p_custom)
 })
+
+
+# ppc_loo_pit_data tests ---------------------------------------------------
+
+test_that("ppc_loo_pit_data returns the expected structure for both boundary modes", {
+  set.seed(123)
+  pit_vals <- runif(50)
+  n_samples <- 10
+  expect_message(
+    d_raw <- ppc_loo_pit_data(
+      pit = pit_vals,
+      boundary_correction = FALSE,
+      samples = n_samples
+    ),
+    "pit"
+  )
+  expect_s3_class(d_raw, "data.frame")
+  expect_named(
+    d_raw,
+    c("y_id", "y_name", "rep_id", "rep_label", "is_y", "is_y_label", "value")
+  )
+  y_rows <- d_raw[d_raw$is_y, ]
+  yrep_rows <- d_raw[!d_raw$is_y, ]
+  expect_equal(nrow(y_rows), length(pit_vals))
+  expect_equal(nrow(yrep_rows), length(pit_vals) * n_samples)
+  expect_equal(y_rows$value, pit_vals)
+
+  grid_len <- 128
+  expect_message(
+    d_bc <- ppc_loo_pit_data(
+      pit = pit_vals,
+      boundary_correction = TRUE,
+      samples = n_samples,
+      grid_len = grid_len
+    ),
+    "pit"
+  )
+  expect_named(
+    d_bc,
+    c("y_id", "y_name", "rep_id", "rep_label", "is_y", "is_y_label", "value", "x")
+  )
+  y_rows <- d_bc[d_bc$is_y, ]
+  yrep_rows <- d_bc[!d_bc$is_y, ]
+  expect_equal(nrow(y_rows), grid_len)
+  expect_equal(nrow(yrep_rows), grid_len * n_samples)
+  expect_false(anyNA(d_bc$x))
+})