From 4c7bd98853bede4b6e93a24ca84787bd90351f7c Mon Sep 17 00:00:00 2001 From: Claude Date: Sun, 12 Jul 2026 03:48:48 +0000 Subject: [PATCH] Add unit tests for the plotting functions; fix scales >= 1.3.0 compatibility None of the package's plot functions render to a graphics device -- they build and return a ggplot object (or, for overlay_peaklist(), a list of ggplot2 layers) via + composition, so they can be unit-tested like any other data structure by inspecting the returned object's data, labels, scales and layer classes, without snapshot/visual-regression tooling. Covers: mat_to_nativeRaster() (pure matrix-to-raster encoding, including the zero-length edge case), plot_interactive(), cubic_root_trans(), as.data.frame.GCIMSSample(), plot() for GCIMSSample/GCIMSChromatogram/ GCIMSSpectrum (labels, data, axis ranges, the single/multi/empty-value subtitle branches), and overlay_peaklist() across its color_by, apex, palette-recycling and pdata-merging branches, plus its two validation errors. Brings plot-GCIMSSample.R, plot-GCIMSChromatogram.R, plot-GCIMSSpectrum.R and utils-plot.R to 100% line coverage. While writing these tests, found that mat_to_gplot() checked inherits(trans, "trans") to validate a transform object passed directly to plot()'s trans= argument (as opposed to a string). scales >= 1.3.0 renamed this S3 class from "trans" to "transform", so passing any transform object -- including the package's own cubic_root_trans() -- this way always failed with "unknown trans value", even though the roxygen docs explicitly point to this as valid usage. Fixed the check to match the class scales has used since 1.3.0 (already over a year old), and bumped the scales dependency in DESCRIPTION to >= 1.4.0 accordingly. Co-Authored-By: Claude Sonnet 5 Claude-Session: https://claude.ai/code/session_019V3CHRGSzcEu3k6tpUFv56 --- DESCRIPTION | 2 +- R/plot-GCIMSSample.R | 2 +- tests/testthat/test-plot-GCIMSChromatogram.R | 45 ++++ tests/testthat/test-plot-GCIMSSample.R | 219 +++++++++++++++++++ tests/testthat/test-plot-GCIMSSpectrum.R | 45 ++++ tests/testthat/test-utils-plot.R | 49 +++++ 6 files changed, 360 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-plot-GCIMSChromatogram.R create mode 100644 tests/testthat/test-plot-GCIMSSample.R create mode 100644 tests/testthat/test-plot-GCIMSSpectrum.R create mode 100644 tests/testthat/test-utils-plot.R diff --git a/DESCRIPTION b/DESCRIPTION index 0b94f12..a5878ee 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -112,7 +112,7 @@ Suggests: png, pracma, rmarkdown, - scales, + scales (>= 1.4.0), testthat (>= 3.0.0), viridisLite biocViews: Software, Preprocessing, Visualization, Classification, diff --git a/R/plot-GCIMSSample.R b/R/plot-GCIMSSample.R index 95d6c3f..a3c9e3e 100644 --- a/R/plot-GCIMSSample.R +++ b/R/plot-GCIMSSample.R @@ -69,7 +69,7 @@ mat_to_gplot <- function(intmat, dt_min = NULL, dt_max = NULL, rt_min = NULL, rt } else { cli_abort("unknown trans value") } - } else if (!inherits(trans, "trans")) { + } else if (!inherits(trans, "transform")) { cli_abort("unknown trans value") } intmat_trans <- trans$transform(intmat) diff --git a/tests/testthat/test-plot-GCIMSChromatogram.R b/tests/testthat/test-plot-GCIMSChromatogram.R new file mode 100644 index 0000000..5276e89 --- /dev/null +++ b/tests/testthat/test-plot-GCIMSChromatogram.R @@ -0,0 +1,45 @@ +test_that("plot() on a GCIMSChromatogram returns a ggplot with data, title and labels from the object", { + ch <- GCIMSChromatogram(retention_time = 1:5, intensity = c(1, 2, 5, 2, 1), description = "Chrom1") + + p <- plot(ch) + + expect_s3_class(p, "ggplot") + expect_equal(p$data$x, rtime(ch)) + expect_equal(p$data$y, intensity(ch), ignore_attr = TRUE) + expect_equal(p$labels$title, "Chrom1") + expect_equal(p$labels$x, "Retention time (s)") + expect_equal(p$labels$y, "Intensity (a.u.)") +}) + +test_that("plot() on a GCIMSChromatogram builds a single-value drift time subtitle", { + ch <- GCIMSChromatogram( + retention_time = 1:5, intensity = c(1, 2, 5, 2, 1), + drift_time_idx = 3L, drift_time_ms = 3.5 + ) + + p <- plot(ch) + + expect_equal(as.character(p$labels$subtitle), "Drift time 3.5 ms") +}) + +test_that("plot() on a GCIMSChromatogram builds a range drift time subtitle for multiple values", { + ch <- GCIMSChromatogram( + retention_time = 1:5, intensity = c(1, 2, 5, 2, 1), + drift_time_idx = c(3L, 4L), drift_time_ms = c(3, 4) + ) + + p <- plot(ch) + + expect_equal(as.character(p$labels$subtitle), "Drift time 3 - 4 ms") +}) + +test_that("plot() on a GCIMSChromatogram has no subtitle when drift_time_ms is empty", { + ch <- GCIMSChromatogram( + retention_time = 1:5, intensity = c(1, 2, 5, 2, 1), + drift_time_idx = integer(0), drift_time_ms = numeric(0) + ) + + p <- plot(ch) + + expect_null(p$labels$subtitle) +}) diff --git a/tests/testthat/test-plot-GCIMSSample.R b/tests/testthat/test-plot-GCIMSSample.R new file mode 100644 index 0000000..4687f3f --- /dev/null +++ b/tests/testthat/test-plot-GCIMSSample.R @@ -0,0 +1,219 @@ +gauss <- function(x, center, height, sd) height * exp(-(x - center)^2 / (2 * sd^2)) + +make_sample <- function() { + dt <- seq(0, 4, by = 0.02) # 201 pts + rt <- seq(0, 50, by = 0.5) # 101 pts + int_mat <- matrix(50, nrow = length(dt), ncol = length(rt)) + + outer(gauss(dt, 2, 500, 0.1), gauss(rt, 25, 1, 3)) + GCIMSSample(drift_time = dt, retention_time = rt, data = int_mat) +} + +test_that("cubic_root_trans() transforms/inverts values symmetrically, including negatives", { + tr <- cubic_root_trans() + + expect_equal(tr$name, "cubic_root") + expect_equal(tr$transform(8), 2) + expect_equal(tr$transform(-8), -2) + expect_equal(tr$inverse(tr$transform(c(-27, -8, 0, 8, 27))), c(-27, -8, 0, 8, 27)) +}) + +test_that("cubic_root_trans()'s breaks() handles a normal range and all-non-finite input", { + tr <- cubic_root_trans() + + b <- tr$breaks(c(-8, 8)) + expect_true(length(b) > 0) + expect_true(all(is.finite(b))) + + expect_equal(tr$breaks(c(NA, NaN, Inf)), numeric(0)) +}) + +test_that("as.data.frame() on a GCIMSSample melts the intensity matrix into long format", { + s <- GCIMSSample(drift_time = 1:2, retention_time = 1:3, data = matrix(1:6, nrow = 2, ncol = 3)) + + df <- as.data.frame(s) + + expect_named(df, c("dt_ms", "rt_s", "Intensity")) + expect_equal(nrow(df), 6L) + expect_equal(df$Intensity, 1:6) +}) + +test_that("as.data.frame() on a GCIMSSample respects dt_range/rt_range and row.names", { + s <- GCIMSSample(drift_time = 1:2, retention_time = 1:3, data = matrix(1:6, nrow = 2, ncol = 3)) + + df <- as.data.frame(s, dt_range = c(1, 1)) + expect_equal(nrow(df), 3L) + + df_rn <- as.data.frame(s, row.names = paste0("r", 1:6)) + expect_equal(rownames(df_rn), paste0("r", 1:6)) +}) + +test_that("plot() on a GCIMSSample returns a ggplot with the expected labels and axis limits", { + s <- make_sample() + + p <- plot(s) + + expect_s3_class(p, "ggplot") + expect_equal(p$labels$x, "Drift time (ms)") + expect_equal(p$labels$y, "Retention time (s)") + expect_equal(p$labels$fill, "Intensity (a.u.)") +}) + +test_that("plot() on a GCIMSSample restricts the plotted range to dt_range/rt_range", { + s <- make_sample() + + p_full <- plot(s) + p_sub <- plot(s, dt_range = c(1, 2), rt_range = c(10, 20)) + + b_full <- ggplot2::ggplot_build(p_full) + b_sub <- ggplot2::ggplot_build(p_sub) + + full_x_range <- diff(b_full$layout$panel_params[[1]]$x.range) + sub_x_range <- diff(b_sub$layout$panel_params[[1]]$x.range) + expect_lt(sub_x_range, full_x_range) +}) + +test_that("plot(remove_baseline = TRUE) on a GCIMSSample does not error once a baseline is estimated", { + s <- make_sample() + s_b <- estimateBaseline(s, dt_peak_fwhm_ms = 0.3, dt_region_multiplier = 6, rt_length_s = 10, remove = FALSE) + + p <- plot(s_b, remove_baseline = TRUE) + + expect_s3_class(p, "ggplot") +}) + +test_that("plot() on a GCIMSSample accepts trans as a string, or as a transform object directly", { + s <- make_sample() + + # Regression test: mat_to_gplot() checked inherits(trans, "trans"), the + # legacy S3 class name for scales transform objects. scales >= 1.3.0 + # renamed it to "transform", which made any non-string trans (including + # this package's own cubic_root_trans()) always fail with "unknown trans + # value". + expect_s3_class(plot(s, trans = "cubic_root"), "ggplot") + expect_s3_class(plot(s, trans = "log10"), "ggplot") + expect_s3_class(plot(s, trans = cubic_root_trans()), "ggplot") + expect_s3_class(plot(s, trans = scales::identity_trans()), "ggplot") +}) + +test_that("plot() on a GCIMSSample errors clearly for an invalid trans value", { + s <- make_sample() + + expect_error(plot(s, trans = "not_a_real_transform"), "unknown trans value") + expect_error(plot(s, trans = 123), "unknown trans value") +}) + +test_that("overlay_peaklist() with a single color returns a rect layer, plus a point or blank layer for the apex", { + peaklist <- data.frame( + SampleID = c("s1", "s1", "s2"), + dt_min_ms = c(1, 3, 2), dt_max_ms = c(2, 4, 3), + rt_min_s = c(1, 3, 2), rt_max_s = c(2, 4, 3) + ) + + out_no_apex <- overlay_peaklist(peaklist) + expect_length(out_no_apex, 2) + expect_s3_class(out_no_apex[[1]]$geom, "GeomRect") + expect_s3_class(out_no_apex[[2]]$geom, "GeomBlank") + + peaklist$dt_apex_ms <- c(1.5, 3.5, 2.5) + peaklist$rt_apex_s <- c(1.5, 3.5, 2.5) + out_apex <- overlay_peaklist(peaklist) + expect_length(out_apex, 2) + expect_s3_class(out_apex[[1]]$geom, "GeomRect") + expect_s3_class(out_apex[[2]]$geom, "GeomPoint") +}) + +test_that("overlay_peaklist() accepts a literal color name for color_by", { + peaklist <- data.frame( + SampleID = "s1", dt_min_ms = 1, dt_max_ms = 2, rt_min_s = 1, rt_max_s = 2 + ) + + out <- overlay_peaklist(peaklist, color_by = "blue") + + expect_length(out, 2) +}) + +test_that("overlay_peaklist() with color_by as a column adds a color scale and, past 10 groups, hides the legend", { + peaklist <- data.frame( + SampleID = c("s1", "s2"), + dt_min_ms = c(1, 2), dt_max_ms = c(2, 3), rt_min_s = c(1, 2), rt_max_s = c(2, 3) + ) + + out <- overlay_peaklist(peaklist, color_by = "SampleID") + geom_classes <- purrr::map_chr(out, function(l) if (inherits(l, "Layer")) class(l$geom)[1] else class(l)[1]) + expect_equal(geom_classes, c("GeomRect", "GeomBlank", "GeomBlank", "ScaleDiscrete")) + + many <- data.frame( + SampleID = paste0("s", 1:12), + dt_min_ms = 1:12, dt_max_ms = 2:13, rt_min_s = 1:12, rt_max_s = 2:13 + ) + out_many <- overlay_peaklist(many, color_by = "SampleID") + geom_classes_many <- purrr::map_chr(out_many, function(l) if (inherits(l, "Layer")) class(l$geom)[1] else class(l)[1]) + expect_equal(geom_classes_many, c("GeomRect", "GeomBlank", "GeomBlank", "ScaleDiscrete", "Guides")) +}) + +test_that("overlay_peaklist() with color_by as a column AND apex columns adds a point layer too", { + peaklist <- data.frame( + SampleID = c("s1", "s2"), + dt_min_ms = c(1, 2), dt_max_ms = c(2, 3), rt_min_s = c(1, 2), rt_max_s = c(2, 3), + dt_apex_ms = c(1.5, 2.5), rt_apex_s = c(1.5, 2.5) + ) + + out <- overlay_peaklist(peaklist, color_by = "SampleID") + geom_classes <- purrr::map_chr(out, function(l) if (inherits(l, "Layer")) class(l$geom)[1] else class(l)[1]) + + expect_equal(geom_classes, c("GeomRect", "GeomBlank", "GeomPoint", "ScaleDiscrete")) +}) + +test_that("overlay_peaklist() recycles a palette smaller than the number of groups", { + many <- data.frame( + SampleID = paste0("s", 1:5), + dt_min_ms = 1:5, dt_max_ms = 2:6, rt_min_s = 1:5, rt_max_s = 2:6 + ) + + expect_no_error( + overlay_peaklist(many, color_by = "SampleID", palette = c("red", "blue")) + ) +}) + +test_that("overlay_peaklist() coerces a non-data.frame peaklist (e.g. S4Vectors::DataFrame)", { + peaklist_df <- S4Vectors::DataFrame(SampleID = "s1", dt_min_ms = 1, dt_max_ms = 2, rt_min_s = 1, rt_max_s = 2) + + out <- overlay_peaklist(peaklist_df) + + expect_length(out, 2) +}) + +test_that("overlay_peaklist() merges in pdata by SampleID when given", { + peaklist <- data.frame( + SampleID = c("s1", "s2"), + dt_min_ms = c(1, 2), dt_max_ms = c(2, 3), rt_min_s = c(1, 2), rt_max_s = c(2, 3) + ) + pdata <- data.frame(SampleID = c("s1", "s2"), Group = c("A", "B")) + + out <- overlay_peaklist(peaklist, pdata = pdata, color_by = "Group") + + expect_length(out, 4) +}) + +test_that("mat_to_gplot() derives dt/rt limits from the matrix dimnames when not given explicitly", { + m <- matrix(1:6, nrow = 2, ncol = 3, dimnames = list(c("1", "2"), c("10", "20", "30"))) + + p <- mat_to_gplot(m) + + b <- ggplot2::ggplot_build(p) + expect_equal(b$layout$panel_params[[1]]$x.range, c(0.95, 2.05)) + expect_equal(b$layout$panel_params[[1]]$y.range, c(9, 31)) +}) + +test_that("overlay_peaklist() validates color_by and mapping_roi", { + peaklist <- data.frame( + SampleID = "s1", dt_min_ms = 1, dt_max_ms = 2, rt_min_s = 1, rt_max_s = 2 + ) + + expect_error(overlay_peaklist(peaklist, color_by = "not_a_col_or_color"), "neither a valid color name") + expect_error(overlay_peaklist(peaklist, color_by = 5), "should be .* a string") + expect_error( + overlay_peaklist(peaklist, mapping_roi = c(a = "a", b = "b", c = "c", d = "d")), + "mapping_roi should be a named vector" + ) +}) diff --git a/tests/testthat/test-plot-GCIMSSpectrum.R b/tests/testthat/test-plot-GCIMSSpectrum.R new file mode 100644 index 0000000..e778763 --- /dev/null +++ b/tests/testthat/test-plot-GCIMSSpectrum.R @@ -0,0 +1,45 @@ +test_that("plot() on a GCIMSSpectrum returns a ggplot with data, title and labels from the object", { + sp <- GCIMSSpectrum(drift_time = 1:5, intensity = c(1, 2, 5, 2, 1), description = "Spec1") + + p <- plot(sp) + + expect_s3_class(p, "ggplot") + expect_equal(p$data$x, dtime(sp)) + expect_equal(p$data$y, intensity(sp), ignore_attr = TRUE) + expect_equal(p$labels$title, "Spec1") + expect_equal(p$labels$x, "Drift time (ms)") + expect_equal(p$labels$y, "Intensity (a.u.)") +}) + +test_that("plot() on a GCIMSSpectrum builds a single-value retention time subtitle", { + sp <- GCIMSSpectrum( + drift_time = 1:5, intensity = c(1, 2, 5, 2, 1), + retention_time_idx = 3L, retention_time_s = 3.5 + ) + + p <- plot(sp) + + expect_equal(as.character(p$labels$subtitle), "Retention time 3.5 s") +}) + +test_that("plot() on a GCIMSSpectrum builds a range retention time subtitle for multiple values", { + sp <- GCIMSSpectrum( + drift_time = 1:5, intensity = c(1, 2, 5, 2, 1), + retention_time_idx = c(3L, 4L), retention_time_s = c(3, 4) + ) + + p <- plot(sp) + + expect_equal(as.character(p$labels$subtitle), "Retention time 3 - 4 s") +}) + +test_that("plot() on a GCIMSSpectrum has no subtitle when retention_time_s is empty", { + sp <- GCIMSSpectrum( + drift_time = 1:5, intensity = c(1, 2, 5, 2, 1), + retention_time_idx = integer(0), retention_time_s = numeric(0) + ) + + p <- plot(sp) + + expect_null(p$labels$subtitle) +}) diff --git a/tests/testthat/test-utils-plot.R b/tests/testthat/test-utils-plot.R new file mode 100644 index 0000000..2a3dc77 --- /dev/null +++ b/tests/testthat/test-utils-plot.R @@ -0,0 +1,49 @@ +test_that("mat_to_nativeRaster() encodes a matrix into a nativeRaster with the right shape", { + colormap <- farver::encode_native(c("#000000", "#333333", "#666666", "#999999", "#CCCCCC", "#FFFFFF")) + m <- matrix(1:6, nrow = 2, ncol = 3) + + nr <- mat_to_nativeRaster(m, colormap) + + expect_s3_class(nr, "nativeRaster") + expect_equal(dim(nr), c(ncol(m), nrow(m))) + expect_equal(attr(nr, "channels"), 4L) + # more than one color of the map should show up for a varied matrix: + expect_gt(length(unique(as.vector(unclass(nr)))), 1L) + expect_true(all(unique(as.vector(unclass(nr))) %in% colormap)) +}) + +test_that("mat_to_nativeRaster() is deterministic", { + colormap <- farver::encode_native(c("#000000", "#FFFFFF")) + m <- matrix(1:6, nrow = 2, ncol = 3) + + expect_identical(mat_to_nativeRaster(m, colormap), mat_to_nativeRaster(m, colormap)) +}) + +test_that("mat_to_nativeRaster() accepts a character colormap, giving the same result as pre-encoded colors", { + m <- matrix(1:6, nrow = 2, ncol = 3) + chr_colors <- c("#000000", "#333333", "#666666", "#999999", "#CCCCCC", "#FFFFFF") + + nr_chr <- mat_to_nativeRaster(m, chr_colors) + nr_num <- mat_to_nativeRaster(m, farver::encode_native(chr_colors)) + + expect_identical(nr_chr, nr_num) +}) + +test_that("mat_to_nativeRaster() handles a zero-length matrix", { + colormap <- farver::encode_native(c("#000000", "#FFFFFF")) + + nr <- mat_to_nativeRaster(matrix(numeric(0), nrow = 0, ncol = 0), colormap) + + expect_s3_class(nr, "nativeRaster") + expect_equal(dim(nr), c(0L, 0L)) + expect_equal(attr(nr, "channels"), 4L) +}) + +test_that("plot_interactive() wraps a ggplot into a plotly widget", { + d <- data.frame(x = c(1, 2), y = c(1, 2)) + plt <- ggplot2::ggplot(d) + ggplot2::geom_point(ggplot2::aes(x = .data$x, y = .data$y)) + + out <- plot_interactive(plt) + + expect_s3_class(out, "plotly") +})