diff --git a/NEWS.md b/NEWS.md index 8417bae5..e7fc9138 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,7 +20,7 @@ * Default to `quantiles=100` for all dot plots by @behramulukir (#402) * Use `"neff_ratio"` consistently in diagnostic color scale helpers to avoid relying on partial matching of `"neff"`. * Replace `expand = c(mult, add)` with `ggplot2::expansion()` helper in scale functions for consistency with ggplot2 >= 3.3.0 style. -* Replace uses of `geom_bar(stat = "identity")` with the more idiomatic ggplot2 form `geom_col()` +* Replace uses of `geom_bar(stat = "identity")` with the more idiomatic ggplot2 form `geom_col()` * New function `ppc_rootogram_grouped` for grouped rootogram plots by @behramulukir and @jgabry (#419) # bayesplot 1.15.0 @@ -37,7 +37,7 @@ # bayesplot 1.14.0 -* PPC "avg" functions (`ppc_scatter_avg()`, `ppc_error_scatter_avg()`, etc.) gain a `stat` argument +* PPC "avg" functions (`ppc_scatter_avg()`, `ppc_error_scatter_avg()`, etc.) gain a `stat` argument to set the averaging function. (Suggestion of #348, @kruschke). * `ppc_error_scatter_avg_vs_x(x = some_expression)` labels the x axis with `some_expression`. * New quantile dot plot functions `ppc_dots()` and `ppd_dots()` by @behramulukir (#357) @@ -59,7 +59,7 @@ * Expand checking workflows to more platforms by @andrjohns (#324) * Skip tests depending on Suggested dependency rstantools if not installed by @MichaelChirico (#325) -* Skip tests depending on Suggested dependency gridExtra if not installed by @MichaelChirico (#326) +* Skip tests depending on Suggested dependency gridExtra if not installed by @MichaelChirico (#326) * Fix missing legends for unobserved levels in rhat and neff plots (#328) * Document problems with `ppc_stat` with `stat="mean"` (#329) * Ensure rank overlay plot starts at 0 even if not all bins present, thanks @sims1253 (#332) diff --git a/tests/testthat/test-ppc-distributions.R b/tests/testthat/test-ppc-distributions.R index 93b52e0a..34e1c82f 100644 --- a/tests/testthat/test-ppc-distributions.R +++ b/tests/testthat/test-ppc-distributions.R @@ -129,6 +129,97 @@ test_that("ppc_violin_grouped returns a ggplot object", { expect_gg(ppc_violin_grouped(y, yrep, group, y_draw = "both", y_jitter = 0.3)) }) +# ppc_data / ppd_data tests ----------------------------------------------- + +test_that("ppc_data returns the correct structure", { + y_small <- c(10, 20) + yrep_small <- rbind(c(11, 21), c(12, 22)) + + d <- ppc_data(y_small, yrep_small) + + expect_s3_class(d, "data.frame") + expect_named(d, c("y_id", "y_name", "rep_id", "rep_label", + "is_y", "is_y_label", "value")) + expect_equal(nrow(d), length(y_small) * (nrow(yrep_small) + 1)) + expect_equal(d$y_id, c(1L, 1L, 2L, 2L, 1L, 2L)) + expect_equal(as.character(d$y_name), c("1", "1", "2", "2", "1", "2")) + expect_equal(d$rep_id, c(1L, 2L, 1L, 2L, NA, NA)) + expect_equal(d$is_y, c(FALSE, FALSE, FALSE, FALSE, TRUE, TRUE)) + expect_equal(d$value, c(11, 12, 21, 22, 10, 20)) + expect_equal(d$value[d$is_y], y_small) + + first_level <- levels(d$rep_label)[1] + expect_true(all(as.character(d$rep_label[d$is_y]) == first_level)) + expect_true(all(as.character(d$rep_label[!d$is_y]) != first_level)) +}) + +test_that("ppc_data carries group through correctly", { + y_small <- c(10, 20) + yrep_small <- rbind(c(11, 21), c(12, 22)) + group_small <- factor(c("a", "b")) + + d <- ppc_data(y_small, yrep_small, group = group_small) + + expect_named(d, c("group", "y_id", "y_name", "rep_id", "rep_label", + "is_y", "is_y_label", "value")) + expect_equal(as.character(d$group), c("a", "a", "b", "b", "a", "b")) + expect_equal(as.character(d$group[d$is_y]), as.character(group_small)) +}) + +test_that("ppc_data handles a single replicate matrix", { + y_small <- c(10, 20) + yrep_small <- matrix(c(11, 21), nrow = 1) + + d <- ppc_data(y_small, yrep_small) + + expect_equal(sum(!d$is_y), length(y_small)) + expect_equal(d$rep_id[!d$is_y], c(1L, 1L)) + expect_equal(d$value[!d$is_y], c(11, 21)) +}) + +test_that("ppd_data returns the correct structure", { + yrep_small <- rbind(c(11, 21), c(12, 22)) + + d <- ppd_data(yrep_small) + + expect_s3_class(d, "data.frame") + expect_named(d, c("y_id", "y_name", "rep_id", "rep_label", "value")) + expect_equal(nrow(d), nrow(yrep_small) * ncol(yrep_small)) + expect_equal(d$y_id, c(1L, 1L, 2L, 2L)) + expect_equal(as.character(d$y_name), c("1", "1", "2", "2")) + expect_equal(d$rep_id, c(1L, 2L, 1L, 2L)) + expect_equal(d$value, c(11, 12, 21, 22)) + expect_true(all(grepl("pred", levels(d$rep_label), fixed = TRUE))) +}) + +test_that("ppd_data carries group through correctly", { + yrep_small <- rbind(c(11, 21), c(12, 22)) + group_small <- factor(c("a", "b")) + + d <- ppd_data(yrep_small, group = group_small) + + expect_named(d, c("group", "y_id", "y_name", "rep_id", "rep_label", "value")) + expect_equal(as.character(d$group), c("a", "a", "b", "b")) +}) + +test_that("ppd_data carries observation names through to y_name", { + yrep_named <- rbind(c(11, 21), c(12, 22)) + colnames(yrep_named) <- c("obs_a", "obs_b") + + d <- ppd_data(yrep_named) + + expect_equal(as.character(d$y_name), c("obs_a", "obs_a", "obs_b", "obs_b")) +}) + +test_that("ppd_data handles a single replicate matrix", { + yrep_small <- matrix(c(11, 21), nrow = 1) + + d <- ppd_data(yrep_small) + + expect_equal(nrow(d), ncol(yrep_small)) + expect_equal(d$rep_id, c(1L, 1L)) + expect_equal(d$value, c(11, 21)) +}) # Visual tests -----------------------------------------------------------------