diff --git a/R/make.clone.tree.grobs.R b/R/make.clone.tree.grobs.R index 1707097..e665222 100644 --- a/R/make.clone.tree.grobs.R +++ b/R/make.clone.tree.grobs.R @@ -201,7 +201,8 @@ make.clone.tree.grobs <- function( xaxis.label = xaxis.label, yaxis1.label = yaxis1.label, yaxis2.label = yaxis2.label, - plotting.direction = plotting.direction + plotting.direction = plotting.direction, + add.polygons = add.polygons ); if (scale.bar) { diff --git a/R/set.up.plot.area.R b/R/set.up.plot.area.R index 292fef3..545cc1e 100644 --- a/R/set.up.plot.area.R +++ b/R/set.up.plot.area.R @@ -148,6 +148,14 @@ add.axis.label <- function(axisGrob, axis.label, axis.position, axis.label.cex, return(axis.gTree); } +is.horizontal.direction <- function(plotting.direction) { + if (is.numeric(plotting.direction)) { + return(isTRUE(all.equal(plotting.direction %% 180, 90))); + } + + return(plotting.direction %in% c('left', 'right')); + } + add.axes <- function( clone.out, yat, @@ -161,14 +169,19 @@ add.axes <- function( no.ccf = FALSE, axis.label.cex = list(x = 1.55, y = 1.55), axis.cex = list(x = 1, y = 1), - plotting.direction = 'down' + plotting.direction = 'down', + add.polygons = FALSE ) { # Skip x-axis if plotting.direction is numeric (custom angle) draw.xaxis <- !is.numeric(plotting.direction); - if (plotting.direction != 'down') { - message('Non-vertical plotting direction detected; skipping (nSNV) x-axis rendering.'); - yaxis.position <- 'none'; + + # A horizontal fish plot lays its clone polygons out along the vertical + # axis, so the second (nSNV) scale no longer corresponds to anything the + # reader can measure. Drop that axis only -- the first y-axis stays, and + # every other plotting direction keeps both. + if (add.polygons && identical(yaxis.position, 'both') && is.horizontal.direction(plotting.direction)) { + yaxis.position <- 'left'; } if (!no.ccf && 'ccf' %in% colnames(clone.out$v) && all(!is.na(clone.out$v$ccf)) && draw.xaxis) { add.xaxis( diff --git a/tests/testthat/data/branching.dendrogram.plots.Rda b/tests/testthat/data/branching.dendrogram.plots.Rda index 5ffcae2..7d4c00f 100644 Binary files a/tests/testthat/data/branching.dendrogram.plots.Rda and b/tests/testthat/data/branching.dendrogram.plots.Rda differ diff --git a/tests/testthat/data/branching.fixed.plots.Rda b/tests/testthat/data/branching.fixed.plots.Rda index 9adde81..b99b5a2 100644 Binary files a/tests/testthat/data/branching.fixed.plots.Rda and b/tests/testthat/data/branching.fixed.plots.Rda differ diff --git a/tests/testthat/data/branching.radial.plots.Rda b/tests/testthat/data/branching.radial.plots.Rda index a42ad71..fc96929 100644 Binary files a/tests/testthat/data/branching.radial.plots.Rda and b/tests/testthat/data/branching.radial.plots.Rda differ diff --git a/tests/testthat/data/complex.plots.Rda b/tests/testthat/data/complex.plots.Rda index 7b122ca..ab85097 100644 Binary files a/tests/testthat/data/complex.plots.Rda and b/tests/testthat/data/complex.plots.Rda differ diff --git a/tests/testthat/data/fish.plots.Rda b/tests/testthat/data/fish.plots.Rda index a0d641c..74cc823 100644 Binary files a/tests/testthat/data/fish.plots.Rda and b/tests/testthat/data/fish.plots.Rda differ diff --git a/tests/testthat/data/linear.plots.Rda b/tests/testthat/data/linear.plots.Rda index 86c5a8d..e32baed 100644 Binary files a/tests/testthat/data/linear.plots.Rda and b/tests/testthat/data/linear.plots.Rda differ diff --git a/tests/testthat/test-axis-plotting-direction.R b/tests/testthat/test-axis-plotting-direction.R new file mode 100644 index 0000000..7075aac --- /dev/null +++ b/tests/testthat/test-axis-plotting-direction.R @@ -0,0 +1,125 @@ +# Regression tests for the axis loss introduced by commit db616d9 (PR #190). +# +# That commit added, in add.axes(): +# +# if (plotting.direction != 'down') { +# message('Non-vertical plotting direction detected; skipping (nSNV) x-axis rendering.'); +# yaxis.position <- 'none'; +# } +# +# The stated intent was to drop the nSNV axis for horizontal fish plots, but: +# * it set yaxis.position, removing the Y-axes, while the message says x-axis; +# * it fired for every direction other than 'down', not just horizontal ones; +# * `plotting.direction != 'down'` compares numeric to character, so R coerces +# 30 to "30" and numeric angles tripped it too. +# +# Result: up / left / right / 30 / 45 all rendered with zero y-axes. + +axis.names <- function(grob) { + grob$childrenOrder[grepl('axis', grob$childrenOrder)]; + } + +two.length.tree <- function() { + load(test_path('data', 'linear.data.Rda')); + linear.test.data$tree[, c('parent', 'length.1', 'length.2')]; + } + +test_that('y-axes are drawn for every plotting direction (regression, PR #190)', { + tree <- two.length.tree(); + + for (direction in list('down', 'up', 'left', 'right', 30, 45, -60)) { + plt <- suppressMessages(SRCGrob( + tree, + yaxis2.label = '', + plotting.direction = direction + )); + + expect_setequal(axis.names(plt), c('axis.left', 'axis.right')); + } + }); + +test_that('a numeric direction is not string-compared against "down" (PR #190)', { + # The guard used `plotting.direction != 'down'`, which coerces 30 to "30". + # Any numeric angle must behave like the named directions here. + tree <- two.length.tree(); + + numeric.axes <- axis.names(suppressMessages( + SRCGrob(tree, yaxis2.label = '', plotting.direction = 30) + )); + named.axes <- axis.names(suppressMessages( + SRCGrob(tree, yaxis2.label = '', plotting.direction = 'down') + )); + + expect_setequal(numeric.axes, named.axes); + }); + +test_that('is.horizontal.direction classifies directions correctly', { + expect_true(is.horizontal.direction('left')); + expect_true(is.horizontal.direction('right')); + expect_true(is.horizontal.direction(90)); + expect_true(is.horizontal.direction(270)); + expect_true(is.horizontal.direction(-90)); + + expect_false(is.horizontal.direction('down')); + expect_false(is.horizontal.direction('up')); + expect_false(is.horizontal.direction(0)); + expect_false(is.horizontal.direction(30)); + expect_false(is.horizontal.direction(180)); + }); + +# tests/testthat/data/fish.data.Rda has no length columns at all +# (get.y.axis.position returns 'none'), so it never had an nSNV axis and cannot +# exercise the suppression. Build a fish plot that actually has two branch +# length scales. +two.length.fish.tree <- function() { + data.frame( + parent = c(NA, '1', '1'), + node.id = c('1', '2', '3'), + length.1 = c(NA, 20, 30), + length.2 = c(NA, 200, 300), + CP = c(0.9, 0.5, 0.4), + stringsAsFactors = FALSE + ); + } + +test_that('a vertical fish plot keeps both y-axes and the CCF axis (PR #190)', { + plt <- suppressMessages(SRCGrob( + two.length.fish.tree(), + yaxis2.label = 'nSNV' + )); + + expect_setequal( + axis.names(plt), + c('axis.bottom', 'axis.left', 'axis.right') + ); + }); + +test_that('a horizontal fish plot drops only the nSNV axis (PR #190 intent)', { + # db616d9's stated goal: a horizontal fish plot keeps its first y-axis and + # loses only the second. It must not lose every axis. + for (direction in c('left', 'right')) { + plt <- suppressMessages(SRCGrob( + two.length.fish.tree(), + yaxis2.label = 'nSNV', + plotting.direction = direction + )); + + expect_length(axis.names(plt), 2); + expect_true(length(axis.names(plt)) > 0); + } + }); + +test_that('a non-fish tree keeps both y-axes when horizontal (PR #190)', { + # Suppression is scoped to fish plots. A plain two-length tree flowing + # sideways still needs both scales. + tree <- two.length.fish.tree(); + tree$CP <- NULL; + + plt <- suppressMessages(SRCGrob( + tree, + yaxis2.label = 'nSNV', + plotting.direction = 'right' + )); + + expect_true('axis.right' %in% axis.names(plt)); + }); diff --git a/tests/testthat/test-linear.R b/tests/testthat/test-linear.R index 1d03531..7f3d194 100644 --- a/tests/testthat/test-linear.R +++ b/tests/testthat/test-linear.R @@ -15,7 +15,11 @@ test_that( main.cex = 1.55, main.y = 0.3, size.units = 'inches', - horizontal.padding = -1, + # horizontal.padding = -1 squeezed the plot until the gene + # annotations rendered as unreadable specks and the axis ticks + # crowded over the polygon (issue #186). A positive padding keeps + # the axes clear of the polygon and the gene text legible. + horizontal.padding = 1, add.normal = TRUE, ); expect_true(compare.trees(linear.example, result.tree)); diff --git a/tests/update-snapshots.R b/tests/update-snapshots.R index 81a9999..3ae5519 100644 --- a/tests/update-snapshots.R +++ b/tests/update-snapshots.R @@ -11,14 +11,34 @@ # The script re-installs the package from source first so the snapshots are # always built against the current code. -pkg.root <- normalizePath(file.path(dirname(sys.frame(1)$ofile), '..'), mustWork = FALSE) -if (!nzchar(pkg.root) || pkg.root == '.') { - pkg.root <- getwd() +get.script.dir <- function() { + # Rscript exposes the script path as --file=; sys.frames() only carries + # $ofile when the script is source()d. sys.frame(1) errors outright under + # Rscript ("not that many frames on the stack"), which broke the usage + # documented above. + file.arg <- grep('^--file=', commandArgs(trailingOnly = FALSE), value = TRUE); + if (1 == length(file.arg)) { + return(dirname(normalizePath(sub('^--file=', '', file.arg)))); + } + + ofile <- if (length(sys.frames())) sys.frames()[[1]]$ofile else NULL; + if (!is.null(ofile)) { + return(dirname(normalizePath(ofile))); + } + + return(NULL); } -message('Package root: ', pkg.root) -message('Installing package from source...') -devtools::load_all(pkg.root, quiet = TRUE) +script.dir <- get.script.dir(); +pkg.root <- if (is.null(script.dir)) { + getwd(); +} else { + normalizePath(file.path(script.dir, '..'), mustWork = FALSE); + } + +message('Package root: ', pkg.root); +message('Loading package from source...'); +pkgload::load_all(pkg.root, quiet = TRUE) data.dir <- file.path(pkg.root, 'tests', 'testthat', 'data') @@ -139,7 +159,8 @@ local({ main.cex = 1.55, main.y = 0.3, size.units = 'inches', - horizontal.padding = -1, + # See test-linear.R: -1 collapsed the gene annotations (issue #186). + horizontal.padding = 1, add.normal = TRUE )