Speed up unit tests by removing unneeded snapshot tests

NEWS.md

@@ -6,7 +6,7 @@
 
 * Plots now render like they would appear when saved in the Viewer pane when they are printed via `print()` (this happens automatically when a `ggplot()` object is run).
 * Added `ytitle_wrap` argument to `labs_e61` so you can custom wrap the y-axis titles just like other graph titles.
-* New, simpler approach to specifying which facets for labels to appear on using a new `panel` argument in `labs_e61`.
+* New, simpler approach to specifying which facets for labels to appear on using a new `panel` argument in `plot_label`.
 
 #### Bug fixes
 

R/theme_e61.R

@@ -291,7 +291,8 @@ theme_e61_spatial <- function(
 #'   square_legend_symbols()
 #'
 square_legend_symbols <- function(size = 6) {
-  guides(colour = guide_legend(override.aes = list(alpha = 1, size = size, shape = 15)))
+  guides(colour = guide_legend(override.aes = list(alpha = 1, size = size, shape = 15)),
+         fill = guide_legend(override.aes = list(alpha = 1, size = size, shape = 15)))
 }
 
 #' Applies changes to the theme for horizontal bar graphs

tests/testthat/test-geom_pointbar.R

@@ -1,194 +1,133 @@
-# geom_pointbar visual tests
-
-# Test 1: Simple single regression coefficient ----
-test_that("Single regression coefficient", {
-  withr::local_seed(42)
-
-  # Single coefficient data (like a regression output)
-  data <- data.frame(
-    term = "Treatment Effect",
-    estimate = 2.5,
-    conf.low = 1.8,
-    conf.high = 3.2,
-    x = 1
+test_that("geom_pointbar() creates errorbar + point layers in correct order", {
+  d <- data.frame(
+    x = 1:3,
+    y = c(2.5, 3.0, 1.5),
+    ymin = c(2.0, 2.6, 1.2),
+    ymax = c(3.0, 3.4, 1.8)
   )
 
-  p <- ggplot(data, aes(x = x, y = estimate, ymin = conf.low, ymax = conf.high)) +
-    geom_pointbar() +
-    labs_e61(title = "Single Regression Coefficient",
-             y = "%")
+  p <- ggplot(d, aes(x, y, ymin = ymin, ymax = ymax)) +
+    geom_pointbar()
 
-  withr::with_tempdir({
-    expect_snapshot_file(suppressWarnings(save_e61("pointbar-single-coef.svg", p)))
-  })
-})
+  expect_equal(length(p@layers), 2)
+  expect_true(inherits(p@layers[[1]]$geom, "GeomErrorbar"))
+  expect_true(inherits(p@layers[[2]]$geom, "GeomPoint"))
 
-# Test 2: Multiple point bars grouped by colour ----
-test_that("Multiple point bars grouped by colour", {
-  withr::local_seed(42)
+  # Point layer must not carry ymin / ymax
+  expect_null(p@layers[[2]]$mapping$ymin)
+  expect_null(p@layers[[2]]$mapping$ymax)
+})
 
-  # Multiple groups with different treatments
-  data <- data.frame(
-    treatment = rep(c("Control", "Treatment A", "Treatment B"), each = 3),
-    time = rep(c("Week 1", "Week 2", "Week 3"), 3),
-    mean_score = c(5.2, 6.1, 6.8, 7.3, 8.2, 9.1, 6.8, 7.9, 8.5),
-    lower_ci = c(4.5, 5.3, 6.0, 6.5, 7.4, 8.3, 6.0, 7.1, 7.7),
-    upper_ci = c(5.9, 6.9, 7.6, 8.1, 9.0, 9.9, 7.6, 8.7, 9.3),
-    x_pos = rep(1:3, 3)
+test_that("geom_pointbar() forwards styling arguments to the correct geom", {
+  d <- data.frame(
+    x = 1:2,
+    y = c(1, 2),
+    ymin = c(0.5, 1.5),
+    ymax = c(1.5, 2.5)
   )
 
-  p <- ggplot(data, aes(x = x_pos, y = mean_score,
-                        ymin = lower_ci, ymax = upper_ci,
-                        colour = treatment)) +
-    geom_pointbar(position = position_dodge(width = 0.3)) +
-    scale_y_continuous_e61() +
-    scale_x_continuous_e61() +
-    scale_colour_e61() +
-    labs_e61(title = "Multiple Groups by Colour",
-             y = "score") +
-    scale_x_continuous(breaks = 1:3, labels = c("Week 1", "Week 2", "Week 3")) +
-    theme_e61(legend = "bottom")
-
-  withr::with_tempdir({
-    expect_snapshot_file(suppressWarnings(save_e61("pointbar-multiple-groups.svg", p)))
-  })
+  p <- ggplot(d, aes(x, y, ymin = ymin, ymax = ymax)) +
+    geom_pointbar(
+      point.size = 4,
+      errorbar.width = 0.4,
+      errorbar.linewidth = 1.2,
+      linetype = "dashed",
+      alpha = 0.8,
+      shape = 21,
+      fill = e61_skylight,
+      colour = e61_skydark
+    )
+
+  eb <- p@layers[[1]]
+  pt <- p@layers[[2]]
+
+  # Errorbar params
+  expect_equal(eb$aes_params$width, 0.4)
+  expect_equal(eb$aes_params$linewidth, 1.2)
+  expect_equal(eb$aes_params$linetype, "dashed")
+  expect_equal(eb$aes_params$alpha, 0.8)
+
+  # Point params (stored inconsistently across ggplot2 versions)
+  getp <- function(layer, nm) {
+    if (!is.null(layer$aes_params[[nm]])) layer$aes_params[[nm]] else layer$params[[nm]]
+  }
+
+  expect_equal(getp(pt, "size"), 4)
+  expect_equal(getp(pt, "shape"), 21)
+  expect_equal(getp(pt, "fill"), e61_skylight)
+  expect_equal(getp(pt, "colour"), e61_skydark)
+  expect_equal(getp(pt, "alpha"), 0.8)
 })
 
-# Test 3: Custom point sizes and error bar widths ----
-test_that("Custom point sizes and error bar widths", {
-  withr::local_seed(42)
-
-  # Data with varying effect sizes (different point sizes make sense)
-  data <- data.frame(
-    study = paste("Study", 1:5),
-    effect_size = c(0.3, 0.8, 1.2, 0.5, 0.9),
-    lower_bound = c(0.1, 0.5, 0.9, 0.2, 0.6),
-    upper_bound = c(0.5, 1.1, 1.5, 0.8, 1.2),
-    sample_size = c(50, 120, 200, 80, 150),
-    x_pos = 1:5
+test_that("geom_pointbar() supports grouping and position_dodge", {
+  d <- data.frame(
+    group = rep(c("A", "B"), each = 2),
+    x = rep(1:2, 2),
+    y = c(5, 6, 7, 8),
+    ymin = c(4, 5, 6, 7),
+    ymax = c(6, 7, 8, 9)
   )
 
-  p <- ggplot(data, aes(x = x_pos, y = effect_size,
-                        ymin = lower_bound, ymax = upper_bound)) +
-    geom_pointbar(
-      point.size = 4,           # Large points
-      errorbar.width = 0.4,     # Wide error bars
-      errorbar.linewidth = 1.2 # Thick error bar lines
-    ) +
-    labs_e61(title = "Custom Point Sizes and Error Bar Widths",
-             subtitle = "Large points (size=4), wide error bars (width=0.4), thick lines",
-             y = "%") +
-    scale_x_continuous(breaks = 1:5, labels = data$study)
+  pos <- position_dodge(width = 0.3)
 
-        withr::with_tempdir({
-    expect_snapshot_file(suppressWarnings(save_e61("pointbar-custom-sizes.svg", p)))
-  })
-})
+  p <- ggplot(d, aes(x, y, ymin = ymin, ymax = ymax, colour = group)) +
+    geom_pointbar(position = pos)
 
-# Test 4: Manual colour specification by group identifier ----
-test_that("Manual colour specification by group", {
-  withr::local_seed(42)
+  expect_true(inherits(p@layers[[1]]$position, "PositionDodge"))
+  expect_true(inherits(p@layers[[2]]$position, "PositionDodge"))
+})
 
-  # Comparison of different methods/approaches
-  data <- data.frame(
-    method = rep(c("Method A", "Method B", "Method C", "Method D"), each = 2),
-    metric = rep(c("Accuracy", "Precision"), 4),
-    value = c(0.85, 0.82, 0.78, 0.85, 0.92, 0.88, 0.75, 0.79),
-    lower = c(0.80, 0.77, 0.72, 0.80, 0.88, 0.83, 0.68, 0.73),
-    upper = c(0.90, 0.87, 0.84, 0.90, 0.96, 0.93, 0.82, 0.85),
-    x_pos = rep(c(1, 2), 4)
+test_that("geom_pointbar() na.rm = TRUE suppresses missing-value warnings", {
+  d <- data.frame(
+    x = 1:5,
+    y = c(2.5, NA, 4.1, 3.8, NA),
+    ymin = c(2.0, NA, 3.5, 3.2, NA),
+    ymax = c(3.0, NA, 4.7, 4.4, NA)
   )
 
-  # Custom colour palette using e61 colours
-  method_colours <- c("Method A" = e61_coraldark,
-                     "Method B" = e61_bluedark,
-                     "Method C" = e61_tealdark,
-                     "Method D" = e61_orangedark)
+  p <- ggplot(d, ggplot2::aes(x, y, ymin = ymin, ymax = ymax)) +
+    geom_pointbar(na.rm = TRUE)
 
-  p <- ggplot(data, aes(x = x_pos, y = value,
-                        ymin = lower, ymax = upper,
-                        colour = method)) +
-    geom_pointbar(
-      position = position_dodge(width = 0.4),
-      point.size = 3,
-      errorbar.width = 0.2
-    ) +
-    scale_colour_manual(values = method_colours) +
-    scale_y_continuous_e61() +
-    scale_x_continuous_e61() +
-    labs_e61(title = "Manual Colour Specification by Group",
-             subtitle = "Four methods with custom e61 colour palette",
-             x = "Metric Type", y = "score") +
-    scale_x_continuous(breaks = 1:2, labels = c("Accuracy", "Precision")) +
-    theme_e61(legend = "bottom")
-
-  withr::with_tempdir({
-    expect_snapshot_file(suppressWarnings(save_e61("pointbar-manual-colours.svg", p)))
-  })
+  # If na.rm is correctly passed through, building should not warn about removed rows
+  expect_no_warning(ggplot2::ggplot_build(p))
 })
 
-# Test 5: Edge case - Missing data handling ----
-test_that("Missing data handling", {
-  withr::local_seed(42)
-
-  # Data with some missing values
-  data <- data.frame(
+test_that("geom_pointbar() preserves missingness in built data", {
+  d <- data.frame(
     x = 1:5,
     y = c(2.5, NA, 4.1, 3.8, NA),
     ymin = c(2.0, NA, 3.5, 3.2, NA),
     ymax = c(3.0, NA, 4.7, 4.4, NA)
   )
 
-  p <- ggplot(data, aes(x = x, y = y, ymin = ymin, ymax = ymax)) +
-    geom_pointbar(na.rm = TRUE, colour = e61_coraldark) +
-    scale_y_continuous_e61() +
-    scale_x_continuous_e61() +
-    labs_e61(title = "Missing Data Handling (na.rm = TRUE)",
-             y = "%")
+  p <- ggplot(d, ggplot2::aes(x, y, ymin = ymin, ymax = ymax)) +
+    geom_pointbar(na.rm = TRUE)
 
-  withr::with_tempdir({
-    expect_snapshot_file(suppressWarnings(save_e61("pointbar-missing-data.svg", p)))
-  })
+  b <- ggplot_build(p)
+
+  # Errorbar layer: missing y/ymin/ymax should still be missing in those rows
+  expect_equal(sum(!is.finite(b$data[[1]]$y)), 2)
+  expect_equal(sum(!is.finite(b$data[[2]]$y)), 2)
 })
 
-# Test 6: Different shapes and styling ----
-test_that("Different shapes and styling", {
-  withr::local_seed(42)
 
-  # Data for showing different aesthetic options
-  data <- data.frame(
-    category = c("A", "B", "C", "D"),
-    value = c(3.2, 4.5, 2.8, 5.1),
-    lower = c(2.5, 3.8, 2.1, 4.3),
-    upper = c(3.9, 5.2, 3.5, 5.9),
-    x_pos = 1:4
+test_that("geom_pointbar() works with manual colour scales", {
+  d <- data.frame(
+    x = factor(c("A", "B")),
+    y = c(1, 2),
+    ymin = c(0.7, 1.6),
+    ymax = c(1.3, 2.4),
+    g = factor(c("G1", "G2"))
   )
 
-  p <- ggplot(data, aes(x = x_pos, y = value, ymin = lower, ymax = upper)) +
-    geom_pointbar(
-      shape = 21,                   # Fillable circles
-      fill = e61_skylight,          # Fill colour using e61 palette
-      colour = e61_skydark,         # Border colour using e61 palette
-      point.size = 5,               # Large points
-      errorbar.width = 0.3,         # Error bar width
-      errorbar.linewidth = 1.5,     # Thick error bars
-      linetype = "dashed",          # Dashed error bars
-      alpha = 0.8                   # Transparency
-    ) +
-    scale_y_continuous_e61() +
-    scale_x_continuous_e61() +
-    labs_e61(title = "Different Shapes and Styling",
-             subtitle = "Shape 21, filled circles, dashed error bars with e61 colours",
-             y = "n") +
-    scale_x_continuous(breaks = 1:4, labels = data$category)
+  p <- ggplot(d, aes(x, y, ymin = ymin, ymax = ymax, colour = g)) +
+    geom_pointbar() +
+    scale_colour_manual(values = c(G1 = "red", G2 = "blue"))
 
-  withr::with_tempdir({
-    expect_snapshot_file(suppressWarnings(save_e61("pointbar-shapes-styling.svg", p)))
-  })
+  expect_no_error(b <- ggplot_build(p))
+  expect_false(is.null(b$plot$scales$get_scales("colour")))
 })
 
-# Additional unit tests for functionality (non-visual) ----
-
 test_that("Required aesthetics validation", {
   data <- data.frame(x = 1:3, y = 1:3)
 
@@ -242,3 +181,59 @@ test_that("Works with e61 theme functions", {
 
   expect_s3_class(p, "ggplot")
 })
+
+test_that("geom_pointbar visual test", {
+
+  set.seed(1)
+
+  d <- data.frame(
+    term = factor(rep(c("A", "B", "C", "D"), each = 2), levels = c("A", "B", "C", "D")),
+    group = factor(rep(c("Control", "Treat"), times = 4), levels = c("Control", "Treat")),
+    estimate = c(0.10, 0.25, -0.05, 0.15, 0.00, 0.20, 0.30, NA),  # includes NA
+    se = c(0.05, 0.07, 0.06, 0.05, 0.04, 0.06, 0.08, 0.09),
+    panel = factor(rep(c("P1", "P2"), each = 4), levels = c("P1", "P2"))
+  )
+
+  d$ymin <- d$estimate - 1.96 * d$se
+  d$ymax <- d$estimate + 1.96 * d$se
+
+  pos <- position_dodge(width = 0.55)
+
+  p <- ggplot(
+    d,
+    aes(
+      x = term,
+      y = estimate,
+      ymin = ymin,
+      ymax = ymax,
+      colour = group,
+      fill = group
+    )
+  ) +
+    geom_pointbar(
+      position = pos,
+      na.rm = TRUE,              # exercises missing handling
+      point.size = 3.5,          # point styling
+      shape = 21,                # enables fill + colour
+      alpha = 0.85,              # applied to both geoms
+      errorbar.width = 0.25,     # errorbar styling
+      errorbar.linewidth = 1.0,
+      linetype = "dashed"
+    ) +
+    geom_hline(yintercept = 0, linewidth = 0.3, alpha = 0.5) +
+    facet_wrap(~ panel, nrow = 1) +
+    scale_colour_manual(values = c("Control" = e61_skydark, "Treat" = e61_orangedark)) +
+    scale_fill_manual(values = c("Control" = e61_skylight, "Treat" = e61_orangelight)) +
+    theme_e61(legend = "top", legend_title = TRUE) +
+    labs_e61(
+      title = "geom_pointbar kitchen sink",
+      subtitle = "dodge + manual colour/fill + shape21 + linetype/alpha + na.rm + facets",
+      y = "Estimate"
+    )
+
+  # Snapshot: keep as SVG so diffs are stable and file size stays smaller than PNG.
+  withr::with_tempdir({
+    suppressWarnings(save_e61("geom-pointbar-kitchen-sink.svg", p))
+    expect_snapshot_file("geom-pointbar-kitchen-sink.svg")
+  })
+})