consolidate new tests

Author: jgabry

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 -----------------------------------------------------------------
@@ -422,54 +513,3 @@ test_that("ppc_pit_ecdf, ppc_pit_ecdf_grouped renders correctly", {
   vdiffr::expect_doppelganger("ppc_pit_ecdf (diff)", p_diff)
   vdiffr::expect_doppelganger("ppc_pit_ecdf_grouped (diff)", g_diff)
 })
-
-
-# ppc_data / ppd_data tests -----------------------------------------------
-
-test_that("ppc_data returns correct structure", {
-  d <- ppc_data(y, yrep)
-  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_data includes y and yrep rows", {
-  d <- ppc_data(y, yrep)
-  y_rows <- d[d$is_y, ]
-  yrep_rows <- d[!d$is_y, ]
-  expect_equal(nrow(y_rows), length(y))
-  expect_equal(nrow(yrep_rows), length(y) * nrow(yrep))
-  expect_equal(y_rows$value, y)
-})
-
-test_that("ppc_data with group adds group column", {
-  d <- ppc_data(y, yrep, group = group)
-  expect_true("group" %in% names(d))
-  expect_equal(nlevels(factor(d$group)), nlevels(group))
-})
-
-test_that("ppc_data works with single replicate", {
-  d <- ppc_data(y, yrep[1, , drop = FALSE])
-  yrep_rows <- d[!d$is_y, ]
-  expect_equal(nrow(yrep_rows), length(y))
-})
-
-test_that("ppd_data returns correct structure", {
-  d <- ppd_data(yrep)
-  expect_s3_class(d, "data.frame")
-  expect_true(all(c("y_id", "rep_id", "rep_label", "value") %in% names(d)))
-})
-
-test_that("ppd_data returns correct number of rows", {
-  d <- ppd_data(yrep)
-  expect_equal(nrow(d), nrow(yrep) * ncol(yrep))
-})
-
-test_that("ppd_data with group adds group column", {
-  d <- ppd_data(yrep, group = group)
-  expect_true("group" %in% names(d))
-})
-
-test_that("ppd_data works with single replicate", {
-  d <- ppd_data(yrep[1, , drop = FALSE])
-  expect_equal(nrow(d), ncol(yrep))
-})

tests/testthat/test-ppc-intervals.R

@@ -224,23 +224,3 @@ test_that("ppc_ribbon_grouped renders correctly", {
     group = vdiff_group)
   vdiffr::expect_doppelganger("ppd_ribbon_grouped (x values)", p_x)
 })
-
-
-# ppc_ribbon_data / ppd_ribbon_data alias tests ----------------------------
-
-test_that("ppc_ribbon_data is identical to ppc_intervals_data", {
-  expect_identical(ppc_ribbon_data, ppc_intervals_data)
-  y_test <- rnorm(20)
-  yrep_test <- matrix(rnorm(200), ncol = 20)
-  d1 <- ppc_intervals_data(y_test, yrep_test, prob = 0.5, prob_outer = 0.9)
-  d2 <- ppc_ribbon_data(y_test, yrep_test, prob = 0.5, prob_outer = 0.9)
-  expect_identical(d1, d2)
-})
-
-test_that("ppd_ribbon_data is identical to ppd_intervals_data", {
-  expect_identical(ppd_ribbon_data, ppd_intervals_data)
-  yrep_test <- matrix(rnorm(200), ncol = 20)
-  d1 <- ppd_intervals_data(yrep_test, prob = 0.5, prob_outer = 0.9)
-  d2 <- ppd_ribbon_data(yrep_test, prob = 0.5, prob_outer = 0.9)
-  expect_identical(d1, d2)
-})