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/NEWS.md b/NEWS.md index b5b642f4..41f470dd 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. * 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. diff --git a/tests/testthat/test-ppc-errors.R b/tests/testthat/test-ppc-errors.R index de4322aa..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 ----------------------------------------------------------------- diff --git a/tests/testthat/test-ppc-loo.R b/tests/testthat/test-ppc-loo.R index 83cdaf50..a722ad46 100644 --- a/tests/testthat/test-ppc-loo.R +++ b/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)) +})