Skip to content

Commit 719bb27

Browse files
maflotmaflot
authored
Merge pull request #12 from maflot/copilot/improve-testing-infrastructure
Add testthat infrastructure and CI matrix to catch rendering regressions Add github actions workflow to run the tests
2 parents 29afcd1 + 207b12a commit 719bb27

7 files changed

Lines changed: 520 additions & 1 deletion

File tree

‎.github/workflows/R-CMD-check.yml‎

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
on:
2+
push:
3+
branches: [main, master]
4+
pull_request:
5+
branches: [main, master]
6+
7+
name: R-CMD-check
8+
9+
permissions: read-all
10+
11+
jobs:
12+
R-CMD-check:
13+
runs-on: ${{ matrix.config.os }}
14+
15+
name: ${{ matrix.config.os }} (R ${{ matrix.config.r }}, ggplot2 ${{ matrix.config.ggplot2 }})
16+
17+
strategy:
18+
fail-fast: false
19+
matrix:
20+
config:
21+
# Primary: R release against current CRAN ggplot2
22+
- {os: ubuntu-latest, r: 'release', ggplot2: 'CRAN'}
23+
# R oldrel to catch regressions on the previous R release
24+
- {os: ubuntu-latest, r: 'oldrel-1', ggplot2: 'CRAN'}
25+
# ggplot2 development version (catches breaking changes early)
26+
- {os: ubuntu-latest, r: 'release', ggplot2: 'devel'}
27+
# Minimum supported ggplot2 version (matches legendry requirement)
28+
- {os: ubuntu-latest, r: 'oldrel-1', ggplot2: '3.5.2'}
29+
# Windows and macOS smoke tests
30+
- {os: windows-latest, r: 'release', ggplot2: 'CRAN'}
31+
- {os: macos-latest, r: 'release', ggplot2: 'CRAN'}
32+
33+
env:
34+
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
35+
R_KEEP_PKG_SOURCE: yes
36+
37+
steps:
38+
- uses: actions/checkout@v4
39+
40+
- uses: r-lib/actions/setup-pandoc@v2
41+
42+
- uses: r-lib/actions/setup-r@v2
43+
with:
44+
r-version: ${{ matrix.config.r }}
45+
http-user-agent: ${{ matrix.config.http-user-agent }}
46+
use-public-rspm: true
47+
48+
- uses: r-lib/actions/setup-r-dependencies@v2
49+
with:
50+
extra-packages: any::rcmdcheck
51+
needs: check
52+
53+
# Override ggplot2 after the standard dependency install when a
54+
# non-CRAN version is requested.
55+
- name: Install ggplot2 devel (from GitHub)
56+
if: matrix.config.ggplot2 == 'devel'
57+
shell: Rscript {0}
58+
run: pak::pak("tidyverse/ggplot2")
59+
60+
- name: Install ggplot2 minimum supported version
61+
if: matrix.config.ggplot2 == '3.5.2'
62+
shell: Rscript {0}
63+
run: pak::pak("ggplot2@3.5.2")
64+
65+
- uses: r-lib/actions/check-r-package@v2
66+
with:
67+
upload-snapshots: true
68+
build_args: 'c("--no-manual", "--compact-vignettes=gs+qpdf")'

‎DESCRIPTION‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,11 +23,14 @@ URL: https://github.com/maflot/ggdiceplot
2323
BugReports: https://github.com/maflot/ggdiceplot/issues
2424
Imports:
2525
dplyr,
26-
ggplot2 (>= 3.4.0),
26+
ggplot2 (>= 3.5.2),
2727
grid,
2828
legendry,
2929
scales,
3030
tibble
3131
LazyData: true
32+
Suggests:
33+
testthat (>= 3.0.0)
34+
Config/testthat/edition: 3
3235
Depends:
3336
R (>= 4.1.0)

‎tests/testthat.R‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
# This file is part of the testthat test suite for ggdiceplot.
2+
# It is executed automatically by R CMD check.
3+
library(testthat)
4+
library(ggdiceplot)
5+
6+
test_check("ggdiceplot")

‎tests/testthat/helper-data.R‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
# Helper functions and shared test data for ggdiceplot tests.
2+
# Sourced automatically by testthat before running any test files.
3+
4+
library(ggplot2)
5+
6+
# ---------------------------------------------------------------------------
7+
# Minimal "long-format" dice data:
8+
# one row per (tile, dot-position) combination.
9+
# tile (x=1,y=1): positions A, B, C (all three present)
10+
# tile (x=2,y=1): positions A, C (B absent)
11+
# ---------------------------------------------------------------------------
12+
make_simple_data <- function() {
13+
data.frame(
14+
x = c(1L, 1L, 1L, 2L, 2L),
15+
y = c(1L, 1L, 1L, 1L, 1L),
16+
dots = factor(c("A", "B", "C", "A", "C"), levels = c("A", "B", "C")),
17+
fill_val = c(1.0, -1.0, 0.5, -0.5, 0.8),
18+
size_val = c(2.0, 3.0, 4.0, 2.5, 3.5),
19+
stringsAsFactors = FALSE
20+
)
21+
}
22+
23+
# Single tile with n dots (useful for testing individual die faces)
24+
make_single_tile_data <- function(n) {
25+
stopifnot(n >= 1L, n <= 6L)
26+
data.frame(
27+
x = rep(1L, n),
28+
y = rep(1L, n),
29+
dots = factor(LETTERS[seq_len(n)], levels = LETTERS[seq_len(n)]),
30+
stringsAsFactors = FALSE
31+
)
32+
}
33+
34+
# Build a ggplot with geom_dice() for the simple 2-tile data
35+
make_simple_plot <- function(fill_mapped = FALSE, size_mapped = FALSE,
36+
pip_scale = 0.75) {
37+
dat <- make_simple_data()
38+
mapping <- if (fill_mapped && size_mapped) {
39+
ggplot2::aes(x = x, y = y, dots = dots, fill = fill_val, size = size_val)
40+
} else if (fill_mapped) {
41+
ggplot2::aes(x = x, y = y, dots = dots, fill = fill_val)
42+
} else if (size_mapped) {
43+
ggplot2::aes(x = x, y = y, dots = dots, size = size_val)
44+
} else {
45+
ggplot2::aes(x = x, y = y, dots = dots)
46+
}
47+
48+
ggplot2::ggplot(dat, mapping) +
49+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L, pip_scale = pip_scale)
50+
}

‎tests/testthat/test-aesthetics.R‎

Lines changed: 149 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,149 @@
1+
# Tests for aesthetic correctness:
2+
# - pip colours are never NA when dots are visible
3+
# - pip coordinates fall within tile boundaries
4+
# - pip row count matches the data (no silent drops)
5+
6+
# ---------------------------------------------------------------------------
7+
# Helper: extract point_df from the first layer's DiceGrob.
8+
# Uses the same tree-traversal approach as test-rendering.R.
9+
# ---------------------------------------------------------------------------
10+
find_dice_grob_aes <- function(x) {
11+
if (inherits(x, "DiceGrob")) return(x)
12+
kids <- if (inherits(x, "gTree")) x$children else if (is.list(x)) x else NULL
13+
if (!is.null(kids)) {
14+
for (k in kids) {
15+
found <- find_dice_grob_aes(k)
16+
if (!is.null(found)) return(found)
17+
}
18+
}
19+
NULL
20+
}
21+
22+
get_point_df <- function(plot) {
23+
raw <- ggplot2::layer_grob(plot, i = 1L)
24+
g <- find_dice_grob_aes(raw)
25+
if (is.null(g)) stop("DiceGrob not found in layer_grob() output")
26+
g$point_df
27+
}
28+
29+
# ---------------------------------------------------------------------------
30+
# Colour correctness
31+
# ---------------------------------------------------------------------------
32+
33+
test_that("pip colour is never NA (fill unmapped)", {
34+
p <- make_simple_plot(fill_mapped = FALSE)
35+
pdf <- get_point_df(p)
36+
expect_false(
37+
any(is.na(pdf$colour)),
38+
info = "All pip colours must be non-NA when fill is not mapped"
39+
)
40+
})
41+
42+
test_that("pip colour is never NA (fill mapped to continuous)", {
43+
dat <- make_simple_data()
44+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots,
45+
fill = fill_val)) +
46+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L) +
47+
ggplot2::scale_fill_gradient2(low = "blue", high = "red", mid = "white",
48+
midpoint = 0)
49+
pdf <- get_point_df(p)
50+
expect_false(
51+
any(is.na(pdf$colour)),
52+
info = "All pip colours must be non-NA when fill is a continuous aesthetic"
53+
)
54+
})
55+
56+
test_that("pip colour is never NA (fill mapped to discrete)", {
57+
dat <- make_simple_data()
58+
dat$group <- factor(ifelse(dat$fill_val > 0, "Up", "Down"))
59+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots,
60+
fill = group)) +
61+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L)
62+
pdf <- get_point_df(p)
63+
expect_false(
64+
any(is.na(pdf$colour)),
65+
info = "All pip colours must be non-NA when fill is a discrete aesthetic"
66+
)
67+
})
68+
69+
# ---------------------------------------------------------------------------
70+
# Coordinate bounds: pips must lie within their tile boundaries
71+
# ---------------------------------------------------------------------------
72+
73+
test_that("pip x-coordinates fall within tile boundaries", {
74+
dat <- make_simple_data()
75+
tile_w <- 0.5 # default width
76+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots)) +
77+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L)
78+
pdf <- get_point_df(p)
79+
80+
# x_coord holds the tile centre; pips must stay within ± tile_w/2
81+
tile_centers <- pdf$x_coord
82+
expect_true(
83+
all(pdf$x >= tile_centers - tile_w / 2 - .Machine$double.eps &
84+
pdf$x <= tile_centers + tile_w / 2 + .Machine$double.eps),
85+
info = "Pip x-coordinates must not exceed tile boundaries"
86+
)
87+
})
88+
89+
test_that("pip y-coordinates fall within tile boundaries", {
90+
dat <- make_simple_data()
91+
tile_h <- 0.5 # default height
92+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots)) +
93+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L)
94+
pdf <- get_point_df(p)
95+
96+
tile_centers <- pdf$y_coord
97+
expect_true(
98+
all(pdf$y >= tile_centers - tile_h / 2 - .Machine$double.eps &
99+
pdf$y <= tile_centers + tile_h / 2 + .Machine$double.eps),
100+
info = "Pip y-coordinates must not exceed tile boundaries"
101+
)
102+
})
103+
104+
# ---------------------------------------------------------------------------
105+
# Pip count invariant: no silent row drops
106+
# ---------------------------------------------------------------------------
107+
108+
test_that("pip count matches the number of data rows (no silent drops)", {
109+
dat <- make_simple_data()
110+
# dat has 5 rows => 5 dots expected (2 tiles: 3+2 dots)
111+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots)) +
112+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L)
113+
pdf <- get_point_df(p)
114+
expect_equal(
115+
nrow(pdf), nrow(dat),
116+
info = "point_df must have exactly one row per data observation"
117+
)
118+
})
119+
120+
test_that("all ndots values produce the correct pip count for a full single tile", {
121+
for (n in 1:6) {
122+
dat <- make_single_tile_data(n)
123+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots)) +
124+
geom_dice(ndots = n, x_length = 1L, y_length = 1L)
125+
pdf <- get_point_df(p)
126+
expect_equal(
127+
nrow(pdf), n,
128+
info = paste0("Expected ", n, " pip rows for ndots = ", n)
129+
)
130+
}
131+
})
132+
133+
# ---------------------------------------------------------------------------
134+
# Tile count invariant: one tile grob per unique (x, y) combination
135+
# ---------------------------------------------------------------------------
136+
137+
test_that("tile_df has one row per unique (x, y) tile", {
138+
dat <- make_simple_data()
139+
# 2 unique (x, y) combinations: (1,1) and (2,1)
140+
p <- ggplot2::ggplot(dat, ggplot2::aes(x = x, y = y, dots = dots)) +
141+
geom_dice(ndots = 3L, x_length = 2L, y_length = 1L)
142+
raw <- ggplot2::layer_grob(p, i = 1L)
143+
g <- find_dice_grob_aes(raw)
144+
n_tiles <- nrow(unique(dat[, c("x", "y")]))
145+
expect_equal(
146+
nrow(g$tile_df), n_tiles,
147+
info = "tile_df must have exactly one row per unique tile"
148+
)
149+
})

0 commit comments

Comments
 (0)