diff --git a/DESCRIPTION b/DESCRIPTION index 585c84a..6fb9fff 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots Version: 2.1.0 -Date: 2024-07-31 +Date: 2024-08-05 Authors@R: c( person("Paul Boutros", role = "cre", email = "PBoutros@mednet.ucla.edu"), person("Adriana Salcedo", role = "aut"), diff --git a/NEWS.md b/NEWS.md index 9d9b4a9..e2f0ea9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,22 +1,18 @@ -# CancerEvolutionVisualization 2.1.0 (2024-07-31) +# CancerEvolutionVisualization 2.1.0 (2024-08-05) ## Added * Optional "spread" column to control node/branch spacing * Plotting functions to visualize the distribution of clones across the genome. * Documentation for heatmaps and clone-genome distirbution plor +* Option to disable node drawing with node-by-node control ## Update * Fixed angle calculation bug where child angles do not follow their parent angle, instead moving "downward" at 0 degrees. * Updated package metadata and README -<<<<<<< HEAD:NEWS.md * Set default parameters for heatmaps, defaulting too BPG defaults unless necessary * Updated changelog format to NEWS.md Markdown format -======= * Refactored use of plyr/dplyr and stringr functions to remove dependencies -* Set default parameters for heatmaps, defaulting to BPG defaults unless necessary - ->>>>>>> 2424b7934e815dcc02cce5482c1b1c16bf319a09:NEWS # CancerEvolutionVisualization 2.0.1 (2023-11-17) diff --git a/R/SRCGrob.R b/R/SRCGrob.R index 2b9ee83..e9a1fa6 100644 --- a/R/SRCGrob.R +++ b/R/SRCGrob.R @@ -20,7 +20,6 @@ SRCGrob <- function( node.radius = 0.1, node.text.line.dist = 0.1, colour.scheme = CancerEvolutionVisualization::colours, - draw.nodes = TRUE, add.normal = FALSE, use.radians = FALSE, normal.cex = 1, @@ -99,7 +98,6 @@ SRCGrob <- function( axis.cex = axis.cex, xaxis.label = xaxis.label, min.width = min.width, - draw.nodes = draw.nodes, label.nodes = label.nodes, node.col = node.col, label.cex = label.cex, diff --git a/R/add.nodes.R b/R/add.nodes.R index 49e8b53..82d4855 100644 --- a/R/add.nodes.R +++ b/R/add.nodes.R @@ -29,19 +29,20 @@ add.node.ellipse <- function( ); node.grob.name <- 'node.polygons'; + circle.nodes <- clone.out$v[clone.out$v$draw.node, ]; - #more precise than circleGrob + # More precise than circleGrob circle.grobs <- ellipseGrob( name = node.grob.name, - x = unit(clone.out$v$x, 'native'), - y = unit(clone.out$v$y, 'native'), - size = node.radius * (1 + 0.2 * nchar(clone.out$v$plot.lab)), - ar = 1 - log2(nchar(clone.out$v$plot.lab)) / 10, + x = unit(circle.nodes$x, 'native'), + y = unit(circle.nodes$y, 'native'), + size = node.radius * (1 + 0.2 * nchar(circle.nodes$plot.lab)), + ar = 1 - log2(nchar(circle.nodes$plot.lab)) / 10, gp = gpar( - fill = clone.out$v$node.colour, - col = clone.out$v$border.colour, - lty = clone.out$v$border.type, - lwd = clone.out$v$border.width + fill = circle.nodes$node.colour, + col = circle.nodes$border.colour, + lty = circle.nodes$border.type, + lwd = circle.nodes$border.width ), angle = pi / 2, position.units = 'native', @@ -58,11 +59,11 @@ add.node.ellipse <- function( node.label.grob <- textGrob( name = 'node.labels', - clone.out$v$plot.lab, - x = unit(clone.out$v$x, 'native'), - y = unit(clone.out$v$y, 'native'), + circle.nodes$plot.lab, + x = unit(circle.nodes$x, 'native'), + y = unit(circle.nodes$y, 'native'), just = c('center', 'center'), - gp = gpar(col = clone.out$v$node.label.colour, cex = label.cex - log2(nchar(clone.out$v$plot.lab)) / 10) + gp = gpar(col = circle.nodes$node.label.colour, cex = label.cex - log2(nchar(circle.nodes$plot.lab)) / 10) ); clone.out$grobs <- c(clone.out$grobs, list(node.label.grob)); diff --git a/R/adjust.tree.R b/R/adjust.tree.R index 4f29ffa..24bc0e1 100644 --- a/R/adjust.tree.R +++ b/R/adjust.tree.R @@ -30,6 +30,7 @@ adjust.branch.lengths <- function(node.df, tree, node.radius, scale1) { } node.df$node.radius[node.df$id == -1] <- 0; + node.df[!node.df$draw.node, 'node.radius'] <- 0; length.cols <- grep('length', colnames(tree)); tree.adj <- apply( diff --git a/R/make.clone.tree.grobs.R b/R/make.clone.tree.grobs.R index 704112e..0ccee07 100644 --- a/R/make.clone.tree.grobs.R +++ b/R/make.clone.tree.grobs.R @@ -27,7 +27,6 @@ make.clone.tree.grobs <- function( axis.cex, xaxis.label, min.width, - draw.nodes, node.radius, label.nodes, node.col, @@ -87,7 +86,7 @@ make.clone.tree.grobs <- function( tree$length <- tree$length1; } - if (draw.nodes != 'none' && length.from.node.edge == TRUE) { + if (length.from.node.edge == TRUE) { tree <- adjust.branch.lengths(v, tree, node.radius, scale1); } @@ -119,7 +118,7 @@ make.clone.tree.grobs <- function( if (!no.ccf) { get.CP.polygons(clone.out); - } + } add.tree.segs(clone.out, node.radius, default.branch.width, scale1, seg1.col, seg2.col); @@ -132,9 +131,7 @@ make.clone.tree.grobs <- function( # add.pie.nodes(clone.out, node.radius, cluster.list); } - if (draw.nodes) { - add.node.ellipse(clone.out,node.radius, label.nodes, label.cex, scale1); - } + add.node.ellipse(clone.out,node.radius, label.nodes, label.cex, scale1); if (add.normal == TRUE) { add.normal(clone.out,node.radius,label.cex, normal.cex) diff --git a/R/prep.tree.R b/R/prep.tree.R index 00facb1..830e09b 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -101,53 +101,18 @@ prep.tree <- function( if (is.null(tree.df$label)) tree.df$child else tree.df$label ); - if (('node.col' %in% colnames(tree.df))) { - tree.df$node.col[is.na(tree.df$node.col)] <- default.node.colour; - } else { - tree.df$node.col <- default.node.colour; - } + tree.df <- prep.draw.node.setting(tree.df); - tree.df$node.label.col <- prep.node.label.colours(tree.df); - - tree.df$border.col <- apply( + tree.df <- prep.node.colours( tree.df, - MARGIN = 1, - FUN = function(row) { - if (is.na(row['border.col'])) row['node.col'] else row['border.col']; - } - ); - - if ('border.type' %in% colnames(tree.df)) { - valid.border.types <- c( - 'blank', - 'solid', - 'dashed', - 'dotted', - 'dotdash', - 'longdash', - 'twodash' - ); - - border.type.is.valid <- tree.df$border.type %in% valid.border.types | is.na(tree.df$border.type); - - if (!all(border.type.is.valid)) { - stop(paste( - 'Invalid border type specified.', - 'Must be one of', paste(c(valid.border.types, 'or NA.'), collapse = ', ') - )); - } + default.node.colour = default.node.colour + ); - tree.df$border.type[is.na(tree.df$border.type)] <- if (is.numeric(tree.df$border.type)) 1 else 'solid'; - } else { - tree.df$border.type <- 'solid'; - } + tree.df$node.label.col <- prep.node.label.colours(tree.df); - if ('border.width' %in% colnames(tree.df)) { - tree.df$border.width <- as.numeric(tree.df$border.width); - tree.df$border.width[is.na(tree.df$border.width)] <- 1; - } else { - tree.df$border.width <- 1; - } + tree.df <- prep.node.border.colours(tree.df); + tree.df <- prep.node.border.type(tree.df); + tree.df <- prep.node.border.width(tree.df); out.df <- data.frame( id = c(-1, tree.df$child), @@ -155,6 +120,7 @@ prep.tree <- function( ccf = if (is.null(tree.df$CP)) NA else c(1, tree.df$CP), color = colour.scheme[1:(nrow(tree.df) + 1)], angle = c(NA, tree.df$angle), + draw.node = c(NA, tree.df$draw.node), spread = c(NA, tree.df$spread), node.colour = c(NA, tree.df$node.col), node.label.colour = c(NA, tree.df$node.label.col), @@ -229,8 +195,6 @@ reset.tree.node.ids <- function(tree.df, value.index) { return(tree.df); } - - check.parent.values <- function(node.names, parent.col) { unique.node.names <- as.list(setNames( !vector(length = length(unique(node.names))), @@ -349,6 +313,85 @@ prep.edge.colour.column <- function(tree.df, column.name, default.value) { } } +prep.draw.node.setting <- function(tree.df) { + if ('draw.node' %in% colnames(tree.df)) { + NA.indices <- is.na(tree.df$draw.node); + tree.df$draw.node <- as.logical(tree.df$draw.node); + + if (any(is.na(tree.df$draw.node) & !NA.indices)) { + warning('Non-logical values found in "draw.node" column.'); + } + + tree.df$draw.node[is.na(tree.df$draw.node)] <- TRUE; + } else { + tree.df$draw.node <- TRUE; + } + + return(tree.df); + } + +prep.node.colours <- function(tree.df, default.node.colour) { + if ('node.col' %in% colnames(tree.df)) { + tree.df$node.col[is.na(tree.df$node.col)] <- default.node.colour; + } else { + tree.df$node.col <- default.node.colour; + } + + return(tree.df); + } + +prep.node.border.colours <- function(tree.df) { + tree.df$border.col <- apply( + tree.df, + MARGIN = 1, + FUN = function(row) { + if (is.na(row['border.col'])) row['node.col'] else row['border.col']; + } + ); + + return(tree.df); + } + +prep.node.border.type <- function(tree.df) { + if ('border.type' %in% colnames(tree.df)) { + valid.border.types <- c( + 'blank', + 'solid', + 'dashed', + 'dotted', + 'dotdash', + 'longdash', + 'twodash' + ); + + border.type.is.valid <- tree.df$border.type %in% valid.border.types | is.na(tree.df$border.type); + + if (!all(border.type.is.valid)) { + stop(paste( + 'Invalid border type specified.', + 'Must be one of', paste(c(valid.border.types, 'or NA.'), collapse = ', ') + )); + } + + tree.df$border.type[is.na(tree.df$border.type)] <- if (is.numeric(tree.df$border.type)) 1 else 'solid'; + } else { + tree.df$border.type <- 'solid'; + } + + return(tree.df); + } + +prep.node.border.width <- function(tree.df) { + if ('border.width' %in% colnames(tree.df)) { + tree.df$border.width <- as.numeric(tree.df$border.width); + tree.df$border.width[is.na(tree.df$border.width)] <- 1; + } else { + tree.df$border.width <- 1; + } + + return(tree.df); + } + prep.node.label.colours <- function(tree.df) { node.col.error.message <- 'Cannot prepare node label colour without node colour values.'; diff --git a/man/SRCGrob.Rd b/man/SRCGrob.Rd index a851492..356f7d8 100644 --- a/man/SRCGrob.Rd +++ b/man/SRCGrob.Rd @@ -28,7 +28,6 @@ SRCGrob( node.radius = 0.1, node.text.line.dist = 0.1, colour.scheme = CancerEvolutionVisualization::colours, - draw.nodes = TRUE, add.normal = FALSE, use.radians = FALSE, normal.cex = 1, @@ -73,7 +72,6 @@ SRCGrob( Distance between node text and tree branches (as a value between 0 and 1) } \item{colour.scheme}{Vector of colour values to be used for CP polygons} - \item{draw.nodes}{Enable or disable drawing tree nodes} \item{add.normal}{Adds a normal} \item{use.radians}{Unit to be used for "angle" column (degrees or radians)} \item{normal.cex}{Font size within the normal "box"} @@ -173,4 +171,13 @@ SRCGrob( simple.tree, add.normal = TRUE ); + + +# Nodeless Mode +nodeless.tree <- data.frame( + parent = c(NA, 1, 2, 2), + draw.node = c(TRUE, FALSE, TRUE, TRUE) + ); + +SRCGrob(nodeless.tree); } diff --git a/tests/testthat/test-prep.tree.R b/tests/testthat/test-prep.tree.R index 737f566..152f105 100644 --- a/tests/testthat/test-prep.tree.R +++ b/tests/testthat/test-prep.tree.R @@ -599,7 +599,7 @@ test_that( }); test_that( - 'prep.node.label.colours errors if "node.col" columb contains NAs', { + 'prep.node.label.colours errors if "node.col" column contains NAs', { tree.df <- data.frame(node.col = c(NA, 1:3)); expect_error( @@ -608,6 +608,47 @@ test_that( ); }); +test_that( + 'prep.draw.node.setting uses valid values', { + tree.df <- data.frame(draw.node = c(TRUE, FALSE, TRUE, FALSE, FALSE)); + result <- prep.draw.node.setting(tree.df); + expect_equal(result$draw.node, tree.df$draw.node); + }); + +test_that( + 'prep.draw.node.setting uses default if no column included', { + tree.df <- data.frame(parent = c(NA, 1, 2, 3)); + + result <- prep.draw.node.setting(tree.df); + expected.result <- rep(TRUE, nrow(tree.df)); + + expect_equal(result$draw.node, expected.result); + }); + +test_that( + 'prep.draw.node.setting fills NA values with default', { + tree.df <- data.frame(draw.node = c(TRUE, FALSE, TRUE, FALSE, FALSE)); + NA.indices <- c(2, 3, 5); + tree.df[NA.indices, 'draw.node'] <- NA; + + result <- prep.draw.node.setting(tree.df); + + default.value <- TRUE; + expected.result <- tree.df$draw.node; + expected.result[NA.indices] <- default.value; + + expect_equal(result$draw.node, expected.result); + }); + +test_that( + 'prep.draw.node.setting warns on non-logical values', { + tree.df <- data.frame(draw.node = c(TRUE, FALSE, 'invalid', TRUE)); + expect_warning( + prep.draw.node.setting(tree.df), + regexp = 'draw.node' + ); + }); + test_that( 'prep.tree.spread result is numeric', { tree.df <- data.frame( diff --git a/vignettes/UserGuide.Rmd b/vignettes/UserGuide.Rmd index 795f418..a8aa762 100644 --- a/vignettes/UserGuide.Rmd +++ b/vignettes/UserGuide.Rmd @@ -37,7 +37,7 @@ of parent and child nodes. It also provides information about the number of mutations at each node. -### Ex. 1: Parent Data +### Ex. 1.1: Parent Data ```{r echo=F} load('data/simple.example.Rda'); load('data/complex.example.Rda'); @@ -65,7 +65,7 @@ parent.only.tree <- SRCGrob(parent.only); grid.draw(parent.only.tree); ``` -### Ex. 2: Branch Lengths +### Ex. 1.2: Branch Lengths It's common to associate branch lengths with a the values of a particular variable (for example, PGA or SNVs). Up to two branch lengths can be specified. Including a @@ -95,7 +95,7 @@ branch.lengths.tree <- SRCGrob(branch.lengths); grid.draw(branch.lengths.tree); ``` -### Ex. 3: Complex Trees +### Ex. 1.3: Complex Trees CEV provides several methods for refining the spacing and arrangement of a tree's nodes. This is especially useful in complex trees, which often require more attention to avoid visual problems such as node collisions and uneven branch/level spacing. Here, we see a tree with many issues. @@ -132,7 +132,7 @@ knitr::kable(spread.tree.input[!is.na(spread.tree.input$spread) | is.na(spread.t grid.draw(SRCGrob(spread.tree.input)); ``` -### Ex. 4: Styling the Tree +### Ex. 1.4: Styling the Tree CEV gives the user control over numerous visual aspects of the tree. By specifying optional columns and values in the tree input data.frame, the user has individual control of the colour, width, and line type of each node, label border, and edge. @@ -190,7 +190,7 @@ node.style.tree <- SRCGrob(node.style); grid.draw(node.style.tree); ``` -### Ex. 5: Showing Cellular Prevalence +### Ex. 1.5: Showing Cellular Prevalence A `cellular.prevalence` column can also be added. These values must range between 0 and 1, and the sum of all child nodes must not be larger than their parent node's value. @@ -211,6 +211,38 @@ CP.tree <- SRCGrob(CP); grid.draw(CP.tree); ``` +### Ex. 1.6: Simplifying the Tree + +Complex trees may benefit from simpler visual styles. For example, there may not be room to render the node ellipses. CEV provides node-by-node control with the `draw.node` column. + +```{r echo=F} +nodeless <- data.frame( + parent = c( + NA, 1, 2, 2, 2, + 3, 3, 3, + 4, 4, 4, 4, 4, + 5, 5, 5, 5 + ), + draw.node = TRUE, + spread = NA + ); +nodeless$spread[6:nrow(nodeless)] <- 0.6; +nodeless$draw.node[c(2, 6:nrow(nodeless))] <- FALSE; + +knitr::kable( + nodeless[, c('parent', 'draw.node')], + row.names = TRUE + ); +``` + +```{r, fig.show='hide'} +nodeless.tree <- SRCGrob(nodeless); +``` + +```{r, echo=F} +grid.draw(nodeless.tree); +``` + ## Text Dataframe This secondary dataframe can be used to specify additional text corresponding to each node.