From a729e169b34460b7001d79165d6a31d37f703f57 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 1 Sep 2022 13:50:30 -0700 Subject: [PATCH 1/6] Tweak branch length prep and utility functions --- R/prep.branch.lengths.R | 10 +++++++--- tests/testthat/test-prep.branch.lengths.R | 8 ++++---- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/R/prep.branch.lengths.R b/R/prep.branch.lengths.R index fb81392..ca8f2df 100644 --- a/R/prep.branch.lengths.R +++ b/R/prep.branch.lengths.R @@ -1,4 +1,4 @@ -get.branch.length.colnames <- function(num.columns) { +get.default.branch.length.colnames <- function(num.columns) { if (num.columns > 0) { sapply( 1:num.columns, @@ -13,7 +13,7 @@ get.branch.length.colnames <- function(num.columns) { get.default.branch.lengths <- function(num.rows) { lengths <- data.frame(a = rep(1, times = num.rows)); - colnames(lengths) <- get.branch.length.colnames(1); + colnames(lengths) <- get.default.branch.length.colnames(1); return(lengths); } @@ -22,6 +22,10 @@ validate.branch.colname <- function(column.name) { grepl('length', column.name); } +get.branch.length.colnames <- function(col.names) { + Filter(validate.branch.colname, col.names); + } + validate.branch.length.values <- function(length.column) { return(tryCatch({ numeric.values <- as.numeric(length.column); @@ -76,7 +80,7 @@ prep.branch.lengths <- function(tree.df) { if (length(length.cols) > 0) { lengths.df <- data.frame(tree.df[, length.cols]); - colnames(lengths.df) <- get.branch.length.colnames(length(length.cols)); + colnames(lengths.df) <- get.default.branch.length.colnames(length(length.cols)); return(lengths.df); } else { diff --git a/tests/testthat/test-prep.branch.lengths.R b/tests/testthat/test-prep.branch.lengths.R index 31d2352..0fab239 100644 --- a/tests/testthat/test-prep.branch.lengths.R +++ b/tests/testthat/test-prep.branch.lengths.R @@ -45,21 +45,21 @@ test_that( }); test_that( - 'get.branch.length.colnames returns the correct length', { + 'get.default.branch.length.colnames returns the correct length', { expected.length <- 5; expect_length( - get.branch.length.colnames(expected.length), + get.default.branch.length.colnames(expected.length), expected.length ); }); test_that( - 'get.branch.length.colnames handles length 0', { + 'get.default.branch.length.colnames handles length 0', { expected.length <- 0; expect_length( - get.branch.length.colnames(expected.length), + get.default.branch.length.colnames(expected.length), expected.length ); }); From d4b0cff783fd1b1f33ca3740c8aec7c1b7c88858 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 1 Sep 2022 13:51:21 -0700 Subject: [PATCH 2/6] Y-axis position prep function --- R/prep.tree.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/prep.tree.R b/R/prep.tree.R index 0b45152..c7e79a8 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -143,3 +143,14 @@ check.parent.values <- function(node.names, parent.col) { } )); } + +get.y.axis.position <- function(tree.colnames) { + num.branch.length.cols <- length(get.branch.length.colnames(tree.colnames)); + + y.axis.position <- if (num.branch.length.cols == 1) 'left' else { + if (num.branch.length.cols > 1) 'both' else 'none'; + }; + + return(y.axis.position); + } + From 13c108643aa7f8da633f1452c9ff1eaa1adb7a95 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 1 Sep 2022 13:51:48 -0700 Subject: [PATCH 3/6] Y-axis position fix --- R/SRCGrob.R | 6 +----- R/prep.tree.R | 2 -- 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/R/SRCGrob.R b/R/SRCGrob.R index abe13d6..557a154 100644 --- a/R/SRCGrob.R +++ b/R/SRCGrob.R @@ -40,15 +40,11 @@ SRCGrob <- function( gene.line.dist <- prep.gene.line.dist(gene.line.dist); yat <- prep.yat(yat); - - yaxis.position <- if (is.null(yaxis2.label)) 'left' else { - if (!is.null(yaxis1.label)) 'both' else 'right'; - }; + yaxis.position <- get.y.axis.position(colnames(tree)); inputs <- prep.tree( tree, genes, - yaxis.position, colour.scheme = colour.scheme ); diff --git a/R/prep.tree.R b/R/prep.tree.R index c7e79a8..adce858 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -2,7 +2,6 @@ prep.tree <- function( tree.df, genes.df, bells = TRUE, - axis.type = 'left', colour.scheme ) { @@ -153,4 +152,3 @@ get.y.axis.position <- function(tree.colnames) { return(y.axis.position); } - From 6a842236f696b04ca767c1e5a5c759469d80a5c9 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 1 Sep 2022 14:07:33 -0700 Subject: [PATCH 4/6] Unit tests for y-axis position prep --- tests/testthat/test-prep.tree.R | 39 +++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/tests/testthat/test-prep.tree.R b/tests/testthat/test-prep.tree.R index 8589879..dc8e5f1 100644 --- a/tests/testthat/test-prep.tree.R +++ b/tests/testthat/test-prep.tree.R @@ -205,3 +205,42 @@ test_that( expect_true(check.parent.values(node.names, parents)); }); + +test_that( + 'get.y.axis.position handles a single branch length column', { + valid.colname <- 'length1'; + cols <- c(valid.colname, 'invalid'); + + yaxis.position <- get.y.axis.position(cols); + expected.position <- 'left'; + + expect_equal(yaxis.position, expected.position); + }); + +test_that( + 'get.y.axis.position handles multiple valid branch length columns', { + valid.colnames <- sapply( + 1:3, + FUN = function(x) { paste0('length', x); } + ); + + cols <- c( + valid.colnames, + 'invalid.col' + ); + + yaxis.position <- get.y.axis.position(cols); + expected.position <- 'both'; + + expect_equal(yaxis.position, expected.position); + }); + +test_that( + 'get.y.axis.position handles no valid branch length columns', { + cols <- c('parent'); + + yaxis.position <- get.y.axis.position(cols); + expected.position <- 'none'; + + expect_equal(yaxis.position, expected.position); + }); \ No newline at end of file From 256bd3d400f6a27fca0aadfafd44d08e180bf4d2 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 1 Sep 2022 14:08:25 -0700 Subject: [PATCH 5/6] Update changelog --- DESCRIPTION | 2 +- NEWS | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 19afa1b..72237f2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Function to Generate Publication Quality Phylogenetic Tree Plots Version: 1.0.0 -Date: 2022-08-03 +Date: 2022-09-01 Authors@R: c( person("Paul Boutros", role = "cre", email = "PBoutros@mednet.ucla.edu"), person("Adriana Salcedo", role = "aut"), diff --git a/NEWS b/NEWS index 823c714..3339d9d 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -CancerEvolutionVisualization 1.0.0 2022-08-03 (Dan Knight) +CancerEvolutionVisualization 1.0.0 2022-09-01 (Dan Knight) ADDED * Documentation for default colour scheme @@ -6,6 +6,7 @@ ADDED UPDATE * Fixed discrepancies between documentation and code * Fixed bug related to referencing an uninitialized variable +* Fixed y-axis positioning bug * Updated packaging/development dependencies From 4545b74a98307bb143d02c709c8a27baeb864b79 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 2 Sep 2022 14:49:19 -0700 Subject: [PATCH 6/6] Fix linting errors --- tests/testthat/test-prep.tree.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-prep.tree.R b/tests/testthat/test-prep.tree.R index dc8e5f1..7263e7d 100644 --- a/tests/testthat/test-prep.tree.R +++ b/tests/testthat/test-prep.tree.R @@ -221,7 +221,9 @@ test_that( 'get.y.axis.position handles multiple valid branch length columns', { valid.colnames <- sapply( 1:3, - FUN = function(x) { paste0('length', x); } + FUN = function(x) { + paste0('length', x); + } ); cols <- c( @@ -243,4 +245,4 @@ test_that( expected.position <- 'none'; expect_equal(yaxis.position, expected.position); - }); \ No newline at end of file + });