diff --git a/DESCRIPTION b/DESCRIPTION index 9e2341e..ee3eabb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,9 @@ Imports: tibble, tidyr Suggests: - testthat (>= 3.0.0) + rlang, + testthat (>= 3.0.0), + vdiffr Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/tests/testthat/_snaps/causalpie/causal-pie-grid-theme.svg b/tests/testthat/_snaps/causalpie/causal-pie-grid-theme.svg new file mode 100644 index 0000000..aa6bf77 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-grid-theme.svg @@ -0,0 +1,134 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +E = 1 +C = 0 +U2 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + +component + + + + + + +A +B +C +E +U1 +U2 +causal-pie-grid-theme + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-many-components.svg b/tests/testthat/_snaps/causalpie/causal-pie-many-components.svg new file mode 100644 index 0000000..e4fe587 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-many-components.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +C = 1 +D = 0 +E = 1 +U1 + + +component + + + + + + +A +B +C +D +E +U1 +causal-pie-many-components + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-multi.svg b/tests/testthat/_snaps/causalpie/causal-pie-multi.svg new file mode 100644 index 0000000..fc706e7 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-multi.svg @@ -0,0 +1,98 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + + + + + + + + + + + + +A = 1 +E = 1 +C = 0 +U2 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + +component + + + + + + +A +B +C +E +U1 +U2 +causal-pie-multi + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-necessary-grid-theme.svg b/tests/testthat/_snaps/causalpie/causal-pie-necessary-grid-theme.svg new file mode 100644 index 0000000..01f267d --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-necessary-grid-theme.svg @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +E = 1 +C = 0 +U2 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + +necessary + + +FALSE +TRUE +causal-pie-necessary-grid-theme + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-necessary-no-u.svg b/tests/testthat/_snaps/causalpie/causal-pie-necessary-no-u.svg new file mode 100644 index 0000000..1cf5dcb --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-necessary-no-u.svg @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 + + + + + + + + + + + +A = 1 +E = 1 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + +necessary + + +FALSE +TRUE +causal-pie-necessary-no-u + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-necessary-single.svg b/tests/testthat/_snaps/causalpie/causal-pie-necessary-single.svg new file mode 100644 index 0000000..b2dd8b2 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-necessary-single.svg @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + +necessary + +TRUE +causal-pie-necessary-single + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-necessary-text-col.svg b/tests/testthat/_snaps/causalpie/causal-pie-necessary-text-col.svg new file mode 100644 index 0000000..8a64f96 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-necessary-text-col.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + + + + + + + + + + + + +A = 1 +E = 1 +C = 0 +U2 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + +necessary + + +FALSE +TRUE +causal-pie-necessary-text-col + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-necessary.svg b/tests/testthat/_snaps/causalpie/causal-pie-necessary.svg new file mode 100644 index 0000000..260c986 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-necessary.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + + + + + + + + + + + + +A = 1 +E = 1 +C = 0 +U2 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + +necessary + + +FALSE +TRUE +causal-pie-necessary + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-no-u.svg b/tests/testthat/_snaps/causalpie/causal-pie-no-u.svg new file mode 100644 index 0000000..d8cd7b2 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-no-u.svg @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 + + +component + + +A +B +causal-pie-no-u + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-single.svg b/tests/testthat/_snaps/causalpie/causal-pie-single.svg new file mode 100644 index 0000000..ee836df --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-single.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + +component + + + +A +B +U1 +causal-pie-single + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-text-col.svg b/tests/testthat/_snaps/causalpie/causal-pie-text-col.svg new file mode 100644 index 0000000..7fc2657 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-text-col.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + +component + + + +A +B +U1 +causal-pie-text-col + + diff --git a/tests/testthat/_snaps/causalpie/causal-pie-three-causes.svg b/tests/testthat/_snaps/causalpie/causal-pie-three-causes.svg new file mode 100644 index 0000000..a0f4f94 --- /dev/null +++ b/tests/testthat/_snaps/causalpie/causal-pie-three-causes.svg @@ -0,0 +1,125 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A = 1 +B = 0 +U1 + + + + + + + + + + + + + +A = 1 +E = 1 +C = 0 +U2 + + + + + + + + + + + + +B = 1 +E = 1 +U3 + + + + + + + + + +Sufficient Cause 1 + + + + + + + + + +Sufficient Cause 2 + + + + + + + + + +Sufficient Cause 3 + + +component + + + + + + + +A +B +C +E +U1 +U2 +U3 +causal-pie-three-causes + + diff --git a/tests/testthat/helper-vdiffr.R b/tests/testthat/helper-vdiffr.R new file mode 100644 index 0000000..380557e --- /dev/null +++ b/tests/testthat/helper-vdiffr.R @@ -0,0 +1,5 @@ +expect_doppelganger <- function(title, fig, ...) { + testthat::skip_if_not_installed("vdiffr") + testthat::skip_on_cran() + vdiffr::expect_doppelganger(title, fig, ...) +} diff --git a/tests/testthat/test-causalpie.R b/tests/testthat/test-causalpie.R new file mode 100644 index 0000000..05b7e8f --- /dev/null +++ b/tests/testthat/test-causalpie.R @@ -0,0 +1,176 @@ +# ---- causal_pie() structural tests ---- + +test_that("causal_pie() returns a ggplot for a single cause", { + causes <- causify(sc(A = 1, B = 0)) + p <- causal_pie(causes) + expect_s3_class(p, "ggplot") + # Single cause should not be faceted + expect_false(inherits(p$facet, "FacetWrap")) +}) + +test_that("causal_pie() facets when multiple causes exist", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1)) + p <- causal_pie(causes) + expect_s3_class(p, "ggplot") + expect_true(inherits(p$facet, "FacetWrap")) +}) + +test_that("causal_pie() uses text_col argument", { + causes <- causify(sc(A = 1, B = 0)) + p <- causal_pie(causes, text_col = "red") + text_layer <- p$layers[[2]] + expect_equal(text_layer$aes_params$colour, "red") +}) + +# ---- causal_pie_necessary() structural tests ---- + +test_that("causal_pie_necessary() returns a ggplot with necessary fill", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1)) + p <- causal_pie_necessary(causes) + expect_s3_class(p, "ggplot") + expect_equal(rlang::as_name(p$mapping$fill), "necessary") +}) + +test_that("causal_pie_necessary() does not facet with single cause", { + causes <- causify(sc(A = 1, B = 0)) + p <- causal_pie_necessary(causes) + expect_s3_class(p, "ggplot") + expect_false(inherits(p$facet, "FacetWrap")) +}) + +test_that("causal_pie_necessary() facets with multiple causes", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1)) + p <- causal_pie_necessary(causes) + expect_true(inherits(p$facet, "FacetWrap")) +}) + +# ---- theme tests ---- + +test_that("theme_causal_pie() returns a complete theme without grid", { + thm <- theme_causal_pie() + expect_s3_class(thm, "theme") + expect_s3_class(thm$panel.grid, "element_blank") + expect_s3_class(thm$axis.text, "element_blank") + expect_equal(thm$strip.text$face, "bold") +}) + +test_that("theme_causal_pie_grid() keeps panel grid", { + thm <- theme_causal_pie_grid() + expect_s3_class(thm, "theme") + expect_false(inherits(thm$panel.grid, "element_blank")) + expect_s3_class(thm$axis.text, "element_blank") +}) + +test_that("theme_causal_pie() respects base_size", { + thm <- theme_causal_pie(base_size = 20) + expect_equal(thm$text$size, 20) +}) + +test_that("theme_causal_pie() passes ... to theme()", { + thm <- theme_causal_pie( + plot.background = ggplot2::element_rect(fill = "red") + ) + expect_equal(thm$plot.background$fill, "red") +}) + +# ---- vdiffr visual snapshot tests ---- + +test_that("causal_pie() single cause renders correctly", { + causes <- causify(sc(A = 1, B = 0)) + expect_doppelganger( + "causal-pie-single", + causal_pie(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie() multiple causes renders correctly", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1, C = 0)) + expect_doppelganger( + "causal-pie-multi", + causal_pie(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie() without U renders correctly", { + causes <- causify(sc(A = 1, B = 0), add_u = FALSE) + expect_doppelganger( + "causal-pie-no-u", + causal_pie(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie_necessary() renders correctly", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1, C = 0)) + expect_doppelganger( + "causal-pie-necessary", + causal_pie_necessary(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie() with three causes renders correctly", { + causes <- causify( + sc(A = 1, B = 0), + sc(A = 1, E = 1, C = 0), + sc(B = 1, E = 1) + ) + expect_doppelganger( + "causal-pie-three-causes", + causal_pie(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie() with many components renders correctly", { + causes <- causify(sc(A = 1, B = 0, C = 1, D = 0, E = 1)) + expect_doppelganger( + "causal-pie-many-components", + causal_pie(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie() with text_col renders correctly", { + causes <- causify(sc(A = 1, B = 0)) + expect_doppelganger( + "causal-pie-text-col", + causal_pie(causes, text_col = "white") + theme_causal_pie() + ) +}) + +test_that("causal_pie() with theme_causal_pie_grid renders correctly", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1, C = 0)) + expect_doppelganger( + "causal-pie-grid-theme", + causal_pie(causes) + theme_causal_pie_grid() + ) +}) + +test_that("causal_pie_necessary() single cause renders correctly", { + causes <- causify(sc(A = 1, B = 0)) + expect_doppelganger( + "causal-pie-necessary-single", + causal_pie_necessary(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie_necessary() without U renders correctly", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1), add_u = FALSE) + expect_doppelganger( + "causal-pie-necessary-no-u", + causal_pie_necessary(causes) + theme_causal_pie() + ) +}) + +test_that("causal_pie_necessary() with text_col renders correctly", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1, C = 0)) + expect_doppelganger( + "causal-pie-necessary-text-col", + causal_pie_necessary(causes, text_col = "white") + theme_causal_pie() + ) +}) + +test_that("causal_pie_necessary() with grid theme renders correctly", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1, C = 0)) + expect_doppelganger( + "causal-pie-necessary-grid-theme", + causal_pie_necessary(causes) + theme_causal_pie_grid() + ) +}) diff --git a/tests/testthat/test-causify.R b/tests/testthat/test-causify.R index 5099caa..62f90e4 100644 --- a/tests/testthat/test-causify.R +++ b/tests/testthat/test-causify.R @@ -42,3 +42,32 @@ test_that("causify() works with add_u = FALSE", { expect_equal(nrow(result), 2) expect_false("U1" %in% result$component) }) + +test_that("causify() fraction logic: single component gets 0.5 each", { + result <- causify(sc(A = 1)) + expect_equal(result$frac, c(0.5, 0.5)) +}) + +test_that("causify() fraction logic: components split 0.5 evenly, U gets 0.5", { + result <- causify(sc(A = 1, B = 0, C = 1, D = 0)) + known <- result[result$component != "U1", ] + expect_equal(unique(known$frac), 0.5 / 4) + expect_equal(result$frac[result$component == "U1"], 0.5) +}) + +test_that("causify() with add_u = FALSE splits fractions equally", { + result <- causify(sc(A = 1, B = 0, C = 1), add_u = FALSE) + expect_equal(unique(result$frac), 1 / 3) +}) + +test_that("causify() labels are 'component = value' format", { + result <- causify(sc(X = 1, Y = 0)) + non_u <- result[!grepl("^U", result$component), ] + expect_equal(non_u$label, c("X = 1", "Y = 0")) +}) + +test_that("causify() generates sequential U names across causes", { + result <- causify(sc(A = 1), sc(B = 0)) + u_rows <- result[grepl("^U", result$component), ] + expect_equal(u_rows$component, c("U1", "U2")) +}) diff --git a/tests/testthat/test-components.R b/tests/testthat/test-components.R index 971830e..46ca2b3 100644 --- a/tests/testthat/test-components.R +++ b/tests/testthat/test-components.R @@ -26,3 +26,31 @@ test_that("sufficient_causes() returns descriptions of each cause", { expect_true(grepl("A", result[1])) expect_true(grepl("B", result[1])) }) + +test_that("necessary_causes() with single cause returns all components", { + causes <- causify(sc(A = 1, B = 0)) + result <- necessary_causes(causes) + expect_true("A" %in% result) + expect_true("B" %in% result) + expect_true("U1" %in% result) +}) + +test_that("necessary_causes() detects a non-U necessary cause", { + causes <- causify(sc(A = 1, B = 0), sc(A = 1, E = 1)) + result <- necessary_causes(causes) + expect_true("A" %in% result) + expect_false("B" %in% result) + expect_false("E" %in% result) +}) + +test_that("sufficient_causes() returns one description per cause", { + causes <- causify(sc(A = 1, B = 0), sc(C = 1)) + result <- sufficient_causes(causes) + expect_length(result, 2) +}) + +test_that("components() with add_u = FALSE has no U components", { + causes <- causify(sc(A = 1, B = 0), add_u = FALSE) + result <- components(causes) + expect_false(any(grepl("^U", result))) +})