Merge pull request #44 from rnabioco/more_tests

* more tests from ggplot2
* vdiffr tests

.github/workflows/check-standard.yaml

@@ -18,11 +18,11 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'release'}
-          - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
-          - {os: ubuntu-latest,   r: 'release'}
-          - {os: ubuntu-latest,   r: 'oldrel/1'}
+          - {os: macOS-latest,   r: 'release',  vdiffr: true}
+          - {os: windows-latest, r: 'release',  vdiffr: true}
+          - {os: ubuntu-latest,  r: 'devel',    vdiffr: false, http-user-agent: 'release'}
+          - {os: ubuntu-latest,  r: 'release',  vdiffr: true}
+          - {os: ubuntu-latest,  r: 'oldrel/1', vdiffr: false}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

DESCRIPTION

@@ -33,11 +33,11 @@ Suggests:
     covr,
     knitr,
     rmarkdown,
-    testthat (>= 3.0.0),
     tidyr,
     tibble,
     dplyr,
-    vdiffr
+    testthat (>= 3.0.0),
+    vdiffr (>= 1.0.0)
 VignetteBuilder: 
     knitr
 Config/testthat/edition: 3

pkgdown/_pkgdown.yml

@@ -1,6 +1,8 @@
 url: https://rnabioco.github.io/ggtrace
 
 authors:
+  Jay Hesselberth:
+    href: https://hesselberthlab.org
   RNA Bioscience Initiative:
     href: https://medschool.cuanschutz.edu/rbi
 

tests/testthat/helper-vdiffr.R

@@ -0,0 +1,17 @@
+# By default, if vdiffr is not installed, all visual tests are skipped unless
+# VDIFFR_RUN_TESTS is explicitly set to "true", which should be the case only on
+# a GitHub Actions CI runner with stable version of R.
+# From ggplot2
+
+if (requireNamespace("vdiffr", quietly = TRUE) && utils::packageVersion("testthat") >= '3.0.3') {
+  expect_doppelganger <- vdiffr::expect_doppelganger
+
+# If vdiffr is not available and visual tests are explicitly required, raise error
+} else {
+  if (identical(Sys.getenv("VDIFFR_RUN_TESTS"), "true")) {
+    stop("vdiffr is not installed")
+  }
+
+  # Otherwise, assign a dummy function
+  expect_doppelganger <- function(...) skip("vdiffr is not installed.")
+}

tests/testthat/test-draw-key.R

@@ -1,10 +1,10 @@
-# test_that("draw_key_*_trace", {
-#   p <- ggplot(clusters, aes(UMAP_1, UMAP_2, color = cluster))
-#
-#   expect_doppelganger("no shape", p + geom_point_trace())
-#   expect_doppelganger("numeric shape", p + geom_point_trace(shape = 3))
-#   expect_doppelganger("character shape", p + geom_point_trace(shape = "plus"))
-#
-#   expect_doppelganger("no linetype", p + geom_point_trace(key_glyph = draw_key_path_trace))
-#   expect_doppelganger("linetype", p + geom_point_trace(key_glyph = draw_key_path_trace, linetype = 2))
-# })
+test_that("draw_key_*_trace", {
+  p <- ggplot(clusters, aes(UMAP_1, UMAP_2, color = cluster))
+
+  expect_doppelganger("no shape", p + geom_point_trace(key_glyph = draw_key_point_trace))
+  expect_doppelganger("numeric shape", p + geom_point_trace(shape = 3, key_glyph = draw_key_point_trace))
+  expect_doppelganger("character shape", p + geom_point_trace(shape = "plus", key_glyph = draw_key_point_trace))
+
+  expect_doppelganger("no linetype", p + geom_point_trace(key_glyph = draw_key_path_trace))
+  expect_doppelganger("linetype", p + geom_point_trace(key_glyph = draw_key_path_trace, linetype = 2))
+})

tests/testthat/test-geom-line-trace.R

@@ -7,42 +7,53 @@ test_that("specify aes params", {
 
   p2 <- p + geom_line_trace(linetype = 5)
   expect_identical(p2$layers[[1]]$aes_params$linetype, 5)
+  expect_doppelganger("specify aes params 1", p2)
 
   p2 <- p + geom_line_trace(color = "red")
   expect_identical(p2$layers[[1]]$aes_params$colour, "red")
+  expect_doppelganger("specify aes params 2", p2)
 
   p2 <- p + geom_line_trace(colour = "red")
   expect_identical(p2$layers[[1]]$aes_params$colour, "red")
+  expect_doppelganger("specify aes params 3", p2)
 
   p2 <- p + geom_line_trace(fill = "red")
   expect_identical(p2$layers[[1]]$aes_params$fill, "red")
+  expect_doppelganger("specify aes params 4", p2)
 
   p2 <- p + geom_line_trace(alpha = 0.5)
   expect_identical(p2$layers[[1]]$aes_params$alpha, 0.5)
+  expect_doppelganger("specify aes params 5", p2)
 })
 
 test_that("aesthetics to variable", {
   p <- ggplot(stocks, aes(day, value, color = name))
 
   p2 <- p + geom_line_trace()
   expect_identical(as.character(p2$mapping$colour)[[2]], "name")
+  expect_doppelganger("aesthetics to variable", p2)
 })
 
 test_that("aesthetics from geom", {
   p <- ggplot(stocks, aes(day, value, color = name))
   expect_identical(as.character(p$mapping$colour)[2], "name")
+  expect_doppelganger("aesthetics from geom 1", p)
 
   p <- geom_line_trace(aes(fill = name))
   expect_identical(as.character(p[[1]]$mapping$fill)[2], "name")
+  expect_doppelganger("aesthetics from geom 2", p)
 
   p <- geom_line_trace(aes(linetype = name))
   expect_identical(as.character(p[[1]]$mapping$linetype)[2], "name")
+  expect_doppelganger("aesthetics from geom 3", p)
 
   p <- geom_line_trace(aes(alpha = name))
   expect_identical(as.character(p[[1]]$mapping$alpha)[2], "name")
+  expect_doppelganger("aesthetics from geom 4", p)
 
   p <- geom_line_trace(aes(stroke = name))
   expect_identical(as.character(p[[1]]$mapping$stroke)[2], "name")
+  expect_doppelganger("aesthetics from geom 5", p)
 })
 
 test_that("trace_position predicate return list", {
@@ -58,21 +69,40 @@ test_that("trace_position predicate data", {
   p <- ggplot(stocks, aes(day, value, color = name)) +
     geom_line_trace(trace_position = day < 500 | day > 1500)
 
-  expect_identical(p$layers[[2]]$data(stocks) %>% dplyr::filter(KEEP_THIS_ROW_PLEASE) %>% dplyr::select(-KEEP_THIS_ROW_PLEASE) %>% tibble::as_tibble(), subset(stocks, day < 500 | day > 1500))
+  df1 <- p$layers[[2]]$data(stocks) %>%
+      dplyr::filter(KEEP_THIS_ROW_PLEASE) %>%
+      dplyr::select(-KEEP_THIS_ROW_PLEASE) %>%
+      tibble::as_tibble()
+
+  df2 <- subset(stocks, day < 500 | day > 1500)
+
+  expect_identical(df1, df2)
 })
 
 test_that("trace_position pass data as data.frame", {
   dat <- subset(stocks, day < 500 | day > 1500)
   p   <- geom_line_trace(data = dat, trace_position = subset(stocks, day < 500 | day > 1500))
 
-  expect_identical(p[[2]]$data(dat) %>% dplyr::select(day, name, value) %>% tibble::as_tibble(), subset(stocks, day < 500 | day > 1500))
+  df1 <- p[[2]]$data(dat) %>%
+    dplyr::select(day, name, value) %>%
+    tibble::as_tibble()
+
+  df2 <- subset(stocks, day < 500 | day > 1500)
+
+  expect_identical(df1, df2)
 })
 
 test_that("trace_position pass data as function", {
   dat <- function(x) subset(x, day < 500 | day > 1500)
   p   <- geom_line_trace(data = dat, trace_position = day < 500 | day > 1500)
 
-  expect_identical(p[[2]]$data(stocks) %>% dplyr::select(-KEEP_THIS_ROW_PLEASE) %>% tibble::as_tibble(), subset(stocks, day < 500 | day > 1500))
+  df1 <- p[[2]]$data(stocks) %>%
+    dplyr::select(-KEEP_THIS_ROW_PLEASE) %>%
+    tibble::as_tibble()
+
+  df2 <- subset(stocks, day < 500 | day > 1500)
+
+  expect_identical(df1, df2)
 })
 
 test_that("background_params color", {
@@ -83,9 +113,11 @@ test_that("background_params color", {
     )
 
   expect_true(p$layers[[1]]$geom_params$bkgd_fill == "grey75")
+  expect_doppelganger("background_params color 1", p)
 
   p <- ggplot(stocks, aes(day, value, color = name)) +
     geom_line_trace(trace_position = day < 500 | day > 1500)
 
   expect_true(is.na(p$layers[[1]]$geom_params$bkgd_colour))
+  expect_doppelganger("background_params color 2", p)
 })

tests/testthat/test-geom-point-trace.R

@@ -49,6 +49,7 @@ test_that("trace_position bottom", {
   p <- geom_point_trace(trace_position = "bottom")
 
   expect_identical(as.character(p[[1]]$mapping$group)[2], "BOTTOM_TRACE_GROUP")
+  expect_doppelganger("trace_position bottom", p)
 })
 
 test_that("trace_position predicate return list", {
@@ -58,27 +59,31 @@ test_that("trace_position predicate return list", {
   expect_true(length(p) == 2)
   expect_identical(p[[1]]$geom_params$bkgd_colour, NA)
   expect_true(length(p[[2]]$aes_params) == 0)
+  expect_doppelganger("trace_position predicate return list", p)
 })
 
 test_that("trace_position predicate data", {
   p <- ggplot(clusters, aes(UMAP_1, UMAP_2)) +
     geom_point_trace(trace_position = signal > 10)
 
   expect_identical(p$layers[[2]]$data(clusters), subset(clusters, signal > 10))
+  expect_doppelganger("trace_position predicate data", p)
 })
 
 test_that("trace_position pass data as data.frame", {
   dat <- subset(clusters, signal > 10)
   p   <- geom_point_trace(data = dat, trace_position = signal > 10)
 
   expect_identical(p[[2]]$data(clusters), subset(clusters, signal > 10))
+  expect_doppelganger("trace_position pass data as data.frame", p)
 })
 
 test_that("trace_position pass data as function", {
   dat <- function(x) subset(x, signal > 10)
   p   <- geom_point_trace(data = dat, trace_position = signal > 10)
 
   expect_identical(p[[2]]$data(clusters), subset(clusters, signal > 10))
+  expect_doppelganger("trace_position pass data as function", p)
 })
 
 test_that("background_params color", {
@@ -89,11 +94,13 @@ test_that("background_params color", {
     )
 
   expect_true(p$layers[[1]]$geom_params$bkgd_fill == "blue")
+  expect_doppelganger("background_params color 1", p)
 
   p <- ggplot(clusters, aes(UMAP_1, UMAP_2)) +
     geom_point_trace(trace_position = signal > 10)
 
   expect_true(is.na(p$layers[[1]]$geom_params$bkgd_colour))
+  expect_doppelganger("background_params color 2", p)
 })
 
 test_that("single strings translate to their corresponding integers", {

tests/testthat/test-rbind-dfs.R

@@ -0,0 +1,14 @@
+# From ggplot2
+test_that("rbind_dfs keep classes of columns", {
+  df1 <- data_frame(
+    integer   = seq_len(10),
+    numeric   = as.numeric(seq_len(10)),
+    character = letters[1:10],
+    factor    = factor(letters[1:10]),
+    ordered   = ordered(letters[1:10]),
+    date      = Sys.Date()
+  )
+
+  df2 <- rbind_dfs(list(df1[1:5, ], df1[6:10, ]))
+  expect_equal(df1, df2)
+})