From 92aaf2c22610aa2cc50d123063b019a9797e18fa Mon Sep 17 00:00:00 2001 From: Utkarsh Date: Wed, 25 Mar 2026 06:21:40 +0530 Subject: [PATCH 1/3] Add test coverage for mcmc_areas_ridges_data, mcmc_parcoord_data, mcmc_trace_data --- tests/testthat/test-mcmc-intervals.R | 27 +++++++++ .../testthat/test-mcmc-scatter-and-parcoord.R | 31 ++++++++++ tests/testthat/test-mcmc-traces.R | 57 +++++++++++++++++++ 3 files changed, 115 insertions(+) diff --git a/tests/testthat/test-mcmc-intervals.R b/tests/testthat/test-mcmc-intervals.R index 882109bd..dd45573e 100644 --- a/tests/testthat/test-mcmc-intervals.R +++ b/tests/testthat/test-mcmc-intervals.R @@ -255,3 +255,30 @@ test_that("mcmc_areas_ridges renders correctly", { p_size <- mcmc_areas_ridges(vdiff_dframe, border_size = 2) vdiffr::expect_doppelganger("mcmc_areas_ridges (size)", p_size) }) + + +# mcmc_areas_ridges_data tests --------------------------------------------- + +test_that("mcmc_areas_ridges_data returns correct structure", { + d <- mcmc_areas_ridges_data(arr, pars = "beta[1]") + expect_s3_class(d, "data.frame") + expect_true(all(c("parameter", "x", "density", "interval") %in% names(d))) +}) + +test_that("mcmc_areas_ridges_data delegates to mcmc_areas_data with point_est='none'", { + d_ridges <- mcmc_areas_ridges_data(arr, pars = "beta[1]", prob = 0.5, prob_outer = 0.9) + d_areas <- mcmc_areas_data(arr, pars = "beta[1]", prob = 0.5, prob_outer = 0.9, + point_est = "none") + expect_equal(d_ridges, d_areas) +}) + +test_that("mcmc_areas_ridges_data works with multiple parameters", { + d <- mcmc_areas_ridges_data(arr, regex_pars = "beta") + params <- unique(d$parameter) + expect_true(length(params) >= 2) +}) + +test_that("mcmc_areas_ridges_data works with single parameter", { + d <- mcmc_areas_ridges_data(arr, pars = "sigma") + expect_equal(length(unique(d$parameter)), 1) +}) diff --git a/tests/testthat/test-mcmc-scatter-and-parcoord.R b/tests/testthat/test-mcmc-scatter-and-parcoord.R index ddae73cc..dde7429e 100644 --- a/tests/testthat/test-mcmc-scatter-and-parcoord.R +++ b/tests/testthat/test-mcmc-scatter-and-parcoord.R @@ -475,3 +475,34 @@ test_that("mcmc_pairs renders correctly", { ) vdiffr::expect_doppelganger("mcmc_pairs (divs, td)", p_divs_treedepth_divergences) }) + + +# mcmc_parcoord_data tests ------------------------------------------------- + +test_that("mcmc_parcoord_data returns correct structure", { + d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma")) + expect_s3_class(d, "data.frame") + expect_named(d, c("Draw", "Parameter", "Value", "Divergent")) +}) + +test_that("mcmc_parcoord_data sets Divergent to 0 when np is NULL", { + d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma")) + expect_true(all(d$Divergent == 0)) +}) + +test_that("mcmc_parcoord_data works with np argument", { + skip_if_not_installed("rstanarm") + d <- mcmc_parcoord_data(post, pars = c("wt", "am", "sigma"), np = np) + expect_named(d, c("Draw", "Parameter", "Value", "Divergent")) + expect_true(all(d$Divergent %in% c(0, 1))) +}) + +test_that("mcmc_parcoord_data errors with fewer than 2 parameters", { + expect_error(mcmc_parcoord_data(arr, pars = "sigma"), "at least two") +}) + +test_that("mcmc_parcoord_data works with regex_pars", { + d <- mcmc_parcoord_data(arr, regex_pars = "beta") + params <- unique(d$Parameter) + expect_true(length(params) >= 2) +}) diff --git a/tests/testthat/test-mcmc-traces.R b/tests/testthat/test-mcmc-traces.R index 7d02b4ee..ef7a889d 100644 --- a/tests/testthat/test-mcmc-traces.R +++ b/tests/testthat/test-mcmc-traces.R @@ -278,3 +278,60 @@ test_that("mcmc_trace with 'np' renders correctly", { vdiffr::expect_doppelganger("mcmc_trace divergences (default)", p_base) vdiffr::expect_doppelganger("mcmc_trace divergences (custom)", p_np_style) }) + + +# mcmc_trace_data tests ---------------------------------------------------- + +test_that("mcmc_trace_data returns correct structure", { + d <- mcmc_trace_data(arr, pars = "beta[1]") + expect_s3_class(d, "tbl_df") + expect_true(all(c("parameter", "value", "value_rank", "chain", + "iteration", "highlight", "warmup") %in% names(d))) +}) + +test_that("mcmc_trace_data returns correct dimensions", { + d <- mcmc_trace_data(arr, pars = "beta[1]") + n_iters <- dim(arr)[1] + n_chains <- dim(arr)[2] + expect_equal(nrow(d), n_iters * n_chains) + expect_equal(length(unique(d$chain)), n_chains) +}) + +test_that("mcmc_trace_data highlight argument works", { + d <- mcmc_trace_data(arr, pars = "beta[1]", highlight = 2) + expect_true(all(d$highlight[d$chain == 2])) + expect_true(all(!d$highlight[d$chain != 2])) +}) + +test_that("mcmc_trace_data warmup labeling works", { + d <- mcmc_trace_data(arr, pars = "beta[1]", n_warmup = 20) + expect_true(all(d$warmup[d$iteration <= 20])) + expect_true(all(!d$warmup[d$iteration > 20])) +}) + +test_that("mcmc_trace_data iter1 shifts iterations", { + d <- mcmc_trace_data(arr, pars = "beta[1]", iter1 = 100) + expect_true(min(d$iteration) == 101) +}) + +test_that("mcmc_trace_data errors on negative iter1", { + expect_error(mcmc_trace_data(arr, pars = "beta[1]", iter1 = -1), "iter1") +}) + +test_that("mcmc_trace_data errors if both n_warmup and iter1 specified", { + expect_error( + mcmc_trace_data(arr, pars = "beta[1]", n_warmup = 10, iter1 = 5), + "n_warmup.*iter1" + ) +}) + +test_that("mcmc_trace_data works with multiple parameters", { + d <- mcmc_trace_data(arr, regex_pars = "beta") + expect_true(length(unique(d$parameter)) >= 2) +}) + +test_that("mcmc_trace_data value_rank is computed correctly", { + d <- mcmc_trace_data(arr, pars = "beta[1]") + # value_rank should be ranks within each parameter group + expect_equal(sort(unique(d$value_rank)), sort(unique(rank(d$value, ties.method = "average")))) +}) From 90c8d5b08044cc0f37a4ed6f083a6c852fa0130a Mon Sep 17 00:00:00 2001 From: Utkarsh Date: Wed, 25 Mar 2026 20:26:57 +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..3341b582 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # bayesplot (development version) +* Added unit tests for `mcmc_areas_ridges_data()`, `mcmc_parcoord_data()`, and `mcmc_trace_data()`. * 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 c5c07e5018a1702146c912b8fd803a5dc0972ecc Mon Sep 17 00:00:00 2001 From: jgabry Date: Thu, 26 Mar 2026 14:58:26 -0400 Subject: [PATCH 3/3] Clean up new tests --- tests/testthat/test-mcmc-intervals.R | 121 ++++++++---------- .../testthat/test-mcmc-scatter-and-parcoord.R | 69 +++++----- tests/testthat/test-mcmc-traces.R | 94 ++++++-------- 3 files changed, 128 insertions(+), 156 deletions(-) diff --git a/tests/testthat/test-mcmc-intervals.R b/tests/testthat/test-mcmc-intervals.R index dd45573e..9e52f6f1 100644 --- a/tests/testthat/test-mcmc-intervals.R +++ b/tests/testthat/test-mcmc-intervals.R @@ -1,42 +1,5 @@ source(test_path("data-for-mcmc-tests.R")) -test_that("mcmc_intervals_data computes quantiles", { - xs <- melt_mcmc(merge_chains(prepare_mcmc_array(arr, pars = "beta[1]"))) - d <- mcmc_intervals_data(arr, pars = "beta[1]", - prob = .3, prob_outer = .5) - - qs <- unlist(d[, c("ll", "l", "m", "h", "hh")]) - by_hand <- quantile(xs$Value, c(.25, .35, .5, .65, .75)) - expect_equal(qs, by_hand, ignore_attr = TRUE) - - expect_equal(d$parameter, factor("beta[1]")) - expect_equal(d$outer_width, .5) - expect_equal(d$inner_width, .3) - expect_equal(d$point_est, "median") - - d2 <- mcmc_areas_data(arr, pars = "beta[1]", prob = .3, prob_outer = .5) - sets <- split(d2, d2$interval) - - expect_equal(range(sets$inner$x), c(d$l, d$h)) - expect_equal(range(sets$outer$x), c(d$ll, d$hh)) -}) - -test_that("mcmc_intervals_data computes point estimates", { - xs <- melt_mcmc(merge_chains(prepare_mcmc_array(arr, pars = "beta[2]"))) - d <- mcmc_intervals_data(arr, pars = "beta[2]", - prob = .3, prob_outer = .5, point_est = "mean") - - expect_equal(d$m, mean(xs$Value), ignore_attr = TRUE) - expect_equal(d$parameter, factor("beta[2]")) - expect_equal(d$point_est, "mean") - - d <- mcmc_intervals_data(arr, pars = "(Intercept)", - prob = .3, prob_outer = .5, - point_est = "none") - expect_true(!("m" %in% names(d))) - expect_equal(d$point_est, "none") -}) - test_that("mcmc_intervals returns a ggplot object", { expect_gg(mcmc_intervals(arr, pars = "beta[1]", regex_pars = "x\\:")) expect_gg(mcmc_intervals(arr1chain, pars = "beta[1]", regex_pars = "Intercept")) @@ -115,6 +78,45 @@ test_that("mcmc_intervals/areas with rhat", { } }) +# _data() tests ---------------------------------------------------------------- + +test_that("mcmc_intervals_data computes quantiles", { + xs <- melt_mcmc(merge_chains(prepare_mcmc_array(arr, pars = "beta[1]"))) + d <- mcmc_intervals_data(arr, pars = "beta[1]", + prob = .3, prob_outer = .5) + + qs <- unlist(d[, c("ll", "l", "m", "h", "hh")]) + by_hand <- quantile(xs$Value, c(.25, .35, .5, .65, .75)) + expect_equal(qs, by_hand, ignore_attr = TRUE) + + expect_equal(d$parameter, factor("beta[1]")) + expect_equal(d$outer_width, .5) + expect_equal(d$inner_width, .3) + expect_equal(d$point_est, "median") + + d2 <- mcmc_areas_data(arr, pars = "beta[1]", prob = .3, prob_outer = .5) + sets <- split(d2, d2$interval) + + expect_equal(range(sets$inner$x), c(d$l, d$h)) + expect_equal(range(sets$outer$x), c(d$ll, d$hh)) +}) + +test_that("mcmc_intervals_data computes point estimates", { + xs <- melt_mcmc(merge_chains(prepare_mcmc_array(arr, pars = "beta[2]"))) + d <- mcmc_intervals_data(arr, pars = "beta[2]", + prob = .3, prob_outer = .5, point_est = "mean") + + expect_equal(d$m, mean(xs$Value), ignore_attr = TRUE) + expect_equal(d$parameter, factor("beta[2]")) + expect_equal(d$point_est, "mean") + + d <- mcmc_intervals_data(arr, pars = "(Intercept)", + prob = .3, prob_outer = .5, + point_est = "none") + expect_true(!("m" %in% names(d))) + expect_equal(d$point_est, "none") +}) + test_that("mcmc_areas_data computes density", { areas_data <- mcmc_areas_data(arr, point_est = "none") areas_data <- areas_data[areas_data$interval_width == 1, ] @@ -153,7 +155,7 @@ test_that("compute_column_density can use density options (#118)", { expect_error(mcmc_areas_data(arr, kernel = stop())) }) -test_that("probabilities outside of [0,1] cause an error", { +test_that("mcmc_intervals_data errors for probabilities outside of [0,1]", { expect_error(mcmc_intervals_data(arr, prob = -0.1), "must be in \\[0,1\\]") expect_error(mcmc_intervals_data(arr, prob = 1.1), @@ -164,7 +166,7 @@ test_that("probabilities outside of [0,1] cause an error", { "must be in \\[0,1\\]") }) -test_that("inconsistent probabilities raise warning (#138)", { +test_that("mcmc_intervals_data warns for inconsistent probabilities (#138)", { expect_warning( mcmc_intervals_data(arr, prob = .9, prob_outer = .8), "`prob_outer` .* is less than `prob`" @@ -172,6 +174,20 @@ test_that("inconsistent probabilities raise warning (#138)", { }) +test_that("mcmc_areas_ridges_data returns correct structure", { + d <- mcmc_areas_ridges_data(arr, pars = c("beta[1]", "sigma"), prob = 0.5, prob_outer = 0.9) + expect_s3_class(d, "data.frame") + expect_named( + d, + c( + "parameter", "interval", "interval_width", "x", "density", + "scaled_density", "plotting_density" + ) + ) + expect_setequal(unique(d$interval), c("inner", "outer")) + expect_false("point" %in% d$interval) + expect_equal(unique(as.character(d$parameter)), c("beta[1]", "sigma")) +}) # Visual tests ----------------------------------------------------------------- @@ -255,30 +271,3 @@ test_that("mcmc_areas_ridges renders correctly", { p_size <- mcmc_areas_ridges(vdiff_dframe, border_size = 2) vdiffr::expect_doppelganger("mcmc_areas_ridges (size)", p_size) }) - - -# mcmc_areas_ridges_data tests --------------------------------------------- - -test_that("mcmc_areas_ridges_data returns correct structure", { - d <- mcmc_areas_ridges_data(arr, pars = "beta[1]") - expect_s3_class(d, "data.frame") - expect_true(all(c("parameter", "x", "density", "interval") %in% names(d))) -}) - -test_that("mcmc_areas_ridges_data delegates to mcmc_areas_data with point_est='none'", { - d_ridges <- mcmc_areas_ridges_data(arr, pars = "beta[1]", prob = 0.5, prob_outer = 0.9) - d_areas <- mcmc_areas_data(arr, pars = "beta[1]", prob = 0.5, prob_outer = 0.9, - point_est = "none") - expect_equal(d_ridges, d_areas) -}) - -test_that("mcmc_areas_ridges_data works with multiple parameters", { - d <- mcmc_areas_ridges_data(arr, regex_pars = "beta") - params <- unique(d$parameter) - expect_true(length(params) >= 2) -}) - -test_that("mcmc_areas_ridges_data works with single parameter", { - d <- mcmc_areas_ridges_data(arr, pars = "sigma") - expect_equal(length(unique(d$parameter)), 1) -}) diff --git a/tests/testthat/test-mcmc-scatter-and-parcoord.R b/tests/testthat/test-mcmc-scatter-and-parcoord.R index dde7429e..1cc70889 100644 --- a/tests/testthat/test-mcmc-scatter-and-parcoord.R +++ b/tests/testthat/test-mcmc-scatter-and-parcoord.R @@ -313,7 +313,6 @@ test_that("pairs_condition message if multiple args specified", { }) - # mcmc_parcoord ----------------------------------------------------------- test_that("mcmc_parcoord returns a ggplot object", { expect_gg(mcmc_parcoord(arr, pars = c("(Intercept)", "sigma"))) @@ -351,7 +350,6 @@ test_that("mcmc_parcoord throws correct warnings and errors", { ) }) - # parcoord_style_np ------------------------------------------------------- test_that("parcoord_style_np returns correct structure", { style <- parcoord_style_np() @@ -375,6 +373,42 @@ test_that("parcoord_style_np throws correct errors", { ) }) +# mcmc_parcoord_data ------------------------------------------------- + +test_that("mcmc_parcoord_data returns expected structure", { + d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma")) + expect_s3_class(d, "data.frame") + expect_named(d, c("Draw", "Parameter", "Value", "Divergent")) + + draws_by_parameter <- split(d$Draw, d$Parameter) + expected_draws <- seq_len(dim(arr)[1] * dim(arr)[2]) + expect_equal(draws_by_parameter[[1]], expected_draws) + expect_equal(draws_by_parameter[[2]], expected_draws) +}) + +test_that("mcmc_parcoord_data sets Divergent to 0 when np is NULL", { + d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma")) + expect_true(all(d$Divergent == 0)) +}) + +test_that("mcmc_parcoord_data joins divergence information from np", { + fake_np <- data.frame( + Iteration = rep(seq_len(dim(arr)[1]), each = dim(arr)[2]), + Chain = rep(seq_len(dim(arr)[2]), times = dim(arr)[1]), + Parameter = factor("divergent__"), + Value = as.integer(rep(c(0, 1, 0, 1), times = dim(arr)[1])) + ) + d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma"), np = fake_np) + + expect_false(anyNA(d$Divergent)) + expect_equal(sum(d$Divergent == 1), 400) + expect_equal(sum(d$Divergent == 0), 400) +}) + +test_that("mcmc_parcoord_data errors with fewer than 2 parameters", { + expect_error(mcmc_parcoord_data(arr, pars = "sigma"), "at least two") +}) + # Visual tests ----------------------------------------------------------------- @@ -475,34 +509,3 @@ test_that("mcmc_pairs renders correctly", { ) vdiffr::expect_doppelganger("mcmc_pairs (divs, td)", p_divs_treedepth_divergences) }) - - -# mcmc_parcoord_data tests ------------------------------------------------- - -test_that("mcmc_parcoord_data returns correct structure", { - d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma")) - expect_s3_class(d, "data.frame") - expect_named(d, c("Draw", "Parameter", "Value", "Divergent")) -}) - -test_that("mcmc_parcoord_data sets Divergent to 0 when np is NULL", { - d <- mcmc_parcoord_data(arr, pars = c("(Intercept)", "sigma")) - expect_true(all(d$Divergent == 0)) -}) - -test_that("mcmc_parcoord_data works with np argument", { - skip_if_not_installed("rstanarm") - d <- mcmc_parcoord_data(post, pars = c("wt", "am", "sigma"), np = np) - expect_named(d, c("Draw", "Parameter", "Value", "Divergent")) - expect_true(all(d$Divergent %in% c(0, 1))) -}) - -test_that("mcmc_parcoord_data errors with fewer than 2 parameters", { - expect_error(mcmc_parcoord_data(arr, pars = "sigma"), "at least two") -}) - -test_that("mcmc_parcoord_data works with regex_pars", { - d <- mcmc_parcoord_data(arr, regex_pars = "beta") - params <- unique(d$Parameter) - expect_true(length(params) >= 2) -}) diff --git a/tests/testthat/test-mcmc-traces.R b/tests/testthat/test-mcmc-traces.R index ef7a889d..113e1ef8 100644 --- a/tests/testthat/test-mcmc-traces.R +++ b/tests/testthat/test-mcmc-traces.R @@ -100,7 +100,44 @@ test_that("mcmc_trace 'np' argument works", { "No divergences to plot.") }) +# mcmc_trace_data ---------------------------------------------------- +test_that("mcmc_trace_data returns plotting data with expected columns", { + d <- mcmc_trace_data(arr, pars = "beta[1]") + expect_s3_class(d, "tbl_df") + expect_named( + d, + c( + "parameter", "value", "value_rank", "iteration", "chain", + "n_chains", "n_iterations", "n_parameters", "highlight", "warmup" + ) + ) + expect_equal(nrow(d), dim(arr)[1] * dim(arr)[2]) +}) + +test_that("mcmc_trace_data highlight argument works", { + d <- mcmc_trace_data(arr, pars = "beta[1]", highlight = 2) + expect_true(all(d$highlight[d$chain == 2])) + expect_true(all(!d$highlight[d$chain != 2])) +}) + +test_that("mcmc_trace_data warmup labeling works", { + d <- mcmc_trace_data(arr, pars = "beta[1]", n_warmup = 20) + expect_true(all(d$warmup[d$iteration <= 20])) + expect_true(all(!d$warmup[d$iteration > 20])) +}) + +test_that("mcmc_trace_data iter1 shifts iterations", { + d <- mcmc_trace_data(arr, pars = "beta[1]", iter1 = 100) + expect_true(min(d$iteration) == 101) +}) + +test_that("mcmc_trace_data computes value_rank within each parameter", { + d <- mcmc_trace_data(arr, pars = c("beta[1]", "beta[2]")) + observed_ranks <- split(d$value_rank, d$parameter) + expected_ranks <- lapply(split(d$value, d$parameter), rank, ties.method = "average") + expect_equal(observed_ranks, expected_ranks) +}) # Visual tests ----------------------------------------------------------------- @@ -278,60 +315,3 @@ test_that("mcmc_trace with 'np' renders correctly", { vdiffr::expect_doppelganger("mcmc_trace divergences (default)", p_base) vdiffr::expect_doppelganger("mcmc_trace divergences (custom)", p_np_style) }) - - -# mcmc_trace_data tests ---------------------------------------------------- - -test_that("mcmc_trace_data returns correct structure", { - d <- mcmc_trace_data(arr, pars = "beta[1]") - expect_s3_class(d, "tbl_df") - expect_true(all(c("parameter", "value", "value_rank", "chain", - "iteration", "highlight", "warmup") %in% names(d))) -}) - -test_that("mcmc_trace_data returns correct dimensions", { - d <- mcmc_trace_data(arr, pars = "beta[1]") - n_iters <- dim(arr)[1] - n_chains <- dim(arr)[2] - expect_equal(nrow(d), n_iters * n_chains) - expect_equal(length(unique(d$chain)), n_chains) -}) - -test_that("mcmc_trace_data highlight argument works", { - d <- mcmc_trace_data(arr, pars = "beta[1]", highlight = 2) - expect_true(all(d$highlight[d$chain == 2])) - expect_true(all(!d$highlight[d$chain != 2])) -}) - -test_that("mcmc_trace_data warmup labeling works", { - d <- mcmc_trace_data(arr, pars = "beta[1]", n_warmup = 20) - expect_true(all(d$warmup[d$iteration <= 20])) - expect_true(all(!d$warmup[d$iteration > 20])) -}) - -test_that("mcmc_trace_data iter1 shifts iterations", { - d <- mcmc_trace_data(arr, pars = "beta[1]", iter1 = 100) - expect_true(min(d$iteration) == 101) -}) - -test_that("mcmc_trace_data errors on negative iter1", { - expect_error(mcmc_trace_data(arr, pars = "beta[1]", iter1 = -1), "iter1") -}) - -test_that("mcmc_trace_data errors if both n_warmup and iter1 specified", { - expect_error( - mcmc_trace_data(arr, pars = "beta[1]", n_warmup = 10, iter1 = 5), - "n_warmup.*iter1" - ) -}) - -test_that("mcmc_trace_data works with multiple parameters", { - d <- mcmc_trace_data(arr, regex_pars = "beta") - expect_true(length(unique(d$parameter)) >= 2) -}) - -test_that("mcmc_trace_data value_rank is computed correctly", { - d <- mcmc_trace_data(arr, pars = "beta[1]") - # value_rank should be ranks within each parameter group - expect_equal(sort(unique(d$value_rank)), sort(unique(rank(d$value, ties.method = "average")))) -})