Merge branch 'main' of github.com:uclahs-cds/public-R-CancerEvolution…

…Visualization into dendrogram
uclahs-cds · Aug 28, 2024 · adf1920 · adf1920
2 parents bcd41a7 + dc0d7c5
commit adf1920
Show file tree

Hide file tree

Showing 10 changed files with 151 additions and 70 deletions.
diff --git 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 = "[email protected]"),
 	person("Adriana Salcedo", role = "aut"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,9 +1,10 @@
-# CancerEvolutionVisualization 2.1.0 (2024-07-31)
+# CancerEvolutionVisualization 2.1.0 (2024-08-28)
 
 ## 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

diff --git 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
@@ -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
@@ -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
@@ -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
@@ -194,52 +194,17 @@ prep.tree <- function(
 
     tree.df$node.label.col <- prep.node.label.colours(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'];
-        }
-    );
-
-    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';
-        }
-
-    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),
         label.text = c('', tree.df$label),
         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),
@@ -475,6 +440,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
@@ -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
@@ -602,7 +602,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(

diff --git 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.