Restore y-axes for non-default plotting directions and fix the linear fixture padding

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) {

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(

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));
+    });

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));

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
         )