From bfe1b3445905a8845c7b339b4c78ad62431e1940 Mon Sep 17 00:00:00 2001 From: Utkarsh Date: Wed, 25 Mar 2026 06:21:15 +0530 Subject: [PATCH 1/3] Add test coverage for ppc_error_data and ppc_loo_pit_data --- tests/testthat/test-ppc-errors.R | 41 ++++++++++++++++++++++ tests/testthat/test-ppc-loo.R | 60 ++++++++++++++++++++++++++++++++ 2 files changed, 101 insertions(+) diff --git a/tests/testthat/test-ppc-errors.R b/tests/testthat/test-ppc-errors.R index de4322aa..cc97bd3a 100644 --- a/tests/testthat/test-ppc-errors.R +++ b/tests/testthat/test-ppc-errors.R @@ -170,3 +170,44 @@ test_that("ppc_error_binned renders correctly", { p_base_x <- ppc_error_binned(y, y_rep, x = x) vdiffr::expect_doppelganger("ppc_error_binned (with x)", p_base_x) }) + + +# ppc_error_data tests ----------------------------------------------------- + +source(test_path("data-for-ppc-tests.R")) + +test_that("ppc_error_data returns correct structure", { + skip_if_not_installed("rstantools") + d <- ppc_error_data(y, yrep) + expect_s3_class(d, "data.frame") + expect_true(all(c("y_id", "y_obs", "rep_id", "rep_label", "value") %in% names(d))) +}) + +test_that("ppc_error_data computes errors correctly", { + skip_if_not_installed("rstantools") + d <- ppc_error_data(y, yrep) + # errors should be y - yrep + first_rep <- d[d$rep_id == 1, ] + expected_errors <- y - yrep[1, ] + expect_equal(first_rep$value, expected_errors) + expect_equal(first_rep$y_obs, y) +}) + +test_that("ppc_error_data returns correct number of rows", { + skip_if_not_installed("rstantools") + d <- ppc_error_data(y, yrep) + expect_equal(nrow(d), length(y) * nrow(yrep)) +}) + +test_that("ppc_error_data with group adds group column", { + skip_if_not_installed("rstantools") + d <- ppc_error_data(y, yrep, group = group) + expect_true("group" %in% names(d)) + expect_equal(nlevels(factor(d$group)), nlevels(group)) +}) + +test_that("ppc_error_data works with single replicate", { + skip_if_not_installed("rstantools") + d <- ppc_error_data(y, yrep[1, , drop = FALSE]) + expect_equal(nrow(d), length(y)) +}) diff --git a/tests/testthat/test-ppc-loo.R b/tests/testthat/test-ppc-loo.R index 83cdaf50..27c858aa 100644 --- a/tests/testthat/test-ppc-loo.R +++ b/tests/testthat/test-ppc-loo.R @@ -352,3 +352,63 @@ 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 correct structure with pit argument", { + set.seed(123) + pit_vals <- runif(50) + expect_message( + d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = FALSE, samples = 10), + "pit" + ) + expect_s3_class(d, "data.frame") + expect_true(all(c("y_id", "rep_id", "rep_label", "value") %in% names(d))) + expect_true("is_y" %in% names(d)) +}) + +test_that("ppc_loo_pit_data with boundary_correction=TRUE returns x column", { + set.seed(123) + pit_vals <- runif(50) + expect_message( + d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = TRUE, + samples = 10), + "pit" + ) + expect_true("x" %in% names(d)) +}) + +test_that("ppc_loo_pit_data without boundary_correction has correct rows", { + set.seed(123) + pit_vals <- runif(50) + n_samples <- 10 + expect_message( + d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = FALSE, + samples = n_samples), + "pit" + ) + y_rows <- d[d$is_y, ] + yrep_rows <- d[!d$is_y, ] + expect_equal(nrow(y_rows), length(pit_vals)) + expect_equal(nrow(yrep_rows), length(pit_vals) * n_samples) +}) + +test_that("ppc_loo_pit_data works with yrep and lw", { + skip_if_not_installed("rstanarm") + skip_if_not_installed("loo") + d <- ppc_loo_pit_data(y, yrep, lw, boundary_correction = FALSE, samples = 10) + expect_s3_class(d, "data.frame") + expect_true(all(c("y_id", "rep_id", "rep_label", "is_y", "value") %in% names(d))) +}) + +test_that("ppc_loo_pit_data pit values are in [0, 1]", { + set.seed(123) + pit_vals <- runif(100) + expect_message( + d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = FALSE, samples = 5), + "pit" + ) + y_rows <- d[d$is_y, ] + expect_true(all(y_rows$value >= 0 & y_rows$value <= 1)) +}) From e882da272fac124e2d9b65eaacfe4072eb78a266 Mon Sep 17 00:00:00 2001 From: Utkarsh Date: Wed, 25 Mar 2026 20:22:42 +0530 Subject: [PATCH 2/3] update news.md --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index ff022231..a0c0cf23 100644 --- a/NEWS.md +++ b/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. * Eliminate redundant data processing in `mcmc_areas_data()` by reusing the prepared MCMC array for both interval and density computation. * Validate equal chain lengths in `validate_df_with_chain()`, reject missing chain labels, and renumber data-frame chain labels internally when converting From 14af3a91d60abb921347e0497b343cd6ec0f1a16 Mon Sep 17 00:00:00 2001 From: jgabry Date: Thu, 26 Mar 2026 14:11:54 -0400 Subject: [PATCH 3/3] Consolidate new tests --- .gitignore | 1 + tests/testthat/test-ppc-errors.R | 67 +++++++++-------------------- tests/testthat/test-ppc-loo.R | 73 +++++++++++++------------------- 3 files changed, 50 insertions(+), 91 deletions(-) diff --git a/.gitignore b/.gitignore index 695e6e77..f34560fe 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,4 @@ release-prep.R # vscode/positron/etc settings .vscode/* +Rplots.pdf diff --git a/tests/testthat/test-ppc-errors.R b/tests/testthat/test-ppc-errors.R index cc97bd3a..e88c65b5 100644 --- a/tests/testthat/test-ppc-errors.R +++ b/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 ----------------------------------------------------------------- @@ -170,44 +182,3 @@ test_that("ppc_error_binned renders correctly", { p_base_x <- ppc_error_binned(y, y_rep, x = x) vdiffr::expect_doppelganger("ppc_error_binned (with x)", p_base_x) }) - - -# ppc_error_data tests ----------------------------------------------------- - -source(test_path("data-for-ppc-tests.R")) - -test_that("ppc_error_data returns correct structure", { - skip_if_not_installed("rstantools") - d <- ppc_error_data(y, yrep) - expect_s3_class(d, "data.frame") - expect_true(all(c("y_id", "y_obs", "rep_id", "rep_label", "value") %in% names(d))) -}) - -test_that("ppc_error_data computes errors correctly", { - skip_if_not_installed("rstantools") - d <- ppc_error_data(y, yrep) - # errors should be y - yrep - first_rep <- d[d$rep_id == 1, ] - expected_errors <- y - yrep[1, ] - expect_equal(first_rep$value, expected_errors) - expect_equal(first_rep$y_obs, y) -}) - -test_that("ppc_error_data returns correct number of rows", { - skip_if_not_installed("rstantools") - d <- ppc_error_data(y, yrep) - expect_equal(nrow(d), length(y) * nrow(yrep)) -}) - -test_that("ppc_error_data with group adds group column", { - skip_if_not_installed("rstantools") - d <- ppc_error_data(y, yrep, group = group) - expect_true("group" %in% names(d)) - expect_equal(nlevels(factor(d$group)), nlevels(group)) -}) - -test_that("ppc_error_data works with single replicate", { - skip_if_not_installed("rstantools") - d <- ppc_error_data(y, yrep[1, , drop = FALSE]) - expect_equal(nrow(d), length(y)) -}) diff --git a/tests/testthat/test-ppc-loo.R b/tests/testthat/test-ppc-loo.R index 27c858aa..a722ad46 100644 --- a/tests/testthat/test-ppc-loo.R +++ b/tests/testthat/test-ppc-loo.R @@ -356,59 +356,46 @@ test_that("ppc_loo_pit_ecdf renders correctly", { # ppc_loo_pit_data tests --------------------------------------------------- -test_that("ppc_loo_pit_data returns correct structure with pit argument", { - set.seed(123) - pit_vals <- runif(50) - expect_message( - d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = FALSE, samples = 10), - "pit" - ) - expect_s3_class(d, "data.frame") - expect_true(all(c("y_id", "rep_id", "rep_label", "value") %in% names(d))) - expect_true("is_y" %in% names(d)) -}) - -test_that("ppc_loo_pit_data with boundary_correction=TRUE returns x column", { - set.seed(123) - pit_vals <- runif(50) - expect_message( - d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = TRUE, - samples = 10), - "pit" - ) - expect_true("x" %in% names(d)) -}) - -test_that("ppc_loo_pit_data without boundary_correction has correct rows", { +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 <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = FALSE, - samples = n_samples), + d_raw <- ppc_loo_pit_data( + pit = pit_vals, + boundary_correction = FALSE, + samples = n_samples + ), "pit" ) - y_rows <- d[d$is_y, ] - yrep_rows <- d[!d$is_y, ] + 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) -test_that("ppc_loo_pit_data works with yrep and lw", { - skip_if_not_installed("rstanarm") - skip_if_not_installed("loo") - d <- ppc_loo_pit_data(y, yrep, lw, boundary_correction = FALSE, samples = 10) - expect_s3_class(d, "data.frame") - expect_true(all(c("y_id", "rep_id", "rep_label", "is_y", "value") %in% names(d))) -}) - -test_that("ppc_loo_pit_data pit values are in [0, 1]", { - set.seed(123) - pit_vals <- runif(100) + grid_len <- 128 expect_message( - d <- ppc_loo_pit_data(pit = pit_vals, boundary_correction = FALSE, samples = 5), + d_bc <- ppc_loo_pit_data( + pit = pit_vals, + boundary_correction = TRUE, + samples = n_samples, + grid_len = grid_len + ), "pit" ) - y_rows <- d[d$is_y, ] - expect_true(all(y_rows$value >= 0 & y_rows$value <= 1)) + 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)) })