From e0d14a1f2b6771eeed7dba780763236baafa2a8e Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 10 May 2024 10:29:14 -0700 Subject: [PATCH 01/51] Refactor dplyr tree segment adjustment --- R/add.segs.R | 67 +++++++++++++++++----------------------------------- 1 file changed, 22 insertions(+), 45 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index a4fc155..19f7aea 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -127,55 +127,32 @@ get.seg.coords <- function( tree.out <- list(); second.tree.segs.adjusted <- NULL; - tree.segs.adjusted <- adply( - tree.segs, - .margins = 1, - .fun = function(r) { - offset.x <- offset * cos(r$angle); - offset.y <- offset * sin(r$angle); + tree.segs.adjusted <- tree.segs; + offset.x <- offset * cos(tree.segs.adjusted$angle); + offset.y <- offset * sin(tree.segs.adjusted$angle); - if (r$angle > 0) { - basey <- r$basey + offset.y; - tipy <- r$tipy + offset.y; - } else { - basey <- r$basey + offset.y; - tipy <- r$tipy + offset.y; - } - - basex <- r$basex - offset.x; - tipx <- r$tipx - offset.x; - - return(data.frame(basex, basey, tipx, tipy)); - } - ); + tree.segs.adjusted$basey <- tree.segs.adjusted$basey + offset.y; + tree.segs.adjusted$tipy <- tree.segs.adjusted$tipy + offset.y; + tree.segs.adjusted$basex <- tree.segs.adjusted$basex - offset.x; + tree.segs.adjusted$tipx <- tree.segs.adjusted$tipx - offset.x; if (length(grep('length',colnames(tree))) == 4) { - second.tree.segs <- tree.segs; - second.tree.segs$tipy <- second.tree.segs$basey + second.tree.segs$length2.c * cos(second.tree.segs$angle); - second.tree.segs$tipx <- second.tree.segs$basex + second.tree.segs$length2.c * sin(second.tree.segs$angle); - - - second.tree.segs.adjusted <- adply( - second.tree.segs, - .margins = 1, - .fun = function(r) { - offset.x <- offset * cos(r$angle); - offset.y <- offset * sin(r$angle); - - if (r$angle > 0) { - basey <- r$basey - offset.y; - tipy <- r$tipy - offset.y; - } else { - basey <- r$basey - offset.y; - tipy <- r$tipy - offset.y; - } - - basex <- r$basex + offset.x; - tipx <- r$tipx + offset.x; - - return(data.frame(basex, basey, tipx, tipy)); - } + second.tree.segs.adjusted <- tree.segs; + second.tree.segs.adjusted$tipy <- ( + second.tree.segs.adjusted$basey + + second.tree.segs.adjusted$length2.c + * cos(second.tree.segs.adjusted$angle) ); + second.tree.segs.adjusted$tipx <- ( + second.tree.segs.adjusted$basex + + second.tree.segs.adjusted$length2.c + * sin(second.tree.segs.adjusted$angle) + ); + + second.tree.segs.adjusted$basey <- second.tree.segs.adjusted$basey - offset.y; + second.tree.segs.adjusted$tipy <- second.tree.segs.adjusted$tipy - offset.y; + second.tree.segs.adjusted$basex <- second.tree.segs.adjusted$basex + offset.x; + second.tree.segs.adjusted$tipx <- second.tree.segs.adjusted$tipx + offset.x; second.tree.segs.adjusted <- second.tree.segs.adjusted[ which(second.tree.segs.adjusted$basey != second.tree.segs.adjusted$tipy), ]; From 5c094e27b80d7e970a881f9c61393edb7cad424b Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 10 May 2024 10:33:39 -0700 Subject: [PATCH 02/51] Remove unused duplicate function --- R/add.segs.R | 96 ---------------------------------------------------- 1 file changed, 96 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 19f7aea..68b629f 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -1,99 +1,3 @@ -add.segs3 <- function( - tree, - v, - offset = 0, - node.radius = 0, - scale.x.real = NULL - ) { - - # Calculate offset based on line width - offset <- offset / scale.x.real / 2; - - tree.segs.adjusted <- tree.segs <- adply( - tree, - .margins = 1, - .fun = function(x) { - if (x$parent == -1) { - basey <- 0; - basex <- 0; - } else { - basey <- v$y[v$id == x$parent]; - basex <- v$x[v$id == x$parent]; - } - - tipy <- basey + x$length1 * cos(x$angle); - tipx <- basex + x$length1 * sin(x$angle); - - return(data.frame(basex, basey, tipx, tipy)); - } - ); - - tree.out <- list(); - - second.tree.segs.adjusted <- NULL; - - if (length(grep('length', colnames(tree))) == 4) { - tree.segs.adjusted <- adply( - tree.segs, - .margins = 1, - .fun = function(r) { - offset.x <- offset * cos(r$angle); - offset.y <- offset * sin(r$angle); - - if (r$angle > 0) { - basey <- r$basey + offset.y; - tipy <- r$tipy + offset.y; - } else { - basey <- r$basey + offset.y; - tipy <- r$tipy + offset.y; - } - - basex <- r$basex - offset.x; - tipx <- r$tipx - offset.x; - - return(data.frame(basex, basey, tipx, tipy)); - } - ); - - tree.segs.adjusted <- tree.segs.adjusted[which(!(tree.segs.adjusted$basey == tree.segs.adjusted$tipy & tree.segs.adjusted$basex == tree.segs.adjusted$tipx)), ] - - second.tree.segs <- tree.segs; - second.tree.segs$tipy <- second.tree.segs$basey + second.tree.segs$length2.c * cos(second.tree.segs$angle); - second.tree.segs$tipx <- second.tree.segs$basex + second.tree.segs$length2.c * sin(second.tree.segs$angle); - - second.tree.segs.adjusted <- adply( - second.tree.segs, - .margins = 1, - .fun = function(r) { - offset.x <- offset * cos(r$angle); - offset.y <- offset * sin(r$angle); - - if (r$angle > 0) { - basey <- r$basey - offset.y; - tipy <- r$tipy - offset.y; - } else { - basey <- r$basey - offset.y; - tipy <- r$tipy - offset.y; - } - - basex <- r$basex + offset.x; - tipx <- r$tipx + offset.x; - - return(data.frame(basex, basey, tipx, tipy)); - } - ); - - second.tree.segs.adjusted <- second.tree.segs.adjusted[which(!(second.tree.segs.adjusted$basey == second.tree.segs.adjusted$tipy & second.tree.segs.adjusted$basex == second.tree.segs.adjusted$tipx)),] - } - - tree.out <- list( - tree.segs = tree.segs.adjusted, - tree.segs2 = second.tree.segs.adjusted - ); - - return(tree.out); - } - get.seg.coords <- function( tree, v, From 6f9bbc2096b90a23b0870200eaf98b9ba2f20766 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 10 May 2024 10:50:20 -0700 Subject: [PATCH 03/51] Refactor dplyr tree segment initialization --- R/add.segs.R | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 68b629f..eab529f 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -9,26 +9,33 @@ get.seg.coords <- function( # Calculate offset based on the line width offset <- offset / scale1 / 2; - tree.segs <- adply( + tree.segs <- apply( tree, - .margins = 1, - .fun = function(x) { - if (x$parent == -1) { + MARGIN = 1, + FUN = function(x) { + if (x['parent'] == -1) { basey <- 0; basex <- 0; } else { - basey <- v$y[v$id == x$parent]; - basex <- v$x[v$id == x$parent]; + basey <- v$y[v$id == x['parent']]; + basex <- v$x[v$id == x['parent']]; } - tipy <- basey + x$length1 * cos(x$angle); - tipx <- basex + x$length1 * sin(x$angle); + tipy <- basey + x['length1'] * cos(x['angle']); + tipx <- basex + x['length1'] * sin(x['angle']); - return(data.frame(basex, basey, tipx, tipy)); + data.frame( + basex = basex, + basey = basey, + tipx = tipx, + tipy = tipy + ); } ); + tree.segs <- as.data.frame(do.call('rbind', tree.segs)); + rownames(tree.segs) <- rownames(tree); + tree.segs <- cbind(tree, tree.segs); - tree.out <- list(); second.tree.segs.adjusted <- NULL; tree.segs.adjusted <- tree.segs; From 169e01a9b6b6765e6da226a09286458d84f4f126 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 10 May 2024 10:54:56 -0700 Subject: [PATCH 04/51] Refactor text prep dplyr functions --- R/add.text.R | 89 +++++++++++++++++++++++----------------------------- 1 file changed, 39 insertions(+), 50 deletions(-) diff --git a/R/add.text.R b/R/add.text.R index 2832858..ff57ad4 100644 --- a/R/add.text.R +++ b/R/add.text.R @@ -61,18 +61,11 @@ check.overlap <- function( node.text.xrange <- c(left, right); - node.segs <- adply( - tree.max.adjusted[, c('tip', 'parent', 'x', 'y')], - .margins = 1, - .fun = function(w) { - data.frame( - y0 = (w$y + node.radius), - y1 = (w$y - node.radius), - x0 = (w$x - node.radius), - x1 = (w$x + node.radius) - ); - } - ); + node.segs <- tree.max.adjusted[, c('tip', 'parent', 'x', 'y')]; + node.segs$y0 <- tree.max.adjusted$y + node.radius; + node.segs$y1 <- tree.max.adjusted$y - node.radius; + node.segs$x0 <- tree.max.adjusted$x - node.radius; + node.segs$x1 <- tree.max.adjusted$x + node.radius; line.intercept <- logical(length = nrow(tree.max.adjusted)); node.intercept <- logical(length = nrow(tree.max.adjusted)); @@ -545,56 +538,52 @@ add.text2 <- function( } ); - tree.max <- adply( + tree.max.adjusted <- apply( tree, - .margins = 1, - .fun = function(x) { - if (x$parent == -1) { + MARGIN = 1, + FUN = function(x) { + if (x['parent'] == -1) { basex <- 0; basey <- 0; } else { - basex <- v$x[v$id == x$parent]; - basey <- v$y[v$id == x$parent]; + basex <- v$x[v$id == x['parent']]; + basey <- v$y[v$id == x['parent']]; } - tipx <- v$x[v$id == x$tip]; - tipy <- v$y[v$id == x$tip]; + tipx <- v$x[v$id == x['tip']]; + tipy <- v$y[v$id == x['tip']]; return(data.frame(basex, basey, tipx, tipy)); } ); - - #the length of the visible line segments - tree.max.adjusted <- adply( - tree.max, - .margins = 1, - .fun = function(x) { - if (x$tipx == x$basex) { - #straight line - basex <- x$basex; - tipx <- x$tipx; - basey <- x$basey + node.radius; - tipy <- x$tipy - node.radius; - } else if (x$tipx > x$basex) { - basey <- x$basey + node.radius * cos(x$angle); - tipy <- x$tipy - node.radius * cos(x$angle); - basex <- x$basex + node.radius * sin(x$angle); - tipx <- x$tipx - node.radius * sin(x$angle); - } else if (x$tipx < x$basex) { - basey <- x$basey + node.radius * cos(x$angle); - tipy <- x$tipy - node.radius * cos(x$angle); - basex <- x$basex + node.radius * sin(x$angle); - tipx <- x$tipx - node.radius * sin(x$angle); - } - if (x$parent == -1) { - basex <- basey <- 0; - } - - return(data.frame(basex,basey,tipx,tipy)); - } + tree.max.adjusted <- do.call('rbind', tree.max.adjusted); + rownames(tree.max.adjusted) <- rownames(tree); + tree.max.adjusted <- cbind(tree, tree.max.adjusted); + tree.max <- tree.max.adjusted; + + # 1 if positive angle, -1 if negative (or 0 degrees) + angle.modifier <- (tree.max.adjusted$angle > 0) * 2 - 1; + + # Length of the visible line segments + tree.max.adjusted$basex <- ( + tree.max.adjusted$basex + + angle.modifier * node.radius * sin(tree.max.adjusted$angle) + ); + tree.max.adjusted$tipx <- ( + tree.max.adjusted$tipx - + -angle.modifier * node.radius * sin(tree.max.adjusted$angle) + ); + tree.max.adjusted$basey <- ( + tree.max.adjusted$basey + + angle.modifier * node.radius * cos(tree.max.adjusted$angle) + ); + tree.max.adjusted$tipy <- ( + tree.max.adjusted$tipy - + -angle.modifier * node.radius * cos(tree.max.adjusted$angle) ); - #push a viewport the same size as the final panel so we can do calculations based on absolute size units + # Push a viewport the same size as the final panel + # to perform calculations using absolute size units if (!is.null(clone.out)) { pushViewport(clone.out$vp); } else { From 074c215fe9e433a0ea90317e09e27677dc63b1e5 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 16 May 2024 13:10:23 -0700 Subject: [PATCH 05/51] Refactor dplyr function in tree length adjustment --- R/adjust.tree.R | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/R/adjust.tree.R b/R/adjust.tree.R index 220ab3e..965897a 100644 --- a/R/adjust.tree.R +++ b/R/adjust.tree.R @@ -1,29 +1,26 @@ -adjust.lengths <- function(x, cols, node.df) { - out.df <- x; - - for (column in cols) { - if (x[1, column] > 0) { - length.adj <- x[1, column]; +adjust.lengths <- function(x, length.cols, node.df) { + adjusted <- list(); + for (column in length.cols) { + if (x[column] > 0) { + length.adj <- x[column]; # Max - if (x[1, column] == x[1, cols[length(cols)]]) { - length.adj <- length.adj + node.df$node.radius[node.df$id == x$tip]; + if (x[column] == x[length.cols[length(length.cols)]]) { + length.adj <- length.adj + node.df$node.radius[node.df$id == x['tip']]; } - if (x$parent != -1) { - length.adj <- length.adj + node.df$node.radius[node.df$id == x$parent]; + if (x['parent'] != -1) { + length.adj <- length.adj + node.df$node.radius[node.df$id == x['parent']]; } - } else { length.adj <- 0; } var.name <- paste0(names(x)[column], '.adj'); - out.df <- cbind(out.df, length.adj); - colnames(out.df)[ncol(out.df)] <- var.name; + adjusted[var.name] <- length.adj; } - return(out.df); + return(as.data.frame(adjusted)); } adjust.branch.lengths <- function(node.df, tree, node.radius, scale1) { @@ -35,13 +32,14 @@ adjust.branch.lengths <- function(node.df, tree, node.radius, scale1) { node.df$node.radius[node.df$id == -1] <- 0; length.cols <- grep('length', colnames(tree)); - tree.adj <- adply( + tree.adj <- apply( tree, - .margins = 1, - .fun = function(x) { - adjust.lengths(x, length.cols, node.df); - } + MARGIN = 1, + FUN = function(x) adjust.lengths(x, length.cols, node.df) ); + tree.adj <- do.call('rbind', tree.adj); + rownames(tree.adj) <- rownames(tree); + tree.adj <- cbind(tree, tree.adj); tree$length <- tree.adj$length.adj; tree$length1 <- tree.adj$length1.adj; From e0f3c23109b57c75b43541c935b6b97287703b7d Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 16 May 2024 13:12:03 -0700 Subject: [PATCH 06/51] Remove unused duplicate function --- R/adjust.tree.R | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/R/adjust.tree.R b/R/adjust.tree.R index 965897a..4f29ffa 100644 --- a/R/adjust.tree.R +++ b/R/adjust.tree.R @@ -47,26 +47,3 @@ adjust.branch.lengths <- function(node.df, tree, node.radius, scale1) { return(tree); } - -adjust.tree <- function(in.tree.node.radius, tree.in, node.radius, scale.x.real) { - if (is.null(in.tree.node.radius$node.radius)) { - node.radius <- node.radius / scale.x.real; - in.tree.node.radius$node.radius <- rep(node.radius, nrow(in.tree.node.radius)); - } - - in.tree.node.radius$node.radius[in.tree.node.radius$id == -1] <- 0; - length.cols <- grep('length', colnames(tree.in)); - tree.adj <- adply( - tree.in, - .margins = 1, - .fun = function(x) { - adjust.lengths(x, length.cols, in.tree.node.radius); - } - ); - - tree.in$length <- tree.adj$length.adj; - tree.in$length1 <- tree.adj$length1.adj; - tree.in$length2.c <- tree.adj$length2.c.adj; - - return(tree.in); - } From 3585423ad05e7625bf81b975ecab021e77f5aacc Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 16 May 2024 13:17:59 -0700 Subject: [PATCH 07/51] Remove unused code --- R/add.text.R | 31 ------------------------------- 1 file changed, 31 deletions(-) diff --git a/R/add.text.R b/R/add.text.R index ff57ad4..f41cfa3 100644 --- a/R/add.text.R +++ b/R/add.text.R @@ -507,37 +507,6 @@ add.text2 <- function( node.text.col <- node.list; node.text.fontface <- node.list; - a_ply( - seq_len( - nrow(node.text)), - .margins = 1, - .fun = function(x) { - text.row <- node.text[x, ]; - pos <- which(tree$tip == text.row$node); - text.value <- text.row$name; - - if (length(grep('_', text.value)) > 0) { - text.split <- strsplit(text.value, split = '_')[[1]]; - node.text.value <- text.split[1]; - amp <- text.split[2]; - call <- paste0(node.text.value, '^\'A', amp, '\''); - text.value <- parse(text = call); - } - - node.list[[pos]] <<- c(node.list[[pos]], text.value); - - node.text.col[[pos]] <<- c( - node.text.col[[pos]], - if (!is.na(text.row$col)) text.row$col else 'black' - ); - - node.text.fontface[[pos]] <<- c( - node.text.fontface[[pos]], - if (!is.na(text.row$fontface)) text.row$fontface else 'plain' - ); - } - ); - tree.max.adjusted <- apply( tree, MARGIN = 1, From 1e3e207a2fd5bb57fcb109605d3c3ada954f4d55 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 16 May 2024 13:22:00 -0700 Subject: [PATCH 08/51] Refactor dplyr function in node text --- R/add.text.R | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/R/add.text.R b/R/add.text.R index f41cfa3..85c0225 100644 --- a/R/add.text.R +++ b/R/add.text.R @@ -496,16 +496,9 @@ add.text2 <- function( # Radius in native units node.radius <- node.radius / scale; node.text <- node.text[node.text$node %in% tree$tip, ]; - node.list <- alply( - seq_len(nrow(tree)), - .margins = 1, - .fun = function(x) { - return(character()) - } - ); - node.text.col <- node.list; - node.text.fontface <- node.list; + node.list <- data.frame(row.names = rownames(tree)); + node.text.col <- node.text.fontface <- lapply tree.max.adjusted <- apply( tree, From 156b3415b68a6f31957456d4257b7d49e7a2b04d Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 16 May 2024 13:22:23 -0700 Subject: [PATCH 09/51] Remove plyr dependency --- NAMESPACE | 1 - 1 file changed, 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 46e3517..091ac19 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ import(grid) import(gridExtra) import(gtable) -import(plyr) import(BoutrosLab.plotting.general) importFrom("graphics", "par", "strheight", "strwidth") From 3293d62ab8cf4a625761d328a4e60c34dee17919 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 16 May 2024 13:23:38 -0700 Subject: [PATCH 10/51] Update changelog --- DESCRIPTION | 3 +-- NEWS | 3 ++- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8c28321..3ae322b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots Version: 2.1.0 -Date: 2024-05-07 +Date: 2024-05-16 Authors@R: c( person("Paul Boutros", role = "cre", email = "PBoutros@mednet.ucla.edu"), person("Adriana Salcedo", role = "aut"), @@ -18,7 +18,6 @@ Depends: gridExtra, gtable, Imports: - plyr, grDevices, utils, stringr, diff --git a/NEWS b/NEWS index a2fe419..348cb88 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -CancerEvolutionVisualization 2.1.0 2024-05-07 (Dan Knight) +CancerEvolutionVisualization 2.1.0 2024-05-16 (Dan Knight) ADDED * Optional "spread" column to control node/branch spacing @@ -7,6 +7,7 @@ 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 +* Refactored use of plyr/dplyr functions to remove dependencies -------------------------------------------------------------------------- From 0f351feb5f945e048123f68dacb2dd7e038e6e51 Mon Sep 17 00:00:00 2001 From: whelena Date: Mon, 20 May 2024 12:43:09 -0700 Subject: [PATCH 11/51] add heatmaps documentation --- man/create.ccf.heatmap.Rd | 33 ++++++++++++++++++++++++ man/create.cluster.heatmap copy.Rd | 41 ++++++++++++++++++++++++++++++ man/create.cluster.heatmap.Rd | 41 ++++++++++++++++++++++++++++++ 3 files changed, 115 insertions(+) create mode 100644 man/create.ccf.heatmap.Rd create mode 100644 man/create.cluster.heatmap copy.Rd create mode 100644 man/create.cluster.heatmap.Rd diff --git a/man/create.ccf.heatmap.Rd b/man/create.ccf.heatmap.Rd new file mode 100644 index 0000000..587f716 --- /dev/null +++ b/man/create.ccf.heatmap.Rd @@ -0,0 +1,33 @@ +\name{create.ccf.heatmap} +\alias{create.ccf.heatmap} +\title{Subclone Tree Plot} +\description{ +Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples. The function is a wrapper around \dQuote{BoutrosLab.plotting.general::create.heatmap()} with some changes in the default parameters. All parameter description are the same as in \dQuote{BoutrosLab.plotting.general::create.heatmap()} except for \dQuote{ccf.thres}. +} +\usage{ +create.ccf.heatmap( + x, + ccf.thres = NULL, + cluster.dimensions = 'both', + clustering.method = 'complete', + distance.method = 'euclidean', + xaxis.lab = '', + xlab.label = 'Mutations', + print.colour.key = FALSE, + colour.scheme = c('white', 'blue') + ) +} +\arguments{ + \item{x}{Either a data-frame or a matrix from which the heatmap is to created} + \item{ccf.thres}{CCF threshold to be applied to the heatmap. Values below the threshold will be set to 0.} + \item{cluster.dimensions}{Defaults to \dQuote{both}.} + \item{clustering.method}{Defaults to \dQuote{complete}.} + \item{distance.method}{Defaults to \dQuote{euclidean}.} + \item{xaxis.lab} {Defaults to an empty string.} + \item{xlab.label}{Defaults to \dQuote{Mutations}.} + \item{print.colour.key}{Defaults to \code{FALSE}.} + \item{colour.scheme}{Defaults to \code{c('white', 'blue')}.} + \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} +} +\value{A `grob` object of the heatmap.} +\author{Helena Winata} diff --git a/man/create.cluster.heatmap copy.Rd b/man/create.cluster.heatmap copy.Rd new file mode 100644 index 0000000..9b62dcd --- /dev/null +++ b/man/create.cluster.heatmap copy.Rd @@ -0,0 +1,41 @@ +\name{create.cluster.heatmap} +\alias{create.cluster.heatmap} +\title{Subclone Tree Plot} +\description{ +Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap. +} +\usage{ +create.cluster.heatmap <- function( + DF, + clone.colours = NULL, + plt.height = 6, + plt.width = 11, + xaxis.col = NULL, + legend.size = 3, + legend.title.cex = 1.2, + legend.label.cex = 1, + filename = NULL, + xlab.cex = 1.2, + xaxis.cex = 1, + xaxis.fontface = 'bold' + ) +} +\arguments{ + \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.} + \item{clone.colours}{Named list to provide a colour scheme for the clone ID covariate bar. If NULL, colours will be randomly generated. Defaults to \code{NULL}.} + \item{plt.height}{Defaults to 6} + \item{plt.width}{Defaults to 11} + \item{xaxis.col}{Column in DF to extract x-axis labels from. Defaults to \code{NULL}.} + \item{legend.size}{Width of the legend boxes in 'character' units. Defaults to 3} + \item{legend.title.cex}{Size of titles in the legends. Defaults to 1.2} + \item{legend.label.cex}{Size of text labels in the legends. Defaults to 1} + \item{filename}{Filename for tiff output, or if NULL returns the trellis object itself. Defaults to \code{NULL}.} + \item{xlab.cex}{Defaults to 1.2} + \item{xaxis.cex}{Defaults to 1} + \item{xaxis.fontface}{Defaults to \dQuote{bold}.} + \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} + +} +\value{A `grob` object of the heatmap.} +\author{Helena Winata} +\seealso{\code{\link{create.ccf.heatmap}}} \ No newline at end of file diff --git a/man/create.cluster.heatmap.Rd b/man/create.cluster.heatmap.Rd new file mode 100644 index 0000000..9b62dcd --- /dev/null +++ b/man/create.cluster.heatmap.Rd @@ -0,0 +1,41 @@ +\name{create.cluster.heatmap} +\alias{create.cluster.heatmap} +\title{Subclone Tree Plot} +\description{ +Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap. +} +\usage{ +create.cluster.heatmap <- function( + DF, + clone.colours = NULL, + plt.height = 6, + plt.width = 11, + xaxis.col = NULL, + legend.size = 3, + legend.title.cex = 1.2, + legend.label.cex = 1, + filename = NULL, + xlab.cex = 1.2, + xaxis.cex = 1, + xaxis.fontface = 'bold' + ) +} +\arguments{ + \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.} + \item{clone.colours}{Named list to provide a colour scheme for the clone ID covariate bar. If NULL, colours will be randomly generated. Defaults to \code{NULL}.} + \item{plt.height}{Defaults to 6} + \item{plt.width}{Defaults to 11} + \item{xaxis.col}{Column in DF to extract x-axis labels from. Defaults to \code{NULL}.} + \item{legend.size}{Width of the legend boxes in 'character' units. Defaults to 3} + \item{legend.title.cex}{Size of titles in the legends. Defaults to 1.2} + \item{legend.label.cex}{Size of text labels in the legends. Defaults to 1} + \item{filename}{Filename for tiff output, or if NULL returns the trellis object itself. Defaults to \code{NULL}.} + \item{xlab.cex}{Defaults to 1.2} + \item{xaxis.cex}{Defaults to 1} + \item{xaxis.fontface}{Defaults to \dQuote{bold}.} + \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} + +} +\value{A `grob` object of the heatmap.} +\author{Helena Winata} +\seealso{\code{\link{create.ccf.heatmap}}} \ No newline at end of file From 82142a2bd33b2f260df82a3f2f6b609effbc4de3 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 5 Jun 2024 10:20:19 -0700 Subject: [PATCH 12/51] add documentation for create.ccf.summary.heatmap --- R/create.ccf.summary.heatmap.R | 7 ++-- man/create.ccf.heatmap.Rd | 4 +-- man/create.ccf.summary.heatmap.Rd | 51 ++++++++++++++++++++++++++++++ man/create.cluster.heatmap copy.Rd | 41 ------------------------ 4 files changed, 58 insertions(+), 45 deletions(-) create mode 100644 man/create.ccf.summary.heatmap.Rd delete mode 100644 man/create.cluster.heatmap copy.Rd diff --git a/R/create.ccf.summary.heatmap.R b/R/create.ccf.summary.heatmap.R index 394815d..c0412fd 100644 --- a/R/create.ccf.summary.heatmap.R +++ b/R/create.ccf.summary.heatmap.R @@ -1,6 +1,6 @@ create.ccf.summary.heatmap <- function( DF, - ccf.thres = 0, + ccf.thres = NULL, median.col = 'median.ccf.per.sample', clone.order = NULL, sample.order = NULL, @@ -24,7 +24,10 @@ create.ccf.summary.heatmap <- function( value = median.col, x.axis = 'clone.id' ); - arr[arr <= ccf.thres] <- 0; + + if (!is.null(ccf.thres)) { + arr[arr <= ccf.thres] <- 0; + } clone.df <- aggregate(CCF ~ clone.id, data = DF[DF$CCF > 0, ], FUN = length); sample.df <- aggregate(CCF ~ ID, data = DF[DF$CCF > 0, ], FUN = length); diff --git a/man/create.ccf.heatmap.Rd b/man/create.ccf.heatmap.Rd index 587f716..c779d6c 100644 --- a/man/create.ccf.heatmap.Rd +++ b/man/create.ccf.heatmap.Rd @@ -2,7 +2,7 @@ \alias{create.ccf.heatmap} \title{Subclone Tree Plot} \description{ -Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples. The function is a wrapper around \dQuote{BoutrosLab.plotting.general::create.heatmap()} with some changes in the default parameters. All parameter description are the same as in \dQuote{BoutrosLab.plotting.general::create.heatmap()} except for \dQuote{ccf.thres}. +Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples. The function is a wrapper around \code{BoutrosLab.plotting.general::create.heatmap()} with some changes in the default parameters. All parameter description are the same as in \code{BoutrosLab.plotting.general::create.heatmap()} except for \code{ccf.thres}. } \usage{ create.ccf.heatmap( @@ -19,7 +19,7 @@ create.ccf.heatmap( } \arguments{ \item{x}{Either a data-frame or a matrix from which the heatmap is to created} - \item{ccf.thres}{CCF threshold to be applied to the heatmap. Values below the threshold will be set to 0.} + \item{ccf.thres}{CCF threshold to be applied to the heatmap. Values below the threshold will be set to 0. Defaults to \code{NULL}} \item{cluster.dimensions}{Defaults to \dQuote{both}.} \item{clustering.method}{Defaults to \dQuote{complete}.} \item{distance.method}{Defaults to \dQuote{euclidean}.} diff --git a/man/create.ccf.summary.heatmap.Rd b/man/create.ccf.summary.heatmap.Rd new file mode 100644 index 0000000..134d0b1 --- /dev/null +++ b/man/create.ccf.summary.heatmap.Rd @@ -0,0 +1,51 @@ +\name{create.ccf.summary.heatmap} +\alias{create.ccf.summary.heatmap} +\title{Subclone Tree Plot} +\description{ +Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap. Subplot parameters controls the appearance of the heatmap and barplots. See \code{BoutrosLab.plotting.general::create.barplot()} or \code{BoutrosLab.plotting.general::create.heatmap()} for parameter description. Legend parameters are passed to \code{BoutrosLab.plotting.general::legend.grob()}. +} + +\usage{ +create.ccf.summary.heatmap <- function( + DF, + ccf.thres = 0, + median.col = 'median.ccf.per.sample', + clone.order = NULL, + sample.order = NULL, + hm.col.scheme = c('white', 'blue'), + subplot.xlab.cex = 1.2, + subplot.xaxis.cex = 1, + subplot.xaxis.fontface = 'bold', + subplot.xaxis.rot = 90, + subplot.ylab.cex = 1.2, + subplot.yaxis.cex = 1, + subplot.yaxis.fontface = 'bold', + hm.xaxis.rot = 90, + legend.size = 3, + legend.title.cex = 1.2, + legend.label.cex = 1 + ) +} +\arguments{ + \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.} + \item{ccf.thres}{CCF threshold to be applied to the heatmap. Values below the threshold will be set to 0. Defaults to \code{NULL}} + \item{median.col}{Defaults to \dQuote{median.ccf.per.sample}} + \item{clone.order}{Defaults to \code{NULL}} + \item{sample.order}{Defaults to \code{NULL}} + \item{hm.col.scheme}{Heatmap colour scheme. Defaults to \code{c('white', 'blue')}} + \item{subplot.xlab.cex}{Subplot parameter. Defaults to 1.2} + \item{subplot.xaxis.cex}{Subplot parameter. Defaults to 1} + \item{subplot.xaxis.fontface}{Subplot parameter. Defaults to \dQuote{bold}} + \item{subplot.xaxis.rot}{Subplot parameter. Defaults to 90} + \item{subplot.ylab.cex}{Subplot parameter. Defaults to 1.2} + \item{subplot.yaxis.cex}{Subplot parameter. Defaults to 1} + \item{subplot.yaxis.fontface}{Subplot parameter. Defaults to \dQuote{bold}} + \item{hm.xaxis.rot}{Subplot parameter. Defaults to 90} + \item{legend.size}{Legend parameter. Defaults to 3} + \item{legend.title.cex}{Legend parameter. Defaults to 1.2} + \item{legend.label.cex}{Legend parameter. Defaults to 1} + \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.multipanelplot() for further details.} + +} +\value{A `grob` object of the summary plot.} +\author{Helena Winata} diff --git a/man/create.cluster.heatmap copy.Rd b/man/create.cluster.heatmap copy.Rd deleted file mode 100644 index 9b62dcd..0000000 --- a/man/create.cluster.heatmap copy.Rd +++ /dev/null @@ -1,41 +0,0 @@ -\name{create.cluster.heatmap} -\alias{create.cluster.heatmap} -\title{Subclone Tree Plot} -\description{ -Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap. -} -\usage{ -create.cluster.heatmap <- function( - DF, - clone.colours = NULL, - plt.height = 6, - plt.width = 11, - xaxis.col = NULL, - legend.size = 3, - legend.title.cex = 1.2, - legend.label.cex = 1, - filename = NULL, - xlab.cex = 1.2, - xaxis.cex = 1, - xaxis.fontface = 'bold' - ) -} -\arguments{ - \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.} - \item{clone.colours}{Named list to provide a colour scheme for the clone ID covariate bar. If NULL, colours will be randomly generated. Defaults to \code{NULL}.} - \item{plt.height}{Defaults to 6} - \item{plt.width}{Defaults to 11} - \item{xaxis.col}{Column in DF to extract x-axis labels from. Defaults to \code{NULL}.} - \item{legend.size}{Width of the legend boxes in 'character' units. Defaults to 3} - \item{legend.title.cex}{Size of titles in the legends. Defaults to 1.2} - \item{legend.label.cex}{Size of text labels in the legends. Defaults to 1} - \item{filename}{Filename for tiff output, or if NULL returns the trellis object itself. Defaults to \code{NULL}.} - \item{xlab.cex}{Defaults to 1.2} - \item{xaxis.cex}{Defaults to 1} - \item{xaxis.fontface}{Defaults to \dQuote{bold}.} - \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} - -} -\value{A `grob` object of the heatmap.} -\author{Helena Winata} -\seealso{\code{\link{create.ccf.heatmap}}} \ No newline at end of file From 3cca6d450636293ff17438ba553101d31bf60862 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 5 Jun 2024 10:33:24 -0700 Subject: [PATCH 13/51] add documentation for create.clone.genome.distribution.plot --- NAMESPACE | 1 - R/create.clone.genome.distribution.plot.R | 20 ++++++------- man/create.clone.genome.distribution.plot.Rd | 31 ++++++++++++++++++++ 3 files changed, 41 insertions(+), 11 deletions(-) create mode 100644 man/create.clone.genome.distribution.plot.Rd diff --git a/NAMESPACE b/NAMESPACE index 8b85eb5..51d41bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,5 +17,4 @@ export(create.ccf.heatmap) export(create.cluster.heatmap) export(create.ccf.summary.heatmap) - export(create.clone.genome.distribution.plot) diff --git a/R/create.clone.genome.distribution.plot.R b/R/create.clone.genome.distribution.plot.R index ff0ef7d..52b6f71 100644 --- a/R/create.clone.genome.distribution.plot.R +++ b/R/create.clone.genome.distribution.plot.R @@ -2,7 +2,7 @@ create.clone.genome.distribution.plot <- function( snv.df, genome.build = 'GRCh37', clone.order = NULL, - cluster.colours = NULL, + clone.colours = NULL, save.plt.dir = NULL, multi.sample = FALSE, ... @@ -23,8 +23,8 @@ create.clone.genome.distribution.plot <- function( snv.df$ID <- 'all'; } - if (is.null(cluster.colours)) { - cluster.colours <- get.colours(clone.order, return.names = TRUE); + if (is.null(clone.colours)) { + clone.colours <- get.colours(clone.order, return.names = TRUE); } snv.df$clone.id <- factor(snv.df$clone.id, levels = clone.order); genome.pos.df <- get.genome.pos(snv.df, genome.build); @@ -40,7 +40,7 @@ create.clone.genome.distribution.plot <- function( print(paste('Plotting clone distribution across the genome for sample:', s)); plt <- create.clone.genome.distribution.plot.per.sample( sample.df, - cluster.colours[levels(sample.df$clone.id)], + clone.colours[levels(sample.df$clone.id)], chr.info, save.plt = ifelse( is.null(save.plt.dir), @@ -54,7 +54,7 @@ create.clone.genome.distribution.plot <- function( create.clone.genome.distribution.plot.per.sample <- function( sample.df, - cluster.colours, + clone.colours, chr.info, save.plt = NULL, width = 18, @@ -88,13 +88,13 @@ create.clone.genome.distribution.plot.per.sample <- function( density.df <- do.call(rbind, density.list); # get plot legend ----------------------------------------------------------------------------- - cluster.colours <- cluster.colours[levels(sample.df$clone.id)]; + clone.colours <- clone.colours[levels(sample.df$clone.id)]; cluster.legend <- BoutrosLab.plotting.general::legend.grob( list( legend = list( title = 'Clones', - labels = names(cluster.colours), - colours = c(cluster.colours), + labels = names(clone.colours), + colours = c(clone.colours), border = 'black' ) ), @@ -104,7 +104,7 @@ create.clone.genome.distribution.plot.per.sample <- function( ); # create individual plot ---------------------------------------------------------------------- - sample.df$colour <- cluster.colours[sample.df$clone.id]; + sample.df$colour <- clone.colours[sample.df$clone.id]; scatter.plt <- create.clone.genome.distribution.scatterplot( scatter.df = sample.df, nsnv = nrow(sample.df), @@ -122,7 +122,7 @@ create.clone.genome.distribution.plot.per.sample <- function( density.plt <- create.clone.genome.distribution.densityplot( density.df, - cluster.colours, + clone.colours, chr.info = chr.info, xaxis.tck = xaxis.tck, yaxis.tck = yaxis.tck, diff --git a/man/create.clone.genome.distribution.plot.Rd b/man/create.clone.genome.distribution.plot.Rd new file mode 100644 index 0000000..1f2d75a --- /dev/null +++ b/man/create.clone.genome.distribution.plot.Rd @@ -0,0 +1,31 @@ +\name{create.clone.genome.distribution.plot} +\alias{create.clone.genome.distribution.plot} +\title{Create Clone Genome Distribution Plot} +\description{ +This function creates a plot showing the distribution of clones across the genome. It generates a scatter plot of the SNVs colored by clone ID and a density plot showing the density of each clone across the genome. The function can handle both single and multi-sample inputs. +} +\usage{ +create.clone.genome.distribution.plot( + snv.df, + genome.build = 'GRCh37', + clone.order = NULL, + clone.colours = NULL, + save.plt.dir = NULL, + multi.sample = FALSE + ) +} +\arguments{ + \item{snv.df}{A data frame containing the SNV data. It must have columns 'chr', 'pos', and 'clone.id'. If \code{multi.sample = TRUE}, it must also have a column 'ID' specifying the sample ID for each SNV.} + \item{genome.build}{The genome build to use. Defaults to \dQuote{GRCh37}.} + \item{clone.order}{The order in which to plot the clones. If \code{NULL}, clones will be sorted alphabetically.} + \item{clone.colours}{A named vector specifying the color to use for each clone. If \code{NULL}, colors will be automatically assigned.} + \item{save.plt.dir}{Directory to save the plot in. If \code{NULL}, the plot will not be saved.} + \item{multi.sample}{Logical indicating whether the input data contains multiple samples. Defaults to \code{FALSE}.} + \item{...}{Additional arguments to be passed to \code{BoutrosLab.plotting.general::create.multipanelplot()}.} +} +\details{ +This function preprocesses the input data frame, extracts chromosome information, and iterates over each sample to create a clone genome distribution plot. For each sample, it calculates the density of each clone across the genome and creates a scatter plot of the SNVs colored by clone ID and a density plot showing the density of each clone. +} +\value{A `grob` object.} +\author{Helena Winata, Selina Wu} + From 7aed2a0b34101f2cfb8b084f8fcf2f28af0bf015 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 5 Jun 2024 14:35:59 -0700 Subject: [PATCH 14/51] fix lintr --- R/Untitled.R | 0 man/GRCh37.Rd | 6 ++++++ man/GRCh38.Rd | 6 ++++++ man/create.ccf.heatmap.Rd | 5 +++-- man/create.ccf.summary.heatmap.Rd | 3 ++- man/create.clone.genome.distribution.plot.Rd | 3 ++- man/create.cluster.heatmap.Rd | 4 ++-- 7 files changed, 21 insertions(+), 6 deletions(-) delete mode 100644 R/Untitled.R create mode 100644 man/GRCh37.Rd create mode 100644 man/GRCh38.Rd diff --git a/R/Untitled.R b/R/Untitled.R deleted file mode 100644 index e69de29..0000000 diff --git a/man/GRCh37.Rd b/man/GRCh37.Rd new file mode 100644 index 0000000..2fca90e --- /dev/null +++ b/man/GRCh37.Rd @@ -0,0 +1,6 @@ +\docType{data} +\name{GRCh37} +\alias{GRCh37} +\title{GRCh37 Chromosom Information} +\description{Chromosome information for the GRCh37 genome build. Used for plotting.} +\format{data.frame} \ No newline at end of file diff --git a/man/GRCh38.Rd b/man/GRCh38.Rd new file mode 100644 index 0000000..bf1b20c --- /dev/null +++ b/man/GRCh38.Rd @@ -0,0 +1,6 @@ +\docType{data} +\name{GRCh38} +\alias{GRCh38} +\title{GRCh38 Chromosom Information} +\description{Chromosome information for the GRCh38 genome build. Used for plotting.} +\format{data.frame} \ No newline at end of file diff --git a/man/create.ccf.heatmap.Rd b/man/create.ccf.heatmap.Rd index c779d6c..e9ec3f5 100644 --- a/man/create.ccf.heatmap.Rd +++ b/man/create.ccf.heatmap.Rd @@ -14,7 +14,8 @@ create.ccf.heatmap( xaxis.lab = '', xlab.label = 'Mutations', print.colour.key = FALSE, - colour.scheme = c('white', 'blue') + colour.scheme = c('white', 'blue'), + ... ) } \arguments{ @@ -23,7 +24,7 @@ create.ccf.heatmap( \item{cluster.dimensions}{Defaults to \dQuote{both}.} \item{clustering.method}{Defaults to \dQuote{complete}.} \item{distance.method}{Defaults to \dQuote{euclidean}.} - \item{xaxis.lab} {Defaults to an empty string.} + \item{xaxis.lab}{Defaults to an empty string.} \item{xlab.label}{Defaults to \dQuote{Mutations}.} \item{print.colour.key}{Defaults to \code{FALSE}.} \item{colour.scheme}{Defaults to \code{c('white', 'blue')}.} diff --git a/man/create.ccf.summary.heatmap.Rd b/man/create.ccf.summary.heatmap.Rd index 134d0b1..10b64b3 100644 --- a/man/create.ccf.summary.heatmap.Rd +++ b/man/create.ccf.summary.heatmap.Rd @@ -23,7 +23,8 @@ create.ccf.summary.heatmap <- function( hm.xaxis.rot = 90, legend.size = 3, legend.title.cex = 1.2, - legend.label.cex = 1 + legend.label.cex = 1, + ... ) } \arguments{ diff --git a/man/create.clone.genome.distribution.plot.Rd b/man/create.clone.genome.distribution.plot.Rd index 1f2d75a..7f30331 100644 --- a/man/create.clone.genome.distribution.plot.Rd +++ b/man/create.clone.genome.distribution.plot.Rd @@ -11,7 +11,8 @@ create.clone.genome.distribution.plot( clone.order = NULL, clone.colours = NULL, save.plt.dir = NULL, - multi.sample = FALSE + multi.sample = FALSE, + ... ) } \arguments{ diff --git a/man/create.cluster.heatmap.Rd b/man/create.cluster.heatmap.Rd index 9b62dcd..a572df2 100644 --- a/man/create.cluster.heatmap.Rd +++ b/man/create.cluster.heatmap.Rd @@ -17,7 +17,8 @@ create.cluster.heatmap <- function( filename = NULL, xlab.cex = 1.2, xaxis.cex = 1, - xaxis.fontface = 'bold' + xaxis.fontface = 'bold', + ... ) } \arguments{ @@ -34,7 +35,6 @@ create.cluster.heatmap <- function( \item{xaxis.cex}{Defaults to 1} \item{xaxis.fontface}{Defaults to \dQuote{bold}.} \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} - } \value{A `grob` object of the heatmap.} \author{Helena Winata} From ba611d5fa6aff900e33b3eb1a6805f756e19a21b Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 14 Jun 2024 12:55:30 -0700 Subject: [PATCH 15/51] standardize param names --- R/create.ccf.summary.heatmap.R | 2 ++ R/create.cluster.heatmap.R | 13 +++++++------ man/create.cluster.heatmap.Rd | 6 ++++-- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/R/create.ccf.summary.heatmap.R b/R/create.ccf.summary.heatmap.R index c0412fd..ee384c4 100644 --- a/R/create.ccf.summary.heatmap.R +++ b/R/create.ccf.summary.heatmap.R @@ -44,6 +44,7 @@ create.ccf.summary.heatmap <- function( data = clone.df, xaxis.cex = 0, xlab.label = NULL, + xaxis.tck = 0, ylab.label = 'SNV per clone', ylab.cex = subplot.ylab.cex, yaxis.cex = subplot.yaxis.cex, @@ -60,6 +61,7 @@ create.ccf.summary.heatmap <- function( xaxis.fontface = subplot.xaxis.fontface, xlimits = c( - max(sample.df$nsnv) * 0.05, max(sample.df$nsnv) * 1.05), yaxis.cex = 0, + yaxis.tck = 0, ylab.label = NULL, plot.horizontal = TRUE ); diff --git a/R/create.cluster.heatmap.R b/R/create.cluster.heatmap.R index 5befe11..a71185e 100644 --- a/R/create.cluster.heatmap.R +++ b/R/create.cluster.heatmap.R @@ -1,8 +1,8 @@ create.cluster.heatmap <- function( DF, clone.colours = NULL, - plt.height = 6, - plt.width = 11, + height = 6, + width = 11, xaxis.col = NULL, legend.size = 3, legend.title.cex = 1.2, @@ -11,7 +11,7 @@ create.cluster.heatmap <- function( xlab.cex = 1.2, xaxis.cex = 1, xaxis.fontface = 'bold', - colour.scheme = c('white', 'blue'), + y.spacing = 1, ... ) { @@ -38,7 +38,6 @@ create.cluster.heatmap <- function( cluster.dimensions = 'none', xlab.label = '', xaxis.lab = xaxis.label, - colour.scheme = colour.scheme, ... ); @@ -85,7 +84,9 @@ create.cluster.heatmap <- function( legend = list(right = list( fun = legend.clone )), - height = plt.height, - width = plt.width + y.spacing = y.spacing, + right.legend.padding = 0.5, + height = height, + width = width )); } diff --git a/man/create.cluster.heatmap.Rd b/man/create.cluster.heatmap.Rd index a572df2..c694783 100644 --- a/man/create.cluster.heatmap.Rd +++ b/man/create.cluster.heatmap.Rd @@ -8,8 +8,8 @@ Creates a heatmap of cancer cell fraction (CCF) distribution across tumour sampl create.cluster.heatmap <- function( DF, clone.colours = NULL, - plt.height = 6, - plt.width = 11, + height = 6, + width = 11, xaxis.col = NULL, legend.size = 3, legend.title.cex = 1.2, @@ -18,6 +18,7 @@ create.cluster.heatmap <- function( xlab.cex = 1.2, xaxis.cex = 1, xaxis.fontface = 'bold', + y.spacing = 1, ... ) } @@ -34,6 +35,7 @@ create.cluster.heatmap <- function( \item{xlab.cex}{Defaults to 1.2} \item{xaxis.cex}{Defaults to 1} \item{xaxis.fontface}{Defaults to \dQuote{bold}.} + \item{y.spacing}{Spacing between heatmap and clone covariate bar. Defaults to 1} \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} } \value{A `grob` object of the heatmap.} From 98c53c648721b8f033dc7d7ed3995329bf603e38 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 14 Jun 2024 13:21:33 -0700 Subject: [PATCH 16/51] add colour scheme param to create.cluster.heatmap --- R/create.cluster.heatmap.R | 2 ++ man/create.cluster.heatmap.Rd | 2 ++ 2 files changed, 4 insertions(+) diff --git a/R/create.cluster.heatmap.R b/R/create.cluster.heatmap.R index a71185e..fe525fe 100644 --- a/R/create.cluster.heatmap.R +++ b/R/create.cluster.heatmap.R @@ -12,6 +12,7 @@ create.cluster.heatmap <- function( xaxis.cex = 1, xaxis.fontface = 'bold', y.spacing = 1, + colour.scheme = c('white', 'blue'), ... ) { @@ -38,6 +39,7 @@ create.cluster.heatmap <- function( cluster.dimensions = 'none', xlab.label = '', xaxis.lab = xaxis.label, + colour.scheme = colour.scheme, ... ); diff --git a/man/create.cluster.heatmap.Rd b/man/create.cluster.heatmap.Rd index c694783..714a7d0 100644 --- a/man/create.cluster.heatmap.Rd +++ b/man/create.cluster.heatmap.Rd @@ -19,6 +19,7 @@ create.cluster.heatmap <- function( xaxis.cex = 1, xaxis.fontface = 'bold', y.spacing = 1, + colour.scheme = c('white', 'blue'), ... ) } @@ -36,6 +37,7 @@ create.cluster.heatmap <- function( \item{xaxis.cex}{Defaults to 1} \item{xaxis.fontface}{Defaults to \dQuote{bold}.} \item{y.spacing}{Spacing between heatmap and clone covariate bar. Defaults to 1} + \item{colour.scheme}{Colour scheme for the heatmap. Defaults to \code{c('white', 'blue')}.} \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.} } \value{A `grob` object of the heatmap.} From d828b333328ff83c041b85ece6c4f4cd546b7650 Mon Sep 17 00:00:00 2001 From: whelena Date: Tue, 18 Jun 2024 12:00:54 -0700 Subject: [PATCH 17/51] automate naming between multi and single sample for clone genome distribution plot --- ...te.clone.genome.distribution.densityplot.R | 3 +- R/create.clone.genome.distribution.plot.R | 45 ++++++++++++------- man/create.ccf.heatmap.Rd | 2 +- man/create.clone.genome.distribution.plot.Rd | 4 +- 4 files changed, 33 insertions(+), 21 deletions(-) diff --git a/R/create.clone.genome.distribution.densityplot.R b/R/create.clone.genome.distribution.densityplot.R index 4bf68bf..e45b7d3 100644 --- a/R/create.clone.genome.distribution.densityplot.R +++ b/R/create.clone.genome.distribution.densityplot.R @@ -25,11 +25,10 @@ create.clone.genome.distribution.densityplot <- function( )); } -calculate.density.and.scale <- function(cluster.df, total.nsnv) { +calculate.density.and.scale <- function(cluster.df) { density <- density(x = cluster.df$genome.pos, bw = 'nrd', adjust = 0.05, na.rm = TRUE); density.df <- as.data.frame(density[c('x','y')]); density.df$clone.id <- unique(cluster.df$clone.id); - # density.df$scaled.y <- density.df$y * nrow(cluster.df) / total.nsnv; density.df$count <- nrow(cluster.df) / sum(density.df$y) * density.df$y; return(density.df) diff --git a/R/create.clone.genome.distribution.plot.R b/R/create.clone.genome.distribution.plot.R index 52b6f71..20bdf9c 100644 --- a/R/create.clone.genome.distribution.plot.R +++ b/R/create.clone.genome.distribution.plot.R @@ -3,7 +3,7 @@ create.clone.genome.distribution.plot <- function( genome.build = 'GRCh37', clone.order = NULL, clone.colours = NULL, - save.plt.dir = NULL, + filename = NULL, multi.sample = FALSE, ... ) { @@ -15,11 +15,24 @@ create.clone.genome.distribution.plot <- function( if (is.null(clone.order)) { clone.order <- sort(unique(snv.df$clone.id)); } - if (multi.sample) { # if multi-sample is true, check for sample ids in 'ID' column - if (is.null(snv.df$ID)) { - stop('ID column must contain sample ID if multi.sample is TRUE') + + if (!is.null(filename)) { + save.plt <- filename; } + + if (multi.sample) { + # if multi-sample is true, check for sample ids in 'ID' column + if (is.null(snv.df$ID)) { + stop('ID column must contain sample ID if multi.sample is TRUE'); + } + # filename must be a directory + if (!dir.exists(save.plt)) { + stop('filename must be a directory if multi.sample is TRUE'); + } } else { + if (dir.exists(save.plt)) { + stop('filename must be a path (not a directory) if multi.sample is FALSE'); + } snv.df$ID <- 'all'; } @@ -36,17 +49,18 @@ create.clone.genome.distribution.plot <- function( for (s in unique(snv.df$ID)) { # Iterate through each sample ------------------------------------------------------------- - sample.df <- droplevels(snv.df[snv.df$ID == s, ]) print(paste('Plotting clone distribution across the genome for sample:', s)); + + sample.df <- droplevels(snv.df[snv.df$ID == s, ]) + if (multi.sample & !is.null(filename)) { + save.plt <- file.path(save.plt, paste0(s, '_clone-genome-dist.png')); + } + plt <- create.clone.genome.distribution.plot.per.sample( sample.df, clone.colours[levels(sample.df$clone.id)], chr.info, - save.plt = ifelse( - is.null(save.plt.dir), - NULL, - file.path(save.plt.dir, paste0(s, '_clone-genome-dist.png')) - ), + save.plt = ifelse(is.null(filename), NULL, save.plt), ... ); } @@ -75,14 +89,13 @@ create.clone.genome.distribution.plot.per.sample <- function( # calculate densities for each cluster -------------------------------------------------------- density.list <- list(); - for (c in unique(sample.df$clone.id)) { - if (sum(sample.df$clone.id == c) <= 1) { - warning(paste('Skipping clone', c, 'in sample', unique(sample.df$ID), 'since there is only one SNV')); + for (k in unique(sample.df$clone.id)) { + if (sum(sample.df$clone.id == k) <= 1) { + warning(paste('Skipping clone', k, 'in sample', unique(sample.df$ID), 'since there is only one SNV')); next; } - density.list[[c]] <- calculate.density.and.scale( - cluster.df = sample.df[sample.df$clone.id == c, ], - total.nsnv = nrow(sample.df) + density.list[[k]] <- calculate.density.and.scale( + cluster.df = sample.df[sample.df$clone.id == k, ] ); } density.df <- do.call(rbind, density.list); diff --git a/man/create.ccf.heatmap.Rd b/man/create.ccf.heatmap.Rd index e9ec3f5..e5eb77b 100644 --- a/man/create.ccf.heatmap.Rd +++ b/man/create.ccf.heatmap.Rd @@ -14,7 +14,7 @@ create.ccf.heatmap( xaxis.lab = '', xlab.label = 'Mutations', print.colour.key = FALSE, - colour.scheme = c('white', 'blue'), + colour.scheme = c('white', 'blue'), ... ) } diff --git a/man/create.clone.genome.distribution.plot.Rd b/man/create.clone.genome.distribution.plot.Rd index 7f30331..53edfa0 100644 --- a/man/create.clone.genome.distribution.plot.Rd +++ b/man/create.clone.genome.distribution.plot.Rd @@ -10,7 +10,7 @@ create.clone.genome.distribution.plot( genome.build = 'GRCh37', clone.order = NULL, clone.colours = NULL, - save.plt.dir = NULL, + save.plt = NULL, multi.sample = FALSE, ... ) @@ -20,7 +20,7 @@ create.clone.genome.distribution.plot( \item{genome.build}{The genome build to use. Defaults to \dQuote{GRCh37}.} \item{clone.order}{The order in which to plot the clones. If \code{NULL}, clones will be sorted alphabetically.} \item{clone.colours}{A named vector specifying the color to use for each clone. If \code{NULL}, colors will be automatically assigned.} - \item{save.plt.dir}{Directory to save the plot in. If \code{NULL}, the plot will not be saved.} + \item{save.plt}{Directory or filepath to save the plot in. If \code{multi.sample = TRUE}, this must be a directory. if \code{multi.sample = FALSE}, this must be a filepath. If \code{NULL}, the plot will not be saved.} \item{multi.sample}{Logical indicating whether the input data contains multiple samples. Defaults to \code{FALSE}.} \item{...}{Additional arguments to be passed to \code{BoutrosLab.plotting.general::create.multipanelplot()}.} } From ccc59f4bfa44786db402201a45e91061f0903f06 Mon Sep 17 00:00:00 2001 From: whelena Date: Thu, 18 Jul 2024 15:07:24 -0700 Subject: [PATCH 18/51] Merge branch 'danknight-circular-angles' of github.com:uclahs-cds/public-R-CancerEvolutionVisualization into hwinata-test-dendrogram --- DESCRIPTION | 4 +-- NEWS | 5 ++++ R/angles.R | 47 ++++++++++++++++++++--------- tests/testthat/test-angles.R | 57 +++++++++++++++++++++++++++++++++++- 4 files changed, 96 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f657098..67f1ef1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots -Version: 3.0.0 -Date: 2024-02-21 +Version: 2.0.2 +Date: 2024-04-09 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 28fd1ae..dce07c6 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,11 @@ CancerEvolutionVisualization 2.0.2 2023-12-15 (Dan Knight) UPDATE * Updated package metadata and README +CancerEvolutionVisualization 2.0.2 2024-04-09 (Dan Knight) + +BUG +* Fixed angle calculation bug where child angles do not follow + their parent angle, instead moving "downward" at 0 degrees. -------------------------------------------------------------------------- CancerEvolutionVisualization 2.0.1 2023-11-17 (Helena Winata, Dan Knight) diff --git a/R/angles.R b/R/angles.R index 8602aa2..664dcce 100644 --- a/R/angles.R +++ b/R/angles.R @@ -3,11 +3,11 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { node.ids <- c(root.node.id); total.angle <- total.angle * spread; - angles <- numeric(nrow(tree)); + angles <- v$angle; while (length(node.ids) > 0) { # "Pops" next element in FIFO queue node.ids - current.node.id <- node.ids[1]; + current.node.id <- as.numeric(node.ids[1]); node.ids <- node.ids[-1]; parent.id <- tree$parent[tree$tip == current.node.id]; @@ -16,11 +16,17 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { tree$angle[tree$tip == current.node.id] <- 0; } - child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; + child.ids <- as.numeric( + tree$tip[tree$parent == current.node.id & !is.na(tree$parent)] + ); num.children <- length(child.ids); if (num.children > 0) { - parent.angle <- tree$angle[tree$tip == current.node.id]; + parent.angle <- angles[current.node.id]; + if (is.na(parent.angle) || length(parent.angle) == 0) { + parent.angle <- 0; + angles[current.node.id] <- parent.angle; + } child.weight <- assign.weight(current.node.id, v); start.angle <- parent.angle - (total.angle) * (num.children > 1) / 2; @@ -29,8 +35,11 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { for (i in seq_along(child.ids)) { child.id <- child.ids[i]; - angle <- start.angle + (i - 1) * (angle.increment); - angles[tree$tip == child.id] <- angle; + + if (is.na(angles[child.id])) { + angle <- start.angle + (i - 1) * (angle.increment); + angles[tree$tip == child.id] <- angle; + } } # Appending to end of queue for breadth-first traversal @@ -38,20 +47,27 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { } } - angles <- override.angles(tree, v, angles); return(angles); } calculate.angles.fixed <- function(v, tree, fixed.angle) { - angles <- numeric(nrow(tree)); + angles <- v$angle; node.ids <- c(v$id[[1]]); while (length(node.ids) > 0) { # "Pops" next element in FIFO queue node.ids - current.node.id <- node.ids[1]; + current.node.id <- as.numeric(node.ids[1]); node.ids <- node.ids[-1]; - child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; + parent.angle <- angles[current.node.id]; + if (is.na(parent.angle) || length(parent.angle) == 0) { + parent.angle <- 0; + angles[current.node.id] <- parent.angle; + } + + child.ids <- as.numeric( + tree$tip[tree$parent == current.node.id & !is.na(tree$parent)] + ); num.children <- length(child.ids); if (num.children > 0) { # Safe to hardcode temporarily. This will only ever apply to @@ -60,12 +76,16 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { # In future, I would like to remove this fixed angle calculation entirely. # It would be ideal to handle all calculations in the same way, and # rely more on user defined spread and explicit angle overrides. - child.angles <- if (num.children == 1) c(0) else c(-1, 1) * fixed.angle; + child.angles <- (if (num.children == 1) c(0) else c(-1, 1)) * fixed.angle; + child.angles <- child.angles + parent.angle; for (i in seq_along(child.ids)) { child.id <- child.ids[i]; - angle <- child.angles[i]; - angles[tree$tip == child.id] <- angle; + + if (is.na(angles[child.id])) { + angle <- child.angles[i]; + angles[tree$tip == child.id] <- angle; + } } } @@ -73,7 +93,6 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { node.ids <- append(node.ids, child.ids); } - angles <- override.angles(tree, v, angles); return(angles); } diff --git a/tests/testthat/test-angles.R b/tests/testthat/test-angles.R index f96ed88..ed62882 100644 --- a/tests/testthat/test-angles.R +++ b/tests/testthat/test-angles.R @@ -124,6 +124,33 @@ test_that( } ); +test_that( + 'calculate.angles.radial handles children of overriden angle', { + num.children <- 4; + test.tree <- data.frame( + parent = c(-1, rep(1, num.children)) + ); + test.tree$tip <- rownames(test.tree) + + test.v <- data.frame( + id = test.tree$tip, + parent = test.tree$parent, + angle = NA + ); + new.angle <- degrees.to.radians(15); + test.v[1, 'angle'] <- new.angle; + + result <- calculate.angles.radial( + test.v, + test.tree, + spread = 1, + total.angle = pi / 2.5 + ); + + expect_equal(mean(result[-1]), new.angle); + } + ); + test_that( 'calculate.angles.fixed sets angle correctly', { test.tree <- data.frame( @@ -175,4 +202,32 @@ test_that( expect_equal(result[angles.to.override], override.values); } -); + ); + +test_that( + 'calculate.angles.fixed handles children of overriden angle', { + num.children <- 2; + test.tree <- data.frame( + parent = c(-1, rep(1, num.children)) + ); + test.tree$tip <- rownames(test.tree) + + test.v <- data.frame( + id = test.tree$tip, + parent = test.tree$parent, + angle = NA + ); + new.angle <- 15; + test.v[1, 'angle'] <- new.angle; + + fixed.angle <- pi / 4; + result <- calculate.angles.fixed( + test.v, + test.tree, + fixed.angle = fixed.angle + ); + expected.angles <- c(new.angle, new.angle - fixed.angle, new.angle + fixed.angle); + + expect_equal(result, expected.angles); + } + ); From 7da2776ecdaf6e19114dc7f47442a5ac81998981 Mon Sep 17 00:00:00 2001 From: whelena Date: Thu, 18 Jul 2024 16:52:06 -0700 Subject: [PATCH 19/51] simplify filenames --- R/create.clone.genome.distribution.plot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/create.clone.genome.distribution.plot.R b/R/create.clone.genome.distribution.plot.R index 20bdf9c..2360d86 100644 --- a/R/create.clone.genome.distribution.plot.R +++ b/R/create.clone.genome.distribution.plot.R @@ -53,7 +53,7 @@ create.clone.genome.distribution.plot <- function( sample.df <- droplevels(snv.df[snv.df$ID == s, ]) if (multi.sample & !is.null(filename)) { - save.plt <- file.path(save.plt, paste0(s, '_clone-genome-dist.png')); + save.plt <- file.path(save.plt, paste0(s, '.png')); } plt <- create.clone.genome.distribution.plot.per.sample( From 068b046449bae499b62d06f672b1685c9a77219d Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 19 Jul 2024 12:17:54 -0700 Subject: [PATCH 20/51] update NEWS --- NEWS | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 7fd533a..d4a98c9 100644 --- a/NEWS +++ b/NEWS @@ -1,8 +1,9 @@ -CancerEvolutionVisualization 2.1.0 2024-05-07 (Helena Winata, Dan Knight) +CancerEvolutionVisualization 2.1.0 2024-07-19 (Helena Winata, Dan Knight) 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 UPDATE * Fixed angle calculation bug where child angles do not follow From abc23bf75e83132973ae7fda4d28a5bcf5c32088 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 19 Jul 2024 13:36:37 -0700 Subject: [PATCH 21/51] match argument name in .Rd file --- man/create.clone.genome.distribution.plot.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/create.clone.genome.distribution.plot.Rd b/man/create.clone.genome.distribution.plot.Rd index 53edfa0..6ca2132 100644 --- a/man/create.clone.genome.distribution.plot.Rd +++ b/man/create.clone.genome.distribution.plot.Rd @@ -10,7 +10,7 @@ create.clone.genome.distribution.plot( genome.build = 'GRCh37', clone.order = NULL, clone.colours = NULL, - save.plt = NULL, + filename = NULL, multi.sample = FALSE, ... ) From 861ca497df625dddecaf4bfd4140c5a954a08163 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 19 Jul 2024 14:28:35 -0700 Subject: [PATCH 22/51] fix param documentation --- man/create.clone.genome.distribution.plot.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/create.clone.genome.distribution.plot.Rd b/man/create.clone.genome.distribution.plot.Rd index 6ca2132..40dded4 100644 --- a/man/create.clone.genome.distribution.plot.Rd +++ b/man/create.clone.genome.distribution.plot.Rd @@ -20,7 +20,7 @@ create.clone.genome.distribution.plot( \item{genome.build}{The genome build to use. Defaults to \dQuote{GRCh37}.} \item{clone.order}{The order in which to plot the clones. If \code{NULL}, clones will be sorted alphabetically.} \item{clone.colours}{A named vector specifying the color to use for each clone. If \code{NULL}, colors will be automatically assigned.} - \item{save.plt}{Directory or filepath to save the plot in. If \code{multi.sample = TRUE}, this must be a directory. if \code{multi.sample = FALSE}, this must be a filepath. If \code{NULL}, the plot will not be saved.} + \item{filename}{Directory or filepath to save the plot in. If \code{multi.sample = TRUE}, this must be a directory. if \code{multi.sample = FALSE}, this must be a filepath. If \code{NULL}, the plot will not be saved.} \item{multi.sample}{Logical indicating whether the input data contains multiple samples. Defaults to \code{FALSE}.} \item{...}{Additional arguments to be passed to \code{BoutrosLab.plotting.general::create.multipanelplot()}.} } From 90afed75c19b0e89dd09491226450b6b96b28840 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 24 Jul 2024 10:57:03 -0700 Subject: [PATCH 23/51] add some notes --- R/add.segs.R | 55 ++++++++++++++++++++++++++++- R/branch.length.scaling.R | 3 ++ R/{main.R => make.clone.polygons.R} | 0 3 files changed, 57 insertions(+), 1 deletion(-) rename R/{main.R => make.clone.polygons.R} (100%) diff --git a/R/add.segs.R b/R/add.segs.R index d88f7ad..8298bbd 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -94,6 +94,23 @@ add.segs3 <- function( return(tree.out); } +###################################################################### +# calculate.coords.radial +# +# Description: +# - Calculates the coordinates for a radial layout of a tree or dendrogram. +# +# Arguments: +# - x A data frame or matrix containing the tree or dendrogram data. +# - v A data frame or matrix containing additional vertex information. +# - length.colname The name of the column in x that contains the branch lengths. +# - parent.id The ID of the parent node. +# - offset The offset value for positioning the nodes. +# - side The side of the tree or dendrogram ("left" or "right"). +# +# Returns: +# - A data frame with the calculated base and tip coordinates (basex, basey, tipx, tipy). + calculate.coords.radial <- function( x, v, @@ -150,6 +167,28 @@ calculate.coords.radial <- function( )); } +###################################################################### +# calculate.coords.dendrogram +# +# Description: +# - Calculates the coordinates for a dendrogram layout of a tree. +# +# Arguments: +# - x A data frame or matrix containing the tree data. +# - v A data frame or matrix containing additional vertex information. +# - length.colname The name of the column in x that contains the branch lengths. +# - parent.id The ID of the parent node. +# - offset The offset value for positioning the nodes. +# - side The side of the dendrogram ("left" or "right"). +# +# Returns: +# - A data frame with the calculated base and tip coordinates (basex, basey, tipx, tipy). +# +# Note: +# - The function assumes that the tree or dendrogram has a binary structure. +# - The function uses the branch lengths and angles to calculate the coordinates. +# - If the "x.length" value is available in v, it will be used instead of calculating dx from the branch length and angle. + calculate.coords.dendrogram <- function( x, v, @@ -187,7 +226,8 @@ calculate.coords.dendrogram <- function( } dy <- x[, length.colname]; - x.length <- v[x$tip, 'x.length'] + # x.length <- v[x$tip, 'x.length']; + x.length <- v[x$tip, 'x']; dx <- if (is.na(x.length)) x[, 'length'] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; @@ -207,6 +247,19 @@ calculate.coords.dendrogram <- function( )); } +################################################################################################### +# calculate.seg.coords +# +# Description: +# - Calculates the coordinates of segments in a tree structure for plotting purposes. The 'calculate.seg.coords' function calculates the coordinates of segments in a tree structure based on the provided tree data frame and additional node information in 'v'. The function supports two modes of coordinate calculation: 'radial' and 'dendrogram'. + +# Arguments: +# - tree A data frame representing the tree structure. Each row corresponds to a segment in the tree. +# - v A data frame or matrix containing additional information about the nodes in the tree. +# - length.colname A character string specifying the column name in 'v' that contains the length information for each node. +# - offset A numeric value specifying the offset to be applied to the coordinates. +# - side A character string specifying the side of the tree on which the segments should be plotted. + calculate.seg.coords <- function( tree, v, diff --git a/R/branch.length.scaling.R b/R/branch.length.scaling.R index 64202f8..0f4b721 100644 --- a/R/branch.length.scaling.R +++ b/R/branch.length.scaling.R @@ -1,3 +1,6 @@ + +# scale = 1 / (mean(branch.lengths) * log2(tree.depth)) * scale.input + get.branch.length.scale <- function(branch.lengths, tree.depth, user.scale) { smart.scale <- get.smart.branch.length.scale(branch.lengths, tree.depth); diff --git a/R/main.R b/R/make.clone.polygons.R similarity index 100% rename from R/main.R rename to R/make.clone.polygons.R From cf429d602c4c65ed5672ba7f0798234e7b0c1314 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 24 Jul 2024 17:55:19 -0700 Subject: [PATCH 24/51] modify angle assignment for dendrogram mode --- R/add.nodes.R | 2 +- R/add.segs.R | 10 ++--- R/angles.R | 88 +++++++++++++++++++++++++++------------ R/position.nodes.radial.R | 4 +- 4 files changed, 69 insertions(+), 35 deletions(-) diff --git a/R/add.nodes.R b/R/add.nodes.R index 49e8b53..0d64d45 100644 --- a/R/add.nodes.R +++ b/R/add.nodes.R @@ -84,7 +84,7 @@ add.normal <- function(clone.out, node.radius, label.cex, normal.cex = 1) { 'N', x = unit(0.5, 'npc'), y = unit(0.5, 'npc'), - name = 'ormal.label', + name = 'normal.label', just = 'center', gp = gpar( col = 'black', diff --git a/R/add.segs.R b/R/add.segs.R index 8298bbd..aff1e27 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -226,15 +226,15 @@ calculate.coords.dendrogram <- function( } dy <- x[, length.colname]; - # x.length <- v[x$tip, 'x.length']; - x.length <- v[x$tip, 'x']; - dx <- if (is.na(x.length)) x[, 'length'] * tan(angle) else x.length; + # x.length <- v[x$tip, 'x']; + x.length <- if (0 == angle) 0 else v[x$tip, 'x.length']; + dx <- if (is.na(x.length)) x[, 'length'] / tan(angle) else x.length; + # dx <- if (is.na(x.length)) x[, length.colname] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; - basex <- basex + dx + offset.x; + # basex <- basex + offset.x; tipx <- basex; - tipy <- basey + dy; diff --git a/R/angles.R b/R/angles.R index f7433ad..c154b93 100644 --- a/R/angles.R +++ b/R/angles.R @@ -3,13 +3,13 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { node.ids <- c(root.node.id); angles <- v$angle; - child.weights <- sapply( - v$id, - function(node.id) assign.weight(node.id, v), - USE.NAMES = FALSE - ); + # child.weights <- sapply( + # v$id, + # function(node.id) assign.weight(node.id, v), + # USE.NAMES = FALSE + # ); - while (length(node.ids) > 0) { + while (length(node.ids) > 0) { # each iteration assigns an angle to the children of the current node # "Pops" next element in FIFO queue node.ids current.node.id <- as.numeric(node.ids[1]); node.ids <- node.ids[-1]; @@ -31,38 +31,71 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { parent.angle <- 0; angles[current.node.id] <- parent.angle; } - child.weight <- assign.weight(current.node.id, v); + # child.weight <- assign.weight(current.node.id, v); level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); level.total.angle <- total.angle * level.spread; - start.angle <- parent.angle - (level.total.angle) * (num.children > 1) / 2; - num.slices <- max(num.children - 1, 1); - angle.increment <- total.angle / num.slices; - - previous.angle <- start.angle; - for (i in seq_along(child.ids)) { - child.id <- child.ids[i]; - - angle <- angles[tree$tip == child.id]; - if (is.na(angle)) { - if (i == 1) { - angle <- start.angle; + # start.angle <- parent.angle - (level.total.angle) * (num.children > 1) / 2; + # start.angle <- - (level.total.angle) * (num.children > 1) / 2; + if (v$mode[v$id == current.node.id] == 'radial' ) { + num.slices <- max(num.children - 1, 1); + angle.increment <- total.angle / num.slices; + start.angle <- parent.angle - (level.total.angle) * (num.children > 1) / 2; + + previous.angle <- start.angle; + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + + angle <- angles[tree$tip == child.id]; + if (is.na(angle)) { + if (i == 1) { + angle <- start.angle; + } else { + pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; + angle <- previous.angle + angle.increment * mean(pair.spread); + } + angles[tree$tip == child.id] <- angle; + } + previous.angle <- angle; + } + } else { + num.slices <- v$leaves[v$id == current.node.id]; + print(num.slices); + x.pos <- 1:num.slices - num.slices %/% 2; + if (num.slices %% 2 == 0) { # if even + x.pos <- x.pos - 0.5 + } else { + x.pos <- x.pos - 1 + } + start.idx <- 1; + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + n.leaves <- v$leaves[v$id == child.id]; + n <- start.idx + (n.leaves %/% 2); + if (n.leaves %% 2 == 0) { # if even + current.pos <- x.pos[n] - 0.5 } else { - pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; - angle <- previous.angle + angle.increment * mean(pair.spread); + current.pos <- x.pos[n] + } + print(paste('position for', child.id, ':', current.pos)) + if (0 == current.pos) { + angles[tree$tip == child.id] <- 0; } - - angles[tree$tip == child.id] <- angle; + random.scale <- 5; + angle <- angles[tree$tip == child.id]; + if (is.na(angle)) { + y <- tree$length[tree$tip == child.id]; + angle <- atan(y / (current.pos * random.scale)); + angles[tree$tip == child.id] <- angle; + } + start.idx <- start.idx + n.leaves; } - - previous.angle <- angle; } - # Appending to end of queue for breadth-first traversal node.ids <- append(node.ids, child.ids); } } - + print(cbind(v[, c('id', 'parent', 'label.text', 'leaves')], angles[as.numeric(v$id)])) return(angles); } @@ -153,3 +186,4 @@ calculate.level.spread <- function(level.spread.values) { ); return(level.spread / (n - 1)); } + diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 2920ccb..2baff0d 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -47,8 +47,8 @@ position.nodes <- function(v, tree, extra.len) { dy <- distance * cos(angle); } else { # Dendrogram - x.length <- vi$x.length; - dx <- if (is.na(x.length)) distance * tan(angle) else x.length; + x.length <- if (0 == angle) 0 else vi$x.length; + dx <- if (is.na(x.length)) distance / tan(angle) else x.length; dy <- distance; } From c9662071a8035cf80e88f5f8951eb9779cb25bfa Mon Sep 17 00:00:00 2001 From: whelena Date: Thu, 25 Jul 2024 16:36:51 -0700 Subject: [PATCH 25/51] add check to make sure all children are given the same parent --- R/prep.tree.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/R/prep.tree.R b/R/prep.tree.R index 5757d65..51bba60 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -130,7 +130,7 @@ prep.tree <- function( edge.col.column <- paste0('edge.col.', branch); tree.df[, edge.col.column] <- NA; } - + default.edge.col <- 'black'; tree.df[, edge.col.column] <- prep.column.values( tree.df[, edge.col.column], @@ -397,6 +397,17 @@ prep.branch.mode <- function(tree.df) { )); } tree.df$mode[invalid.mode] <- NA; + + # check all children of the same parent is specified the same mode + split.df <- split(tree.df, tree.df$parent); + n.mode <- sapply(split.df, function(x) length(unique(x$mode))) + + if (any(n.mode > 1)){ + invalid.parent.str <- paste(names(n.mode[n.mode > 1]), collapse = ' ') + stop(paste('"mode" must be consistent across children sharing a parent.', + 'Multiple modes specified for children of:', invalid.parent.str + )); + } } else { tree.df$mode <- NA; } From 2933a2b5d7dd7df6efc348d8f1870793158ab082 Mon Sep 17 00:00:00 2001 From: whelena Date: Thu, 25 Jul 2024 16:41:20 -0700 Subject: [PATCH 26/51] option 2 of assigning dendrogram angles --- R/angles.R | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/R/angles.R b/R/angles.R index c154b93..96b04c9 100644 --- a/R/angles.R +++ b/R/angles.R @@ -3,6 +3,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { node.ids <- c(root.node.id); angles <- v$angle; + x <- numeric(nrow(v)); # child.weights <- sapply( # v$id, # function(node.id) assign.weight(node.id, v), @@ -59,36 +60,37 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { previous.angle <- angle; } } else { - num.slices <- v$leaves[v$id == current.node.id]; - print(num.slices); - x.pos <- 1:num.slices - num.slices %/% 2; - if (num.slices %% 2 == 0) { # if even + parent.leaves <- v$leaves[v$id == current.node.id]; + x.pos <- 1:num.children - num.children %/% 2; + if (parent.leaves %% 2 == 0) { # if even x.pos <- x.pos - 0.5 } else { x.pos <- x.pos - 1 } - start.idx <- 1; + x.pos <- x.pos * (parent.leaves / num.children); + # start.idx <- 1; for (i in seq_along(child.ids)) { child.id <- child.ids[i]; - n.leaves <- v$leaves[v$id == child.id]; - n <- start.idx + (n.leaves %/% 2); - if (n.leaves %% 2 == 0) { # if even - current.pos <- x.pos[n] - 0.5 - } else { - current.pos <- x.pos[n] - } + # n.leaves <- v$leaves[v$id == child.id]; + # n <- start.idx + (n.leaves %/% 2); + # if (n.leaves %% 2 == 0) { # if even + # current.pos <- x.pos[n] - 0.5 + # } else { + # current.pos <- x.pos[n] + # } + current.pos <- x.pos[i] print(paste('position for', child.id, ':', current.pos)) if (0 == current.pos) { angles[tree$tip == child.id] <- 0; } - random.scale <- 5; + random.scale <- 35; angle <- angles[tree$tip == child.id]; if (is.na(angle)) { y <- tree$length[tree$tip == child.id]; angle <- atan(y / (current.pos * random.scale)); angles[tree$tip == child.id] <- angle; } - start.idx <- start.idx + n.leaves; + # start.idx <- start.idx + n.leaves; } } # Appending to end of queue for breadth-first traversal From 77162d7c48b9954cc17934ae413868efe3efdd68 Mon Sep 17 00:00:00 2001 From: whelena Date: Thu, 25 Jul 2024 22:04:05 -0700 Subject: [PATCH 27/51] refactor calculate.angles.radial to handle different modes --- R/angles.R | 166 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 102 insertions(+), 64 deletions(-) diff --git a/R/angles.R b/R/angles.R index 96b04c9..2e499d0 100644 --- a/R/angles.R +++ b/R/angles.R @@ -2,13 +2,9 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { root.node.id <- v$id[[1]]; node.ids <- c(root.node.id); + random.scale <- median(tree$length); angles <- v$angle; x <- numeric(nrow(v)); - # child.weights <- sapply( - # v$id, - # function(node.id) assign.weight(node.id, v), - # USE.NAMES = FALSE - # ); while (length(node.ids) > 0) { # each iteration assigns an angle to the children of the current node # "Pops" next element in FIFO queue node.ids @@ -32,67 +28,35 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { parent.angle <- 0; angles[current.node.id] <- parent.angle; } - # child.weight <- assign.weight(current.node.id, v); - level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); - level.total.angle <- total.angle * level.spread; - # start.angle <- parent.angle - (level.total.angle) * (num.children > 1) / 2; - # start.angle <- - (level.total.angle) * (num.children > 1) / 2; - if (v$mode[v$id == current.node.id] == 'radial' ) { - num.slices <- max(num.children - 1, 1); - angle.increment <- total.angle / num.slices; - start.angle <- parent.angle - (level.total.angle) * (num.children > 1) / 2; - - previous.angle <- start.angle; - for (i in seq_along(child.ids)) { - child.id <- child.ids[i]; - - angle <- angles[tree$tip == child.id]; - if (is.na(angle)) { - if (i == 1) { - angle <- start.angle; - } else { - pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; - angle <- previous.angle + angle.increment * mean(pair.spread); - } - angles[tree$tip == child.id] <- angle; - } - previous.angle <- angle; - } - } else { - parent.leaves <- v$leaves[v$id == current.node.id]; - x.pos <- 1:num.children - num.children %/% 2; - if (parent.leaves %% 2 == 0) { # if even - x.pos <- x.pos - 0.5 - } else { - x.pos <- x.pos - 1 - } - x.pos <- x.pos * (parent.leaves / num.children); - # start.idx <- 1; - for (i in seq_along(child.ids)) { - child.id <- child.ids[i]; - # n.leaves <- v$leaves[v$id == child.id]; - # n <- start.idx + (n.leaves %/% 2); - # if (n.leaves %% 2 == 0) { # if even - # current.pos <- x.pos[n] - 0.5 - # } else { - # current.pos <- x.pos[n] - # } - current.pos <- x.pos[i] - print(paste('position for', child.id, ':', current.pos)) - if (0 == current.pos) { - angles[tree$tip == child.id] <- 0; - } - random.scale <- 35; - angle <- angles[tree$tip == child.id]; - if (is.na(angle)) { - y <- tree$length[tree$tip == child.id]; - angle <- atan(y / (current.pos * random.scale)); - angles[tree$tip == child.id] <- angle; - } - # start.idx <- start.idx + n.leaves; - } + if (unique(v$mode[v$id %in% child.ids]) == 'radial') { + # if all children are radial, spread evenly by angle + level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); + level.total.angle <- total.angle * level.spread; + + angles <- split.equal.angle( + level.total.angle, + child.ids, + angles, + tree, + v + ); + } else if (unique(v$mode[v$id %in% child.ids]) == 'dendrogram') { + # if all children are dendrogram, spread evenly by x distance + angles <- split.equal.x.dist( + child.ids, + angles, + tree, + v, + random.scale + ); } + + if (v$mode[v$id == current.node.id] == 'radial' ) { + #if parent is 'radial' angjust starting angle + angles[tree$tip %in% child.ids] <- parent.angle + angles[tree$tip %in% child.ids]; + } + # Appending to end of queue for breadth-first traversal node.ids <- append(node.ids, child.ids); } @@ -101,6 +65,80 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { return(angles); } +split.equal.angle <- function( + level.total.angle, + child.ids, + angles, + tree, + v + ) { + + num.children <- length(child.ids); + num.slices <- max(num.children - 1, 1); + angle.increment <- level.total.angle / num.slices; + start.angle <- - (level.total.angle) * (num.children > 1) / 2; + + previous.angle <- 0; + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + angle <- angles[tree$tip == child.id]; + + if (is.na(angle)) { + if (i == 1) { + angle <- 0; + } else { + pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; + angle <- previous.angle + angle.increment * mean(pair.spread); + } + angles[tree$tip == child.id] <- angle; + } + previous.angle <- angle; + } + return(angles); + } + +split.equal.x.dist <- function( + child.ids, + angles, + tree, + v, + random.scale + ) { + num.slices <- v$leaves[v$id == current.node.id]; + x.pos <- 1:num.slices - num.slices %/% 2; + + if (num.slices %% 2 == 0) { # if even + x.pos <- x.pos - 0.5 + } else { + x.pos <- x.pos - 1 + } + + idx <- 1; + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + n.leaves <- v$leaves[v$id == child.id]; + n <- idx + (n.leaves %/% 2); + if (n.leaves %% 2 == 0) { # if even + current.pos <- x.pos[n] - 0.5 + } else { + current.pos <- x.pos[n] + } + + if (0 == current.pos) { + angles[child.id] <- 0; + } + + angle <- angles[tree$tip == child.id] + if (is.na(angle)) { + y <- tree$length[tree$tip == child.id]; + angle <- atan(y / (current.pos * random.scale)); + angles[tree$tip == child.id] <- angle; + } + idx <- idx + n.leaves; + } + return(angles); + } + calculate.angles.fixed <- function(v, tree, fixed.angle) { angles <- v$angle; node.ids <- c(v$id[[1]]); From cd12ddd330fa840b17e57dcae8606b95952d4426 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 26 Jul 2024 11:52:17 -0700 Subject: [PATCH 28/51] fix dendrogram dx calculation --- R/add.segs.R | 8 ++------ R/position.nodes.radial.R | 2 +- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index aff1e27..f9193b0 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -226,10 +226,8 @@ calculate.coords.dendrogram <- function( } dy <- x[, length.colname]; - # x.length <- v[x$tip, 'x']; - x.length <- if (0 == angle) 0 else v[x$tip, 'x.length']; - dx <- if (is.na(x.length)) x[, 'length'] / tan(angle) else x.length; - # dx <- if (is.na(x.length)) x[, length.colname] * tan(angle) else x.length; + x.length <- v[x$tip, 'x']; + dx <- if (is.na(x.length)) x[, 'length'] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; basex <- basex + dx + offset.x; @@ -237,8 +235,6 @@ calculate.coords.dendrogram <- function( tipx <- basex; tipy <- basey + dy; - - return(data.frame( basex, basey, diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 2baff0d..ba17a8e 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -48,7 +48,7 @@ position.nodes <- function(v, tree, extra.len) { } else { # Dendrogram x.length <- if (0 == angle) 0 else vi$x.length; - dx <- if (is.na(x.length)) distance / tan(angle) else x.length; + dx <- if (is.na(x.length)) distance * tan(angle) else x.length; dy <- distance; } From 48fed2fcda42fb559d8db7e6a53be378fc345390 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 26 Jul 2024 15:34:26 -0700 Subject: [PATCH 29/51] fix refatoring to use with full radial and full dend mode --- R/add.segs.R | 2 +- R/angles.R | 40 +++++++++++++++++++++------------------ R/position.nodes.radial.R | 2 +- 3 files changed, 24 insertions(+), 20 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index f9193b0..47cdfcb 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -226,7 +226,7 @@ calculate.coords.dendrogram <- function( } dy <- x[, length.colname]; - x.length <- v[x$tip, 'x']; + x.length <- v[x$tip, 'x.length']; dx <- if (is.na(x.length)) x[, 'length'] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; diff --git a/R/angles.R b/R/angles.R index 2e499d0..43b8a8e 100644 --- a/R/angles.R +++ b/R/angles.R @@ -2,7 +2,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { root.node.id <- v$id[[1]]; node.ids <- c(root.node.id); - random.scale <- median(tree$length); + random.scale <- median(tree$length1); angles <- v$angle; x <- numeric(nrow(v)); @@ -23,10 +23,10 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { num.children <- length(child.ids); if (num.children > 0) { - parent.angle <- angles[current.node.id]; + parent.angle <- angles[tree$tip == current.node.id]; if (is.na(parent.angle) || length(parent.angle) == 0) { parent.angle <- 0; - angles[current.node.id] <- parent.angle; + angles[tree$tip == current.node.id] <- parent.angle; } if (unique(v$mode[v$id %in% child.ids]) == 'radial') { @@ -41,9 +41,16 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { tree, v ); + if (v$mode[v$id == current.node.id] == 'radial') { + #if parent is 'radial' angjust starting angle + angles[tree$tip %in% child.ids] <- parent.angle + angles[tree$tip %in% child.ids]; + } } else if (unique(v$mode[v$id %in% child.ids]) == 'dendrogram') { + # sort children by complexity + child.ids <- v$id[v$id %in% child.ids]; # if all children are dendrogram, spread evenly by x distance angles <- split.equal.x.dist( + current.node.id, child.ids, angles, tree, @@ -52,11 +59,6 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { ); } - if (v$mode[v$id == current.node.id] == 'radial' ) { - #if parent is 'radial' angjust starting angle - angles[tree$tip %in% child.ids] <- parent.angle + angles[tree$tip %in% child.ids]; - } - # Appending to end of queue for breadth-first traversal node.ids <- append(node.ids, child.ids); } @@ -78,14 +80,14 @@ split.equal.angle <- function( angle.increment <- level.total.angle / num.slices; start.angle <- - (level.total.angle) * (num.children > 1) / 2; - previous.angle <- 0; + previous.angle <- start.angle; for (i in seq_along(child.ids)) { child.id <- child.ids[i]; angle <- angles[tree$tip == child.id]; if (is.na(angle)) { if (i == 1) { - angle <- 0; + angle <- start.angle; } else { pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; angle <- previous.angle + angle.increment * mean(pair.spread); @@ -98,12 +100,14 @@ split.equal.angle <- function( } split.equal.x.dist <- function( + current.node.id, child.ids, angles, tree, v, random.scale ) { + num.slices <- v$leaves[v$id == current.node.id]; x.pos <- 1:num.slices - num.slices %/% 2; @@ -117,21 +121,21 @@ split.equal.x.dist <- function( for (i in seq_along(child.ids)) { child.id <- child.ids[i]; n.leaves <- v$leaves[v$id == child.id]; - n <- idx + (n.leaves %/% 2); + j <- idx + (n.leaves %/% 2); if (n.leaves %% 2 == 0) { # if even - current.pos <- x.pos[n] - 0.5 + current.pos <- x.pos[j] - 0.5 } else { - current.pos <- x.pos[n] + current.pos <- x.pos[j] } - if (0 == current.pos) { - angles[child.id] <- 0; - } + # if (0 == current.pos) { + # angles[tree$tip == child.id] <- 0; + # } - angle <- angles[tree$tip == child.id] + angle <- angles[tree$tip == child.id]; if (is.na(angle)) { y <- tree$length[tree$tip == child.id]; - angle <- atan(y / (current.pos * random.scale)); + angle <- atan((current.pos * random.scale) / y); angles[tree$tip == child.id] <- angle; } idx <- idx + n.leaves; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index ba17a8e..2920ccb 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -47,7 +47,7 @@ position.nodes <- function(v, tree, extra.len) { dy <- distance * cos(angle); } else { # Dendrogram - x.length <- if (0 == angle) 0 else vi$x.length; + x.length <- vi$x.length; dx <- if (is.na(x.length)) distance * tan(angle) else x.length; dy <- distance; } From 02ca32cd84ba74e99942ddded997c9ae0cf7ba61 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 26 Jul 2024 17:05:25 -0700 Subject: [PATCH 30/51] remove print and allow spread to modify x dist between nodes --- R/angles.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/angles.R b/R/angles.R index 43b8a8e..e0edc35 100644 --- a/R/angles.R +++ b/R/angles.R @@ -2,7 +2,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { root.node.id <- v$id[[1]]; node.ids <- c(root.node.id); - random.scale <- median(tree$length1); + random.scale <- median(tree$length1) * spread; angles <- v$angle; x <- numeric(nrow(v)); @@ -63,7 +63,6 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { node.ids <- append(node.ids, child.ids); } } - print(cbind(v[, c('id', 'parent', 'label.text', 'leaves')], angles[as.numeric(v$id)])) return(angles); } @@ -128,10 +127,6 @@ split.equal.x.dist <- function( current.pos <- x.pos[j] } - # if (0 == current.pos) { - # angles[tree$tip == child.id] <- 0; - # } - angle <- angles[tree$tip == child.id]; if (is.na(angle)) { y <- tree$length[tree$tip == child.id]; From 47f28f3cf4f6015bc9f3d7212292c1b396e8c054 Mon Sep 17 00:00:00 2001 From: whelena Date: Fri, 26 Jul 2024 17:37:25 -0700 Subject: [PATCH 31/51] update NEWS and test + fix lintr --- NEWS | 5 ++++- R/angles.R | 1 - R/error.warning.R | 6 +++--- R/prep.tree.R | 15 ++++++++------- tests/testthat/test-angles.R | 21 ++++++++++++++------- tests/testthat/test-error.warning.R | 2 +- tests/testthat/test-prep.tree.R | 18 +++++++++--------- 7 files changed, 39 insertions(+), 29 deletions(-) diff --git a/NEWS b/NEWS index 61ec864..032afe2 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -CancerEvolutionVisualization 3.0.0 2024-05-07 (Dan Knight) +CancerEvolutionVisualization 3.0.0 2024-07-26 (Helena Winata, Dan Knight) ADDED * Dendrogram mode with node-by-node control @@ -9,7 +9,10 @@ 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 +* Split angle handling for `radial` and `dendrogram` modes to optimized each + independently. +-------------------------------------------------------------------------- CancerEvolutionVisualization 2.0.2 2024-04-09 (Dan Knight) BUG diff --git a/R/angles.R b/R/angles.R index e0edc35..9c3e24b 100644 --- a/R/angles.R +++ b/R/angles.R @@ -225,4 +225,3 @@ calculate.level.spread <- function(level.spread.values) { ); return(level.spread / (n - 1)); } - diff --git a/R/error.warning.R b/R/error.warning.R index 323ab03..c4ba6f3 100644 --- a/R/error.warning.R +++ b/R/error.warning.R @@ -3,9 +3,9 @@ check.lengths <- function(a, b, a.name, b.name) { b.length <- length(b); if (a.length != b.length) { error.message <- paste( - shQuote(a.name, type = 'cmd'), "and", - shQuote(b.name, type = 'cmd'), "have differing lengths", - paste0("(", paste(a.length, "and", b.length), ").") + shQuote(a.name, type = 'cmd'), 'and', + shQuote(b.name, type = 'cmd'), 'have differing lengths', + paste0('(', paste(a.length, 'and', b.length), ').') ); stop(error.message); } diff --git a/R/prep.tree.R b/R/prep.tree.R index 51bba60..3ac9614 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -24,7 +24,7 @@ prep.tree <- function( )); branch.names <- branch.names[1:2]; } else if (length(branch.names) == 0) { - branch.names <- c("1"); + branch.names <- c('1'); } if (!('angle' %in% colnames(tree.df))) { @@ -513,8 +513,8 @@ prep.connector.line.width <- function( check.lengths( connector.line.width, branch.line.width, - a.name = "connector.line.width", - b.name = "branch.line.width", + a.name = 'connector.line.width', + b.name = 'branch.line.width', ); NA.indices <- is.na(branch.line.width) connector.line.width[NA.indices] <- branch.line.width[NA.indices]; @@ -523,7 +523,7 @@ prep.connector.line.width <- function( non.numeric.indices <- is.na(connector.line.width); if (any(non.numeric.indices)) { warning( - non.numeric.warning.message("connector.width", "branch line width values") + non.numeric.warning.message('connector.width', 'branch line width values') ); connector.line.width[non.numeric.indices] <- branch.line.width[non.numeric.indices]; } @@ -574,7 +574,8 @@ prep.column.values <- function( default.values, conversion.fun = NULL ) { - if(!is.null(conversion.fun)) { + + if (!is.null(conversion.fun)) { original.default.NAs <- is.na(default.values); default.values <- suppressWarnings(conversion.fun(default.values)); if (any(is.na(default.values) & !original.default.NAs)) { @@ -587,7 +588,7 @@ prep.column.values <- function( if (default.values.n != 1 && default.values.n != n) { stop('"default.values" must be either length 1 or the same length as "column.values".'); } - + replace.with.default <- function(x, NA.indices) { if (default.values.n == 1) { x[NA.indices] <- default.values; @@ -605,7 +606,7 @@ prep.column.values <- function( if (converted.n != n) { stop(paste( 'Conversion function changed length of column values', - paste0("(", "expected ", n, ", ", "received ", converted.n, ")") + paste0('(', 'expected ', n, ', ', 'received ', converted.n, ')') )); } converted.NAs <- is.na(column.values); diff --git a/tests/testthat/test-angles.R b/tests/testthat/test-angles.R index 80544a4..12febcb 100644 --- a/tests/testthat/test-angles.R +++ b/tests/testthat/test-angles.R @@ -9,7 +9,8 @@ test_that( test.v <- data.frame( id = test.tree$tip, parent = test.tree$parent, - spread = 1 + spread = 1, + mode = 'radial' ); total.angle <- pi / 2; @@ -39,7 +40,8 @@ test_that( test.v <- data.frame( id = test.tree$tip, parent = test.tree$parent, - spread = 1 + spread = 1, + mode = 'radial' ); total.angle <- pi / 2; @@ -81,7 +83,8 @@ test_that( test.v <- data.frame( id = test.tree$tip, parent = test.tree$parent, - spread = spread + spread = spread, + mode = 'radial' ); total.angle <- pi / 4; @@ -115,7 +118,8 @@ test_that( id = test.tree$tip, parent = test.tree$parent, angle = NA, - spread = 1 + spread = 1, + mode = 'radial' ); test.v[angles.to.override, 'angle'] <- override.values; @@ -142,7 +146,8 @@ test_that( id = test.tree$tip, parent = test.tree$parent, angle = NA, - spread = 1 + spread = 1, + mode = 'radial' ); new.angle <- degrees.to.radians(15); test.v[1, 'angle'] <- new.angle; @@ -174,7 +179,8 @@ test_that( test.v <- data.frame( id = test.tree$tip, parent = test.tree$parent, - spread = 1 + spread = 1, + mode = 'radial' ); test.v$spread[2] <- spread; @@ -216,7 +222,8 @@ test_that( test.v <- data.frame( id = test.tree$tip, parent = test.tree$parent, - spread = 1 + spread = 1, + mode = 'radial' ); test.v$spread[4] <- spread; diff --git a/tests/testthat/test-error.warning.R b/tests/testthat/test-error.warning.R index 7ad6092..bbd91dc 100644 --- a/tests/testthat/test-error.warning.R +++ b/tests/testthat/test-error.warning.R @@ -12,7 +12,7 @@ test_that( 'check.lengths errors if lengths are not equal', { a <- rep('1', 5); b <- rep('2', length(a) + 2); - + expect_error({ check.lengths(a, b, a.name = 'a', b.name = 'b'); }, diff --git a/tests/testthat/test-prep.tree.R b/tests/testthat/test-prep.tree.R index 49d507c..602e1f1 100644 --- a/tests/testthat/test-prep.tree.R +++ b/tests/testthat/test-prep.tree.R @@ -619,7 +619,7 @@ test_that( expect_error( prep.column.values(column.values, default.values), - regexp = "default" + regexp = 'default' ); }); @@ -685,14 +685,14 @@ test_that( expect_error( prep.column.values(column.values, 2, conversion.fun = conversion.fun), - regexp = "length" + regexp = 'length' ); }); test_that( - 'prep.column.values errors if "conversion.fun" introduces NAs in "default.values" ', { + 'prep.column.values errors if "conversion.fun" introduces NAs in "default.values"', { column.values <- rep(1, 5); - default.values <- "test"; + default.values <- 'test'; conversion.fun <- as.numeric; expect_error( @@ -701,13 +701,13 @@ test_that( default.values, conversion.fun = conversion.fun ), - regexp = "conversion" + regexp = 'conversion' ); }); test_that( 'prep.column.values warns if "conversion.fun" introduces NAs in "column.values"', { - column.values <- rep("hello", 5); + column.values <- rep('hello', 5); default.values <- 1; conversion.fun <- as.numeric; @@ -717,13 +717,13 @@ test_that( default.values, conversion.fun = conversion.fun ), - regexp = "conversion" + regexp = 'conversion' ); }); test_that( 'prep.column.values applies conversion function', { - column.values <- rep("10", 5); + column.values <- rep('10', 5); default.values <- 1; conversion.fun <- as.numeric; @@ -739,7 +739,7 @@ test_that( 'prep.column.values replaces NA values after conversion with default', { column.values <- rep(4, 5); non.numeric.indices <- c(2, 3); - column.values[non.numeric.indices] <- "test"; + column.values[non.numeric.indices] <- 'test'; default.values <- 1; conversion.fun <- as.numeric; From db04c33e573bb44483bc0168ac6a41986343d5cb Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 29 Jul 2024 09:11:33 -0700 Subject: [PATCH 32/51] Update changelog format to markdown --- NEWS => NEWS.md | 120 ++++++++++++++++++++++-------------------------- 1 file changed, 54 insertions(+), 66 deletions(-) rename NEWS => NEWS.md (63%) diff --git a/NEWS b/NEWS.md similarity index 63% rename from NEWS rename to NEWS.md index 7fd533a..4a2487c 100644 --- a/NEWS +++ b/NEWS.md @@ -1,29 +1,28 @@ -CancerEvolutionVisualization 2.1.0 2024-05-07 (Helena Winata, Dan Knight) +# CancerEvolutionVisualization 2.1.0 (2024-05-07) -ADDED +## Added * Optional "spread" column to control node/branch spacing * Plotting functions to visualize the distribution of clones across the genome. -UPDATE +## 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 * Set default parameters for heatmaps, defaulting too BPG defaults unless necessary --------------------------------------------------------------------------- -CancerEvolutionVisualization 2.0.1 2023-11-17 (Helena Winata, Dan Knight) -ADDED +# CancerEvolutionVisualization 2.0.1 (2023-11-17) + +## Added * GitHub links for code and bug reports -BUG +## Bug * Fixed S3 naming conflict in heatmap functions, using safe "create." prefix --------------------------------------------------------------------------- -CancerEvolutionVisualization 2.0.0 2023-11-16 (Helena Winata, Dan Knight) +# CancerEvolutionVisualization 2.0.0 (2023-11-16) -ADDED +## Added * Option to specify edge colour with "edge.col.1" and "edge.col.2" columns in tree input dataframe * Option to specify edge width using "edge.width.1" and "edge.width.2" @@ -38,32 +37,30 @@ ADDED "border.col", "border.width", and "border.type" columns * Option ot specify tree node label colour with "node.label.col" column -UPDATE +## Update * Reimplemented tree angle calculations * Fixed lopsided radial tree bug -REMOVED +## Removed * "seg1.col" and "seg2.col" parameters (replaced by tree input columns). * "node.col" parameter to SRCGrob. (Node colour only customizable through tree input data.frame.) --------------------------------------------------------------------------- -CancerEvolutionVisualization 1.0.1 2022-10-03 (Dan Knight) +# CancerEvolutionVisualization 1.0.1 (2022-10-03) -UPDATE +## Update * Package title change for CRAN submission --------------------------------------------------------------------------- -CancerEvolutionVisualization 1.0.0 2022-09-28 (Dan Knight) +# CancerEvolutionVisualization 1.0.0 (2022-09-28) -ADDED +## Added * Documentation for default colour scheme * Checks for valid tree structure - Valid root node - Circular node references -UPDATE +## Update * Changed gene input to a generic node text input, where style and colour are specified directly (not through SNV or CNA values). @@ -75,64 +72,59 @@ UPDATE * Remove README from build --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.10.0 2022-08-01 (Dan Knight) +# CancerEvolutionVisualization 0.10.0 (2022-08-01) -ADDED +## Added * Optional SNV column in gene input data to italicize gene text * Validates gene.line dist input value -UPDATE +## Update * Changed gene input "gene" column to more generic "name" -REMOVED +## Removed * Removed extra.len parameter to allow the value to be inferred by the presence/absence of CP values. * Removed spread parameter until radial nodes are supported. * Removed wid parameter, as it is no longer needed with horizontal.padding * Removed cluster.list parameter until (pie nodes are implemented) --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.9.0 2022-07-20 (Dan Knight) -REMOVED +# CancerEvolutionVisualization 0.9.0 (2022-07-20) + +## Removed * Removed ylimits and yaxis.interval parameters. (yat can be used instead.) * Removed filename parameter from SRCGrob to follow grid patterns. --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.8.0 2022-07-14 (Dan Knight) +# CancerEvolutionVisualization 0.8.0 (2022-07-14) -UPDATE +## Update * Added "smart" branch length scaling based on the branch lengths and tree depth. * The user can still scale the lengths proportionally with the scale1 and scale2 arguments. --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.7.0 2022-06-28 (Dan Knight) +# CancerEvolutionVisualization 0.7.0 (2022-06-28) -UPDATE +## Update * Added yat parameter to allow specific Y axis tick values -REMOVED +## Removed * Removed yaxis.interval parameters (replaced with yat) --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.6.0 2022-06-24 (Dan Knight) +# CancerEvolutionVisualization 0.6.0 (2022-06-24) -UPDATE +## Update * Changed output format to only return the tree grob itself (no longer including intermediate values) --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.5.0 2022-06-24 (Dan Knight) +# CancerEvolutionVisualization 0.5.0 (2022-06-24) -UPDATE +## Update * Automatically sets the branch angle to pi / 6 * Infers whether to draw polygons based on existence and changed parameter to optionally disable polygons @@ -147,7 +139,7 @@ UPDATE * Changed "nodes" parameter to boolean "draw.nodes" to enable/disable node circles -REMOVED +## Removed * Removed the fixed_angle argument (to be replaced by an angle column in the tree input data.frame) * Removed add.genes parameter @@ -157,66 +149,62 @@ REMOVED * Disabled genes.on.nodes mode --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.4.1 2022-05-05 (Dan Knight) +# CancerEvolutionVisualization 0.4.1 (2022-05-05) -UPDATE +## Update * Automatically adjusts node size, shape, and text size based on the length of the label text --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.4.0 2022-05-03 (Dan Knight) +# CancerEvolutionVisualization 0.4.0 (2022-05-03) -UPDATE +## Update * Combined gene input dataframes into one -BUG +## Bug * Fixed issue when trunk node is not positioned first in the input tree --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.3.0 2022-04-29 (Dan Knight) +# CancerEvolutionVisualization 0.3.0 (2022-04-29) -UPDATE +## Update * Allow node labels to be specified separately -BUG +## Bug * Fixed issue when creating ellipse nodes for longer labels --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.2.1 2022-04-14 (Dan Knight) +# CancerEvolutionVisualization 0.2.1 (2022-04-14) -UPDATE +## Update * Allow tree input without CP and validate CP input values --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.2.0 2022-04-12 (Dan Knight) -UPDATE +# CancerEvolutionVisualization 0.2.0 (2022-04-12) + +## Update * Include tree preparation in SRCGrob to simplify use and improve consistency. --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.1.1 2022-02-23 (Dan Knight) -UPDATE +# CancerEvolutionVisualization 0.1.1 (2022-02-23) + +## Update * Remove input sampling (assume that data has been prepared properly) --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.1.0 2021-11-08 (Dan Knight) -UPDATE +# CancerEvolutionVisualization 0.1.0 (2021-11-08) + +## Update * Add functions for deep comparison of plot Grobs. * Update tests to use new comparisons and add test cases. --------------------------------------------------------------------------- -CancerEvolutionVisualization 0.0.0 2021-09-13 (Adriana Salcedo) + +# CancerEvolutionVisualization 0.0.0 (2021-09-13) INITIAL FEATURES From 013a84ad63eeb2fc0c2df5984873bf2a8a93011c Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 29 Jul 2024 10:00:43 -0700 Subject: [PATCH 33/51] Update changelog --- DESCRIPTION | 6 +++--- NEWS.md | 7 ++----- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1e9ad62..d76a7c6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots -Version: 2.1.0 -Date: 2024-05-07 +Version: 2.1.1 +Date: 2024-07-29 Authors@R: c( person("Paul Boutros", role = "cre", email = "PBoutros@mednet.ucla.edu"), person("Adriana Salcedo", role = "aut"), @@ -14,7 +14,7 @@ URL: https://github.com/uclahs-cds/package-CancerEvolutionVisualization BugReports: https://github.com/uclahs-cds/package-CancerEvolutionVisualization/issues Depends: R (>= 3.5.0), - graphics, + graphics, grid, gridExtra, gtable, diff --git a/NEWS.md b/NEWS.md index 4a2487c..856c287 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# CancerEvolutionVisualization 2.1.0 (2024-05-07) +# CancerEvolutionVisualization 2.1.0 (2024-07-29) ## Added * Optional "spread" column to control node/branch spacing @@ -9,6 +9,7 @@ their parent angle, instead moving "downward" at 0 degrees. * Updated package metadata and README * Set default parameters for heatmaps, defaulting too BPG defaults unless necessary +* Updated changelog format to NEWS.md Markdown format # CancerEvolutionVisualization 2.0.1 (2023-11-17) @@ -180,7 +181,6 @@ * Allow tree input without CP and validate CP input values - # CancerEvolutionVisualization 0.2.0 (2022-04-12) ## Update @@ -188,14 +188,12 @@ consistency. - # CancerEvolutionVisualization 0.1.1 (2022-02-23) ## Update * Remove input sampling (assume that data has been prepared properly) - # CancerEvolutionVisualization 0.1.0 (2021-11-08) ## Update @@ -203,7 +201,6 @@ * Update tests to use new comparisons and add test cases. - # CancerEvolutionVisualization 0.0.0 (2021-09-13) INITIAL FEATURES From fb4e1a806aec8113b23c59efc7707aba05f0ad69 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 30 Jul 2024 12:04:48 -0700 Subject: [PATCH 34/51] Fix documentation --- man/create.ccf.summary.heatmap.Rd | 6 +++--- man/create.cluster.heatmap.Rd | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/man/create.ccf.summary.heatmap.Rd b/man/create.ccf.summary.heatmap.Rd index 10b64b3..d400aa3 100644 --- a/man/create.ccf.summary.heatmap.Rd +++ b/man/create.ccf.summary.heatmap.Rd @@ -6,9 +6,9 @@ Creates a heatmap of cancer cell fraction (CCF) distribution across tumour sampl } \usage{ -create.ccf.summary.heatmap <- function( +create.ccf.summary.heatmap( DF, - ccf.thres = 0, + ccf.thres = NULL, median.col = 'median.ccf.per.sample', clone.order = NULL, sample.order = NULL, @@ -25,7 +25,7 @@ create.ccf.summary.heatmap <- function( legend.title.cex = 1.2, legend.label.cex = 1, ... - ) + ); } \arguments{ \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.} diff --git a/man/create.cluster.heatmap.Rd b/man/create.cluster.heatmap.Rd index 714a7d0..e484cc3 100644 --- a/man/create.cluster.heatmap.Rd +++ b/man/create.cluster.heatmap.Rd @@ -5,7 +5,7 @@ Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap. } \usage{ -create.cluster.heatmap <- function( +create.cluster.heatmap( DF, clone.colours = NULL, height = 6, @@ -21,13 +21,13 @@ create.cluster.heatmap <- function( y.spacing = 1, colour.scheme = c('white', 'blue'), ... - ) + ); } \arguments{ \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.} \item{clone.colours}{Named list to provide a colour scheme for the clone ID covariate bar. If NULL, colours will be randomly generated. Defaults to \code{NULL}.} - \item{plt.height}{Defaults to 6} - \item{plt.width}{Defaults to 11} + \item{height}{Defaults to 6} + \item{width}{Defaults to 11} \item{xaxis.col}{Column in DF to extract x-axis labels from. Defaults to \code{NULL}.} \item{legend.size}{Width of the legend boxes in 'character' units. Defaults to 3} \item{legend.title.cex}{Size of titles in the legends. Defaults to 1.2} From 2d27a49adb61f72791a7858212f6fed9d2f89810 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 30 Jul 2024 12:06:07 -0700 Subject: [PATCH 35/51] Update changelog --- DESCRIPTION | 2 +- NEWS | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1e9ad62..0576914 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots Version: 2.1.0 -Date: 2024-05-07 +Date: 2024-07-30 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 d4a98c9..1eb2f46 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -CancerEvolutionVisualization 2.1.0 2024-07-19 (Helena Winata, Dan Knight) +CancerEvolutionVisualization 2.1.0 2024-07-3 (Helena Winata, Dan Knight) ADDED * Optional "spread" column to control node/branch spacing From d622bebde3f44847a73d3d0fadd99ff63d262c7a Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 31 Jul 2024 15:41:20 -0700 Subject: [PATCH 36/51] Remove stringr dependency --- DESCRIPTION | 1 - NAMESPACE | 1 - 2 files changed, 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3ae322b..cf38905 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,6 @@ Depends: Imports: grDevices, utils, - stringr, BoutrosLab.plotting.general Suggests: testthat, diff --git a/NAMESPACE b/NAMESPACE index 091ac19..e90b7b5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ import(BoutrosLab.plotting.general) importFrom("graphics", "par", "strheight", "strwidth") importFrom("grDevices", "dev.list", "rainbow") importFrom("utils", "read.table", "vi", "head") -importFrom("stringr", "str_replace_all") importFrom("stats", "setNames", "aggregate", "reshape") importFrom("grDevices", "col2rgb") From 98bc10637d2a132d8839c5065c82f068c0c86703 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 31 Jul 2024 15:42:27 -0700 Subject: [PATCH 37/51] Update changelog --- DESCRIPTION | 2 +- NEWS | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cf38905..f52d5ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots Version: 2.1.0 -Date: 2024-05-16 +Date: 2024-07-31 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 348cb88..985134f 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -CancerEvolutionVisualization 2.1.0 2024-05-16 (Dan Knight) +CancerEvolutionVisualization 2.1.0 2024-07-30 (Dan Knight) ADDED * Optional "spread" column to control node/branch spacing @@ -7,7 +7,7 @@ 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 -* Refactored use of plyr/dplyr functions to remove dependencies +* Refactored use of plyr/dplyr and stringr functions to remove dependencies -------------------------------------------------------------------------- From efb60c2bee646c0fcb60033ad5341087cadd644b Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 31 Jul 2024 15:52:38 -0700 Subject: [PATCH 38/51] Reimplement stringr filtering function --- tests/testthat/helper-compare.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/helper-compare.R b/tests/testthat/helper-compare.R index b929b71..0d175d4 100644 --- a/tests/testthat/helper-compare.R +++ b/tests/testthat/helper-compare.R @@ -13,7 +13,7 @@ compare.trees <- function(example, test) { } get.axis.keys <- function(x) { - stringr::str_subset(x$childrenOrder, 'axis'); + x$childrenOrder[grepl('axis', x$childrenOrder)]; } # Grob comparisons @@ -172,7 +172,7 @@ compare.trees <- function(example, test) { test.polygon.grobs <- function(example, test) { get.polygon.keys <- function(x) { - stringr::str_subset(x$childrenOrder, 'polygon') + x$childrenOrder[grepl('polygon', x$childrenOrder)]; } compare.polygons <- function(x, y) { From 658240d028ad49cdfe9bf01119a5c2f472ce2e49 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 6 Aug 2024 16:44:57 -0700 Subject: [PATCH 39/51] Fix bug in radial angle calculation --- R/angles.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/angles.R b/R/angles.R index 9c3e24b..23b4f4f 100644 --- a/R/angles.R +++ b/R/angles.R @@ -35,11 +35,12 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { level.total.angle <- total.angle * level.spread; angles <- split.equal.angle( - level.total.angle, - child.ids, - angles, - tree, - v + base.total.angle = total.angle, + level.total.angle = level.total.angle, + child.ids = child.ids, + angles = angles, + tree = tree, + v = v ); if (v$mode[v$id == current.node.id] == 'radial') { #if parent is 'radial' angjust starting angle @@ -67,6 +68,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { } split.equal.angle <- function( + base.total.angle, level.total.angle, child.ids, angles, @@ -76,7 +78,7 @@ split.equal.angle <- function( num.children <- length(child.ids); num.slices <- max(num.children - 1, 1); - angle.increment <- level.total.angle / num.slices; + angle.increment <- base.total.angle / num.slices; start.angle <- - (level.total.angle) * (num.children > 1) / 2; previous.angle <- start.angle; From d163f9f488a015cd60b42d158503c316658ec551 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 12:02:42 -0700 Subject: [PATCH 40/51] Refactor adply implementation --- R/add.segs.R | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 498f295..6ff8c02 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -24,7 +24,7 @@ calculate.coords.radial <- function( side ) { - angle <- x$angle; + angle <- x['angle']; offset.x.modifier <- offset.y.modifier <- 1; if (side == 'left') { @@ -43,16 +43,16 @@ calculate.coords.radial <- function( )); } - if (x$parent == -1) { + if (x['parent'] == -1) { basey <- 0; basex <- 0; } else { - basey <- v$y[parent.id]; - basex <- v$x[parent.id]; + basey <- v[parent.id, 'y']; + basex <- v[parent.id, 'x']; } - dy <- x[, length.colname] * cos(angle); - dx <- x[, length.colname] * sin(angle); + dy <- x[length.colname] * cos(angle); + dx <- x[length.colname] * sin(angle); offset.x <- offset * cos(angle) * offset.x.modifier; offset.y <- offset * sin(angle) * offset.y.modifier; @@ -102,7 +102,7 @@ calculate.coords.dendrogram <- function( side ) { - angle <- x$angle; + angle <- x['angle']; offset.x.modifier <- offset.y.modifier <- 1; if (side == 'left') { @@ -121,17 +121,17 @@ calculate.coords.dendrogram <- function( )); } - if (x$parent == -1) { + if (x['parent'] == -1) { basey <- 0; basex <- 0; } else { - basey <- v$y[parent.id]; - basex <- v$x[parent.id]; + basey <- v[parent.id, 'y']; + basex <- v[parent.id, 'x']; } dy <- x[, length.colname]; - x.length <- v[x$tip, 'x.length']; - dx <- if (is.na(x.length)) x[, 'length'] * tan(angle) else x.length; + x.length <- v[v$tip == x['tip'], 'x.length']; + dx <- if (is.na(x.length)) x['length'] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; basex <- basex + dx + offset.x; @@ -168,12 +168,12 @@ calculate.seg.coords <- function( side ) { - segs <- adply( + segs <- apply( tree, - .margins = 1, - .fun = function(x) { - node.id <- which(v$id == x$tip); - parent.id <- which(v$id == x$parent); + MARGIN = 1, + FUN = function(x) { + node.id <- which(v$id == x['tip']); + parent.id <- which(v$id == x['parent']); coords <- if (v[node.id, 'mode'] == 'radial') { calculate.coords.radial( @@ -198,6 +198,10 @@ calculate.seg.coords <- function( return(coords); } ); + + segs <- do.call('rbind', segs); + rownames(segs) <- rownames(tree); + segs <- cbind(tree, segs); return(segs); } From cb5cbcfcd5bc382f81596f211ff7c3d1198c2639 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 12:03:13 -0700 Subject: [PATCH 41/51] Fix code style --- R/prep.tree.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/prep.tree.R b/R/prep.tree.R index 3ac9614..d0eaf7b 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -402,7 +402,7 @@ prep.branch.mode <- function(tree.df) { split.df <- split(tree.df, tree.df$parent); n.mode <- sapply(split.df, function(x) length(unique(x$mode))) - if (any(n.mode > 1)){ + if (any(n.mode > 1)) { invalid.parent.str <- paste(names(n.mode[n.mode > 1]), collapse = ' ') stop(paste('"mode" must be consistent across children sharing a parent.', 'Multiple modes specified for children of:', invalid.parent.str From 6950f1cf36f64295fe2827a4315d0957d17507e1 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 12:07:16 -0700 Subject: [PATCH 42/51] Update function imports from base R --- NAMESPACE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index c8e9d06..370b2ac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,7 @@ import(BoutrosLab.plotting.general) importFrom("graphics", "par", "strheight", "strwidth") importFrom("grDevices", "dev.list", "rainbow") importFrom("utils", "read.table", "vi", "head") -importFrom("stats", "setNames", "aggregate", "reshape") +importFrom("stats", "median", "setNames", "aggregate", "reshape") importFrom("grDevices", "col2rgb") export(SRCGrob) From 5161148f0ebaf1a48f075375c2ca58c435e04acb Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 12:21:32 -0700 Subject: [PATCH 43/51] Fix typo --- R/prep.tree.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/prep.tree.R b/R/prep.tree.R index d0eaf7b..86ea461 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -514,7 +514,7 @@ prep.connector.line.width <- function( connector.line.width, branch.line.width, a.name = 'connector.line.width', - b.name = 'branch.line.width', + b.name = 'branch.line.width' ); NA.indices <- is.na(branch.line.width) connector.line.width[NA.indices] <- branch.line.width[NA.indices]; From 268d8651e50c88996f11c9c333a71db21177dda4 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 14:52:21 -0700 Subject: [PATCH 44/51] Fix bug when creating tree segments --- R/add.segs.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 6ff8c02..18234a0 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -129,8 +129,8 @@ calculate.coords.dendrogram <- function( basex <- v[parent.id, 'x']; } - dy <- x[, length.colname]; - x.length <- v[v$tip == x['tip'], 'x.length']; + dy <- x[length.colname]; + x.length <- v[v$id == x['tip'], 'x.length']; dx <- if (is.na(x.length)) x['length'] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; @@ -238,8 +238,6 @@ add.tree.segs <- function( side = 'right' ); - valid.segs <- tree.segs2$basey != tree.segs2$tipy & tree.segs2$basex == tree.segs2$tipx; - tree.segs2 <- tree.segs2[valid.segs, ]; } else { tree.segs2 <- NULL; } From e7683641648f81694e6a54e43d4a2f5923aa75a5 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 16:52:31 -0700 Subject: [PATCH 45/51] Handle types when calculating seg coords --- R/add.segs.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 18234a0..8e0ec5c 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -57,11 +57,11 @@ calculate.coords.radial <- function( offset.x <- offset * cos(angle) * offset.x.modifier; offset.y <- offset * sin(angle) * offset.y.modifier; - tipx <- basex + dx + offset.x; - tipy <- basey + dy + offset.y; + tipx <- as.numeric(basex + dx + offset.x); + tipy <- as.numeric(basey + dy + offset.y); - basex <- basex + offset.x; - basey <- basey + offset.y; + basex <- as.numeric(basex + offset.x); + basey <- as.numeric(basey + offset.y); return(data.frame( basex, @@ -97,7 +97,6 @@ calculate.coords.dendrogram <- function( x, v, length.colname, - parent.id, offset, side ) { @@ -134,10 +133,10 @@ calculate.coords.dendrogram <- function( dx <- if (is.na(x.length)) x['length'] * tan(angle) else x.length; offset.x <- offset * offset.x.modifier; - basex <- basex + dx + offset.x; + basex <- as.numeric(basex + dx + offset.x); tipx <- basex; - tipy <- basey + dy; + tipy <- as.numeric(basey + dy); return(data.frame( basex, From 5b013a56a71c26e262f3c22130fbebc2aac764d1 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 7 Aug 2024 17:52:56 -0700 Subject: [PATCH 46/51] Dendrogram regression/E2E test case --- .../testthat/data/branching.dendrogram.data.Rda | Bin 0 -> 256 bytes .../testthat/data/branching.dendrogram.plots.Rda | Bin 0 -> 5149 bytes tests/testthat/test-dendrogram.R | 12 ++++++++++++ 3 files changed, 12 insertions(+) create mode 100644 tests/testthat/data/branching.dendrogram.data.Rda create mode 100644 tests/testthat/data/branching.dendrogram.plots.Rda create mode 100644 tests/testthat/test-dendrogram.R diff --git a/tests/testthat/data/branching.dendrogram.data.Rda b/tests/testthat/data/branching.dendrogram.data.Rda new file mode 100644 index 0000000000000000000000000000000000000000..641e7b8463d3d1edd17c91664a229c3f2d07a420 GIT binary patch literal 256 zcmV+b0ssCViwFP!000001GP~-Z^AGTeIyPosX$2G`wwb~c432|;s;b9vAX!0AQ1;S zmJk#DE&YX^8AvbSP?4cxXf55nd-i=ionK$(&+$A45JCv{5r>Fo)5+ry5CM}G1Uifl zZ&sN_x-^N@WVFo_t1{`Ra8fI$fZ+a^jj%%Qg&tdb_f>Vg`5YY)7~^;3)356M)c9xC zKi+t)wZ?0)p|!15k&^x+cDen?sEi6fP}HewWyv_tM3!sv@$HIC;!-*A{El=&(rwoy zpBkMzHs8p)dzUTvU{{vqzA0g`QbjGHb>1TXy?o~-60^gpBq$qM!ddd~ID7*cgbFTn G0ssICQhE3Q literal 0 HcmV?d00001 diff --git a/tests/testthat/data/branching.dendrogram.plots.Rda b/tests/testthat/data/branching.dendrogram.plots.Rda new file mode 100644 index 0000000000000000000000000000000000000000..a38e4a3e736fbcb676050c1333ed62786753571b GIT binary patch literal 5149 zcmds*`#;nD|HmDY^C65Rq*Sgsl~XH+YBW__$ zHDAg~iUJaEBe{}yN8E>9@C`}X8D(|3?4<9u95(MDcKy56Y6B93K}~ylwW?yWMzS<5 zcazlFD0g=mC7uu(Ff?JW6t3Xr;+B1RZ0D87ccVqDKqq#Ui+|8Wyb35?Uwxr7klH)v z7H~Bj-{*3Bcnu0xjy)+yXe@U=pJ^f^L3G?Y6$*rA<$g|G~MpNoS+S3ntU@uY%Rf`v^Q$V7!==Q`8-^$kVag=5nuB!;2L92-(xL>}kALD%Iq*9L>;TuJ&2m zNVoob?UA6b(TD6DPBSLUgldB~PK=mz7kj$8!$srGQ1vnjrIGSF`@$_$TjM|Hm=^B5 zpW;H23qOf`gV!{FK6|m*w}0ZvbGJ6=3dtf6TP8gRJN>@Dp1AzPrJ}6!;FPliLmD>w zpwX(=Ut3AykSP(nle%WLavd*KiCHT-K1^*XN(OtZ6!|eOy!wLcWz5t~L8WQyt11Nv zaK=3B@^C5V+>Dy8Xqkr)xMjmSZ1hH0x#Mz+bqTGrGs;CqNBvSw_JJoRZs(%R2JLOr5Medg(d3YvuWqNGzdN;&`by!A)8c}YKx4w6lBfHWxEFJnHevgo&P%7 z%hMVzrM!A8S@ISwNjYe^k$T&{jhG(RGROcv=?3%);v?Ny)Zy>I1m;u?15 zi{JhbePu1pnVE)>?ekl)C4OOnShsS!jr1=6y7=_T#!7yfiAvUU%DPrMp&?rDFsBo? zfOf~&ZP`P1rA4ldlGnp$CO93jE6@bvfb`&+xqhfAYAL*joYY%U&}@Ks6+}wFGbTfz z7T$X6vnzRos#6)Ckn~4){KK3I0(m(}SMf_jQg{g6NC0yjL3?5EC>`>EeX4xwD5L4( zendSh6|K8oH#uiJ_>Ps@(lEF_qaq1N9dS#7c-;+@Fej;LW97Y|S5PS+{rEu#8oIDJ z=%ZINZM(m)dT#2ds@`WFxWFwNTXm$Pw;rg!^%D}j^|_@0W_TNH4B0wfO96Exi|m9o z$j!?@G8a?r0vdP;Z+F6I)m!}=2vj*B%$p>5VxR&j5=QIVIJMeZ|(j_fky$kqu-1;FJ9yIHZ`1(BCdk*)i% zb>!WtuvId5qabG9G=H_)5mgXg2-zI{1Fiz!JNFISxqOe+w1_%5AR-Y9V zTL{zRz}s8uaYPF7U^0b(N22=jnK$*hIN&fYS!6VitSIc5Yy=xvJ_1nw5GA+Y0)d!1 zrrFS3G6qK%gQ3O0{HLD!s9F zzv~SiSvgowgrXA(jq9!?b${sw(rhGx*f5vMcO#<(PHlk^F&eCJb*w%MD6UXQ&j@e7 zP0uJ&hz$c+VgbV6^vDW_b4loe6(az_zrWKJJawA63&yrw%tKVK&&3MYExJ+6OxL`b zP3#{Vn_IO7MgszpjbH(T|7`ESe8B-nKwhl8vRh!5OdHu(^MSN~_%bTsA+-zQSv|L( z19r$?fd@0>WCRq@&RUNnTLGx)1P=#%z6!*w+aI=YGwa`q`&~rSJ`H$d12fIGUUZLR z76|APpcvdhkNlx%z>)q#eSdYzO#hd|^3Ne)ioTWZ`=R=lB2W)D=5`wA%%fA0|36FU zcULyXTzW@eZS%m}fyXGti}-q5>F$8F3+Q*V0Tv3MYCBiN(4jsV>{Ho@mF23G0bdnP zl8QFH%wr>X>?AQ7X0El8iF_Y2T^96kLKncjWL22&HXwGT$H9Y{QjA0~r-whSu8|&$~Pm5b%08*_1 zEP4zLUe^PubSdz`7}a5|^!e0&$MZ-ED2FnF1XJ?fvf9M5DDFURw?({Wwb3rn6dMGL z9)A5CSlTwF&x9=9834DElS|5d7BB$Fly*sv6zEPQ2#ntPdcP}iRK)Q!6QY9T@^68R zZ3Y5x-+CI&bgk$JFx-LtXg#Y<^;sDgU=HnZZXPD^!Ae~ZD@=KY`}qxbU#T|)8vNgk z`&X|xp8n1?fQD=!-ZS!~E+UKOCMcPGwh6<{9{isu+vFz`EdP_AzqiCD6ajL;WRP3H zX%H3#xGp~u+RVlzERc8Re{d0q@f*tATYUUUllG-!ydL$2k^d&y_h7!GWfM=1rvU;o zyKR%Kd_baa4*yp3zi}go4SXLtxe;wB*T#pm-_VW6{e-CndCRlbP^!NplbHCb>myOT` zvifyBA9K1uXe^=sY~1gbZr{N67>s`0%eXp-#P@%kZ1`xcROJPyl$Cxcw)cW>iM;gG z>Xr4gkJ}Y&XL@o;m0AJBQl%0cH3Bnq&r^QFj^uER47>-bFP|a$zHSyRZ-ZR;E z49kyx`|-ZS$CdMtxX8CZ$;3Efa-z;h0-DoN;IVrrzhcI9Ya$7rFtA_ft&$~>(wykgB0nQT}eh0l`rFBkNWAyJS?w(y_4a+N4bV6li^UTQg z+Lx5^-IbrKPHd1g0&3_aH7(!2iw#Cxz4tbVk$X;*{Z;;!{LxG#9>FVfKr-OQHBrcJ zWnqW4o(~J-g1!Sa>XHQ)Hf9Rjb$y7Bjwg7u+>^4j@Tkc)N3Y#QK)=M6DfK?z!jB&Z zZhuL)dhV9tY#mjL_lT#oVY}|{aRV-WZz~8}b$T|he2wjuPtwHPQGb=261>dIU2T;M zo>&{zbe;%*xdaNaba1wN@--;M-g_oTx3VQrbAY&h_{3fftXWk0z%A?4mKT%WZhb|8 zj7lLg0;^=Q>|%q2wdq&RE)H28A2iMgAnk!;1}pP%?b^5RK&D?t35hoL5$JB)X;`mUX(; z>2C|}Fv_4QGX1!1i={53D`9gPYXRYe)r*8xuFZ@vBHZM{+)3__1>{`slxFG1;%6J zb?LJ^EHf0B`-yR!LH1IwtaTJR1-iDLqDhuZ&64k>Y-A-p6kE3Nd?&Wlj5A3N9+sle zAX<|lO%08Xsk%0E1&vU?1-WSnKGg<^uC9IYla=HL)rb10ZC`J^8N7d$-zeK_UrmS; zHx)7Z;NGMlgu2U9$jBtMZfZoHr*2vOm$pf+9NN(!XlpQ0GXm$jU6hSTe)ZBmZ}E=TA4!e;V8BCxUB z=H-QVU$q5mKrBen8 zF&V>^^Ipm*wfvE!(ACwVC%Ka}yDJW=U7iZ5YAd0Z*Lve06O!&m85V!Z>RU5!>C0NV z^X#zJgDR?ou>VstUA(RLCyiQ@oqK}+-vw{TmHt-LHnX}uqM-UIy zHenet*8#X{jEU~0857kG_%jLHXngUIII?fqv^F}1=zhrW@HwH^Azk&KKL?0}tO*gS zZ(eMb@LpskzeoYsifRSQ-aBtmY>>&%G1t~0ud;SnR-m-Y4_efwRjXLT=)LI45%lbE xK=;F~(2{bT+hlpuym^|aO*RA&v-z;;%a{{zEQDw+TQ literal 0 HcmV?d00001 diff --git a/tests/testthat/test-dendrogram.R b/tests/testthat/test-dendrogram.R new file mode 100644 index 0000000..29924c6 --- /dev/null +++ b/tests/testthat/test-dendrogram.R @@ -0,0 +1,12 @@ +test_that( + 'Fixed branching case values', { + load('data/branching.dendrogram.plots.Rda'); + load('data/branching.dendrogram.data.Rda') + + result.tree <- SRCGrob(branching.dendrogram.test.data$tree); + expect_true(compare.trees( + result.tree, + branching.dendrogram.example + )); + } +); \ No newline at end of file From 5560b1875173a11a367b368552f9c4bc0a478af8 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 14 Aug 2024 11:18:13 -0700 Subject: [PATCH 47/51] Refactor equal X-dist --- R/add.segs.R | 2 ++ R/angles.R | 73 ++++++++++++++++++++++++++++------------------------ 2 files changed, 41 insertions(+), 34 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 8e0ec5c..6368c26 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -97,6 +97,7 @@ calculate.coords.dendrogram <- function( x, v, length.colname, + parent.id, offset, side ) { @@ -163,6 +164,7 @@ calculate.seg.coords <- function( tree, v, length.colname, + parent.id, offset, side ) { diff --git a/R/angles.R b/R/angles.R index 23b4f4f..d118c00 100644 --- a/R/angles.R +++ b/R/angles.R @@ -2,7 +2,9 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { root.node.id <- v$id[[1]]; node.ids <- c(root.node.id); - random.scale <- median(tree$length1) * spread; + # random.scale <- median(tree$length1) * spread; + random.scale <- 1; + angles <- v$angle; x <- numeric(nrow(v)); @@ -28,15 +30,14 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { parent.angle <- 0; angles[tree$tip == current.node.id] <- parent.angle; } + + level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); if (unique(v$mode[v$id %in% child.ids]) == 'radial') { # if all children are radial, spread evenly by angle - level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); - level.total.angle <- total.angle * level.spread; - angles <- split.equal.angle( base.total.angle = total.angle, - level.total.angle = level.total.angle, + level.spread = level.spread, child.ids = child.ids, angles = angles, tree = tree, @@ -51,12 +52,12 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { child.ids <- v$id[v$id %in% child.ids]; # if all children are dendrogram, spread evenly by x distance angles <- split.equal.x.dist( - current.node.id, - child.ids, - angles, - tree, - v, - random.scale + base.total.angle = total.angle, + level.spread = level.spread, + child.ids = child.ids, + angles = angles, + tree = tree, + v = v ); } @@ -69,7 +70,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { split.equal.angle <- function( base.total.angle, - level.total.angle, + level.spread, child.ids, angles, tree, @@ -78,6 +79,8 @@ split.equal.angle <- function( num.children <- length(child.ids); num.slices <- max(num.children - 1, 1); + + level.total.angle <- base.total.angle * level.spread; angle.increment <- base.total.angle / num.slices; start.angle <- - (level.total.angle) * (num.children > 1) / 2; @@ -101,41 +104,43 @@ split.equal.angle <- function( } split.equal.x.dist <- function( - current.node.id, + base.total.angle, + level.spread, child.ids, angles, tree, - v, - random.scale + v ) { - num.slices <- v$leaves[v$id == current.node.id]; - x.pos <- 1:num.slices - num.slices %/% 2; + num.children <- length(child.ids); + num.slices <- max(num.children - 1, 1); + + largest.edge.length <- max( + tree$length[tree$tip %in% child.ids[c(1, length(child.ids))]] + ); + base.total.dx <- tan(base.total.angle) / largest.edge.length; + level.total.dx <- base.total.dx * level.spread; - if (num.slices %% 2 == 0) { # if even - x.pos <- x.pos - 0.5 - } else { - x.pos <- x.pos - 1 - } + dx.increment <- base.total.dx / num.slices; + start.dx <- - (level.total.dx) * (num.children > 1) / 2; - idx <- 1; + previous.dx <- start.dx; for (i in seq_along(child.ids)) { child.id <- child.ids[i]; - n.leaves <- v$leaves[v$id == child.id]; - j <- idx + (n.leaves %/% 2); - if (n.leaves %% 2 == 0) { # if even - current.pos <- x.pos[j] - 0.5 - } else { - current.pos <- x.pos[j] - } - angle <- angles[tree$tip == child.id]; + dy <- tree$length[tree$tip == child.id]; + if (is.na(angle)) { - y <- tree$length[tree$tip == child.id]; - angle <- atan((current.pos * random.scale) / y); + if (i == 1) { + dx <- start.dx; + } else { + pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; + dx <- previous.dx + dx.increment * mean(pair.spread); + } + angle <- atan(dx / dy); angles[tree$tip == child.id] <- angle; } - idx <- idx + n.leaves; + previous.dx <- dx; } return(angles); } From ceb4bed09d582f8300c682fb8888b5d0cf1bc125 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 14 Aug 2024 11:18:22 -0700 Subject: [PATCH 48/51] Update dendrogram regression test --- .../data/branching.dendrogram.plots.Rda | Bin 5149 -> 5104 bytes tests/testthat/test-dendrogram.R | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/data/branching.dendrogram.plots.Rda b/tests/testthat/data/branching.dendrogram.plots.Rda index a38e4a3e736fbcb676050c1333ed62786753571b..0145777c77b4f0d81a13d69ac36ca8137f792aa3 100644 GIT binary patch literal 5104 zcmaJ^2{@E%`=22Z*^(tj8s*T8ED=eTWcw(_F_y86?8{hcvX2Zx5v3&AB8sW3!`QMM zM3#dlds#}>#=aBd|Bf90(>cCxuDRapdY^fo-@W|q`*+VHbdL$N^P!(kz7++r7kody zGQEPncf$B2l*5+pl&imzDo3nh@Z+_RhJ{S{b)c=a!P-_$;BXY+!J;^zF>7W9ol$W!eiD z7ZS$Zo~^fv4g}U~iQZAUknL<{+%j5$UmVPQQoWMsHg1*eTox72_W}DUrbOBHPDW45 zxkB_AqbUFSf;ab-&Cl{I^@ZE}YCRj9Hk_mC{RdJw**rb_Hr;c1r6tdEO7LaGy^8FN zuepvm$_;$atJ`L!o)!}FCh|#x{^E`1R9uzoWUc^OQow=jZKnRs9K6$ltPSqNP*oY} z+zSqqZHgh4c&hE0Lh)u~pDm`UamlIuo?Z8>a9>^gOyE|{9r+32MEt|3?Ce*Ui629n zA=+KITp6?} z@93H73uvjLH>-$xzkEzwiwm#h4%<*_lIhK#a(LCHonmtiUk7at(*9AB5?gZ1+czPY zp{zhm*L^Ts7Gs@`konW)YB#yJO`*iO?WujG^QUDg8AG>5VR7@!ehKkX`vJ-;YZvK+ zX3Db5X6#GJPd68szX=<;^tv|{jK3Xu;-*`i^~60P?os=xb#=Y*nutHwdXtAPj`&qX z%71T7qsF>HL*4x8AHuC~6Cb|1WN`j0>TsZVoMYWm%$h=**adGH6jr0U0+Jy<&q8-< zgXCbwEqOT;t_eq-yNoW+@DAxXx8!uEKYM0|xkO8_j+FDn;Lt+(YLHEf?3h4tN9XX3 zLXO;f*42_l)$>`wt<#P(5#4!~3o|#-rK1AVL#$R_L#Wl_%x7C&M)Gd!)D%OlHk{L< zsC&xfS>=E;c7z*Jt6 zYSAP;%(Ueb=^>QAjL3Jkud`$()=lRxE##6!-(5F~^gZua5ycDV z?>;7t!O0FcIem3r-dReA#PAk3=F~f3tc9Cn&HV-E{OX0hviaUC}admX!!+er`D`)%l@5PS&pgf8GyFRR4X|8ud=zJP=LRV67 zYrXTcLfW9p>bT>eRqIXFtu}?c3g0hh7}yA_RL60yp31@DAb+2)#g#)Bw)G(hpX%## zwe1!Q{Pdm0s-se-Bn^7sVEWe+##h-0Hu?M`L9pXs4K_l+@oYC~ONB^Gw56`R2uORs%Sk_yta5lmJumUXVDHeih6@nNL$!lPw4u5J}q+H zqHdy@7g#?ycaafE&VjHIgzajCkBT1$ zL(<`2OM+S<2*5(-8ekx?By+J!O0pQBxC12je4U1~F@zh^2*)xtR%HeBjK4G!9_HQ8i#m zjfnw?V0s?J%nUt%Fo1^A!NfulstjQqf7`U+m!D4CCk4O)$>rw;4lekys)unLA-JmX z5dH<$ENU0b3_Xgtv_BqT6pTdvG`im=AZ>Is8#~Tv4w(XJML;DZqBb_+CesRz z9>v?N*G4Cp!N?+WPE`#?I32;MGZ6&iw}b{oYML;mr4Qu*kDrEsrQPU2Fj(l45I2w7 zzQ3h1!o@>5R5dc-2N3I5a;%}DAXsXTswv=U^KW)wmY*4-VE~)LIOqrgYCQQIY9Maz z{qg>nEgHrs7cqzi10)a>N0v8MhO+G13QpHEP_0jg0}Q%rfVm;rKr#$4%!F&6VE~_& z09}D4=`_yvNgvIfUy0q_1cV2pahn0a0^#kD4TOhef(8TO?L!z4-oLs1yV0FA{H;)S z2-~eDz{U=3KMU$-GXSh=(|X|#!cnRW7f?dT4L1-UMBk_4B;rZQpbYIw>K*a zCyT5KRR`Y6u6Il7iFL9%f!eXE+yjyIo*IXZ0X2@)0?n=T;*s;$Zpi@BXt}NkJP&QM z08i4v;e{HZfaWW=2{vqV7XX~X3n}!kpXLQd(ZBX(0a<*cX6(prMM3fUJFw~V1!oXY zX>Q8%U2>^08f({X(QI3;Gt&GBNB~Znsk{dpRpf650q0paVT{OmY-K9=`$=3#OuY|Z zn#(-aqH}WUf%kntht$pK4c?zuO3aL>++f5D^5AG;sD#XYDBEUvl>^k^B{V zuSWN6xP6rL5GqX>bOR(BvtC zYdU-nd1uCc(At^JyOSCi%wQN0o2XEbJ|u`6mU{3HQM>2ABHcosK@&1yG@tjNYC(XL zqKdGjiO7HYvN!T~_FD%5!?UJ|@yq`wZqLV^KMWt)JG+j<*d=}Ou}W0ELwb^ILT^5E zXLRQ0)W5d$sS|DtQ{=8qVK#biT5+xA!b`pWvc+7tggBC@Is>oWu{xo zxunou@l#RaJ@Qz9h|w~!3Jcsv-gyn&2(G!F3S1_j`cETfoO-h#i)WzSx-I+~%9SyV zTd!Hmx?El`5s5Wn(IRx%DM4cCYZE?qR15>F^C=@JJr~yYP5;x!0=$jUETat?gQ$kO z;{Jl7zy6=NscbhJ;oAC=QXWyHtYRDk7SNT5!Pb0Co1FN!Poa^HP$8xU;iOw_mmMVUW{4CalkN334;OG+wu1eSa;xpC~PY<@=b)qC}g|imFs5=C> zVv~=pzy@&=2bNP^S)i^RWC~UX!PKmoc~IkPqn-3x0rFYgld#=|k3qZF?)oa1;J$_7SM#G!lvX33S|8U|}6IwjH zjIz?`ndeuV@0)!cvJm5)%xSLUIiJE z-Piz^qA5Z!InAu4SRS{u;aG07-RE_%cq6hk+@rOooWnaLs@S!!bW+W;pwvRn;r=s; zFPqs_9p1I(`a^6V*_oA+0?|IhcWPYBuMeK3gx{0>nhq(_Q&-A)p5oEZ@HQ?sI zZ8aODwv^DE1{FkA`gqE_Q@J}z8i0}EC0mA{@c45j1t8}kGKc)wI2Ty1ipAGfukDNa(vz2LXtZwF_ z1hH(JF1W)psIySN6xE3`5!AN&My5Jh^nTmwn3nWfsqwM!ov-J$@J2oE_g*j7mH5mf zQZm7N)%BHn(}D=EMN!>$!&%Qi&5uw{CXkKH3k=@#p`ODp(Ezk{Wa1c@4R;x*->6f z)IFG9iK_nKyx40xOAJM}*~qiR0oi>z?)5p3QxTa^jCRGm_ke*~2fx3?+R^p{J~zXY zt?Pw8+1x`}`kF}i5We0GbXj>@?7WbN>Y#fD)N za&z6G^K2=u` zS2dzvu*ECYBW__$ zHDAg~iUJaEBe{}yN8E>9@C`}X8D(|3?4<9u95(MDcKy56Y6B93K}~ylwW?yWMzS<5 zcazlFD0g=mC7uu(Ff?JW6t3Xr;+B1RZ0D87ccVqDKqq#Ui+|8Wyb35?Uwxr7klH)v z7H~Bj-{*3Bcnu0xjy)+yXe@U=pJ^f^L3G?Y6$*rA<$g|G~MpNoS+S3ntU@uY%Rf`v^Q$V7!==Q`8-^$kVag=5nuB!;2L92-(xL>}kALD%Iq*9L>;TuJ&2m zNVoob?UA6b(TD6DPBSLUgldB~PK=mz7kj$8!$srGQ1vnjrIGSF`@$_$TjM|Hm=^B5 zpW;H23qOf`gV!{FK6|m*w}0ZvbGJ6=3dtf6TP8gRJN>@Dp1AzPrJ}6!;FPliLmD>w zpwX(=Ut3AykSP(nle%WLavd*KiCHT-K1^*XN(OtZ6!|eOy!wLcWz5t~L8WQyt11Nv zaK=3B@^C5V+>Dy8Xqkr)xMjmSZ1hH0x#Mz+bqTGrGs;CqNBvSw_JJoRZs(%R2JLOr5Medg(d3YvuWqNGzdN;&`by!A)8c}YKx4w6lBfHWxEFJnHevgo&P%7 z%hMVzrM!A8S@ISwNjYe^k$T&{jhG(RGROcv=?3%);v?Ny)Zy>I1m;u?15 zi{JhbePu1pnVE)>?ekl)C4OOnShsS!jr1=6y7=_T#!7yfiAvUU%DPrMp&?rDFsBo? zfOf~&ZP`P1rA4ldlGnp$CO93jE6@bvfb`&+xqhfAYAL*joYY%U&}@Ks6+}wFGbTfz z7T$X6vnzRos#6)Ckn~4){KK3I0(m(}SMf_jQg{g6NC0yjL3?5EC>`>EeX4xwD5L4( zendSh6|K8oH#uiJ_>Ps@(lEF_qaq1N9dS#7c-;+@Fej;LW97Y|S5PS+{rEu#8oIDJ z=%ZINZM(m)dT#2ds@`WFxWFwNTXm$Pw;rg!^%D}j^|_@0W_TNH4B0wfO96Exi|m9o z$j!?@G8a?r0vdP;Z+F6I)m!}=2vj*B%$p>5VxR&j5=QIVIJMeZ|(j_fky$kqu-1;FJ9yIHZ`1(BCdk*)i% zb>!WtuvId5qabG9G=H_)5mgXg2-zI{1Fiz!JNFISxqOe+w1_%5AR-Y9V zTL{zRz}s8uaYPF7U^0b(N22=jnK$*hIN&fYS!6VitSIc5Yy=xvJ_1nw5GA+Y0)d!1 zrrFS3G6qK%gQ3O0{HLD!s9F zzv~SiSvgowgrXA(jq9!?b${sw(rhGx*f5vMcO#<(PHlk^F&eCJb*w%MD6UXQ&j@e7 zP0uJ&hz$c+VgbV6^vDW_b4loe6(az_zrWKJJawA63&yrw%tKVK&&3MYExJ+6OxL`b zP3#{Vn_IO7MgszpjbH(T|7`ESe8B-nKwhl8vRh!5OdHu(^MSN~_%bTsA+-zQSv|L( z19r$?fd@0>WCRq@&RUNnTLGx)1P=#%z6!*w+aI=YGwa`q`&~rSJ`H$d12fIGUUZLR z76|APpcvdhkNlx%z>)q#eSdYzO#hd|^3Ne)ioTWZ`=R=lB2W)D=5`wA%%fA0|36FU zcULyXTzW@eZS%m}fyXGti}-q5>F$8F3+Q*V0Tv3MYCBiN(4jsV>{Ho@mF23G0bdnP zl8QFH%wr>X>?AQ7X0El8iF_Y2T^96kLKncjWL22&HXwGT$H9Y{QjA0~r-whSu8|&$~Pm5b%08*_1 zEP4zLUe^PubSdz`7}a5|^!e0&$MZ-ED2FnF1XJ?fvf9M5DDFURw?({Wwb3rn6dMGL z9)A5CSlTwF&x9=9834DElS|5d7BB$Fly*sv6zEPQ2#ntPdcP}iRK)Q!6QY9T@^68R zZ3Y5x-+CI&bgk$JFx-LtXg#Y<^;sDgU=HnZZXPD^!Ae~ZD@=KY`}qxbU#T|)8vNgk z`&X|xp8n1?fQD=!-ZS!~E+UKOCMcPGwh6<{9{isu+vFz`EdP_AzqiCD6ajL;WRP3H zX%H3#xGp~u+RVlzERc8Re{d0q@f*tATYUUUllG-!ydL$2k^d&y_h7!GWfM=1rvU;o zyKR%Kd_baa4*yp3zi}go4SXLtxe;wB*T#pm-_VW6{e-CndCRlbP^!NplbHCb>myOT` zvifyBA9K1uXe^=sY~1gbZr{N67>s`0%eXp-#P@%kZ1`xcROJPyl$Cxcw)cW>iM;gG z>Xr4gkJ}Y&XL@o;m0AJBQl%0cH3Bnq&r^QFj^uER47>-bFP|a$zHSyRZ-ZR;E z49kyx`|-ZS$CdMtxX8CZ$;3Efa-z;h0-DoN;IVrrzhcI9Ya$7rFtA_ft&$~>(wykgB0nQT}eh0l`rFBkNWAyJS?w(y_4a+N4bV6li^UTQg z+Lx5^-IbrKPHd1g0&3_aH7(!2iw#Cxz4tbVk$X;*{Z;;!{LxG#9>FVfKr-OQHBrcJ zWnqW4o(~J-g1!Sa>XHQ)Hf9Rjb$y7Bjwg7u+>^4j@Tkc)N3Y#QK)=M6DfK?z!jB&Z zZhuL)dhV9tY#mjL_lT#oVY}|{aRV-WZz~8}b$T|he2wjuPtwHPQGb=261>dIU2T;M zo>&{zbe;%*xdaNaba1wN@--;M-g_oTx3VQrbAY&h_{3fftXWk0z%A?4mKT%WZhb|8 zj7lLg0;^=Q>|%q2wdq&RE)H28A2iMgAnk!;1}pP%?b^5RK&D?t35hoL5$JB)X;`mUX(; z>2C|}Fv_4QGX1!1i={53D`9gPYXRYe)r*8xuFZ@vBHZM{+)3__1>{`slxFG1;%6J zb?LJ^EHf0B`-yR!LH1IwtaTJR1-iDLqDhuZ&64k>Y-A-p6kE3Nd?&Wlj5A3N9+sle zAX<|lO%08Xsk%0E1&vU?1-WSnKGg<^uC9IYla=HL)rb10ZC`J^8N7d$-zeK_UrmS; zHx)7Z;NGMlgu2U9$jBtMZfZoHr*2vOm$pf+9NN(!XlpQ0GXm$jU6hSTe)ZBmZ}E=TA4!e;V8BCxUB z=H-QVU$q5mKrBen8 zF&V>^^Ipm*wfvE!(ACwVC%Ka}yDJW=U7iZ5YAd0Z*Lve06O!&m85V!Z>RU5!>C0NV z^X#zJgDR?ou>VstUA(RLCyiQ@oqK}+-vw{TmHt-LHnX}uqM-UIy zHenet*8#X{jEU~0857kG_%jLHXngUIII?fqv^F}1=zhrW@HwH^Azk&KKL?0}tO*gS zZ(eMb@LpskzeoYsifRSQ-aBtmY>>&%G1t~0ud;SnR-m-Y4_efwRjXLT=)LI45%lbE xK=;F~(2{bT+hlpuym^|aO*RA&v-z;;%a{{zEQDw+TQ diff --git a/tests/testthat/test-dendrogram.R b/tests/testthat/test-dendrogram.R index 29924c6..d5d9556 100644 --- a/tests/testthat/test-dendrogram.R +++ b/tests/testthat/test-dendrogram.R @@ -1,5 +1,5 @@ test_that( - 'Fixed branching case values', { + 'Dendrogram case values', { load('data/branching.dendrogram.plots.Rda'); load('data/branching.dendrogram.data.Rda') From 5300cc0fc5388ada5ca258253f020c4600686b56 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 14 Aug 2024 17:40:05 -0700 Subject: [PATCH 49/51] Revert "Refactor equal X-dist" This reverts commit 5560b1875173a11a367b368552f9c4bc0a478af8. --- R/add.segs.R | 2 -- R/angles.R | 73 ++++++++++++++++++++++++---------------------------- 2 files changed, 34 insertions(+), 41 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 6368c26..8e0ec5c 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -97,7 +97,6 @@ calculate.coords.dendrogram <- function( x, v, length.colname, - parent.id, offset, side ) { @@ -164,7 +163,6 @@ calculate.seg.coords <- function( tree, v, length.colname, - parent.id, offset, side ) { diff --git a/R/angles.R b/R/angles.R index d118c00..23b4f4f 100644 --- a/R/angles.R +++ b/R/angles.R @@ -2,9 +2,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { root.node.id <- v$id[[1]]; node.ids <- c(root.node.id); - # random.scale <- median(tree$length1) * spread; - random.scale <- 1; - + random.scale <- median(tree$length1) * spread; angles <- v$angle; x <- numeric(nrow(v)); @@ -30,14 +28,15 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { parent.angle <- 0; angles[tree$tip == current.node.id] <- parent.angle; } - - level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); if (unique(v$mode[v$id %in% child.ids]) == 'radial') { # if all children are radial, spread evenly by angle + level.spread <- calculate.level.spread(v$spread[v$id %in% child.ids]); + level.total.angle <- total.angle * level.spread; + angles <- split.equal.angle( base.total.angle = total.angle, - level.spread = level.spread, + level.total.angle = level.total.angle, child.ids = child.ids, angles = angles, tree = tree, @@ -52,12 +51,12 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { child.ids <- v$id[v$id %in% child.ids]; # if all children are dendrogram, spread evenly by x distance angles <- split.equal.x.dist( - base.total.angle = total.angle, - level.spread = level.spread, - child.ids = child.ids, - angles = angles, - tree = tree, - v = v + current.node.id, + child.ids, + angles, + tree, + v, + random.scale ); } @@ -70,7 +69,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { split.equal.angle <- function( base.total.angle, - level.spread, + level.total.angle, child.ids, angles, tree, @@ -79,8 +78,6 @@ split.equal.angle <- function( num.children <- length(child.ids); num.slices <- max(num.children - 1, 1); - - level.total.angle <- base.total.angle * level.spread; angle.increment <- base.total.angle / num.slices; start.angle <- - (level.total.angle) * (num.children > 1) / 2; @@ -104,43 +101,41 @@ split.equal.angle <- function( } split.equal.x.dist <- function( - base.total.angle, - level.spread, + current.node.id, child.ids, angles, tree, - v + v, + random.scale ) { - num.children <- length(child.ids); - num.slices <- max(num.children - 1, 1); - - largest.edge.length <- max( - tree$length[tree$tip %in% child.ids[c(1, length(child.ids))]] - ); - base.total.dx <- tan(base.total.angle) / largest.edge.length; - level.total.dx <- base.total.dx * level.spread; + num.slices <- v$leaves[v$id == current.node.id]; + x.pos <- 1:num.slices - num.slices %/% 2; - dx.increment <- base.total.dx / num.slices; - start.dx <- - (level.total.dx) * (num.children > 1) / 2; + if (num.slices %% 2 == 0) { # if even + x.pos <- x.pos - 0.5 + } else { + x.pos <- x.pos - 1 + } - previous.dx <- start.dx; + idx <- 1; for (i in seq_along(child.ids)) { child.id <- child.ids[i]; - angle <- angles[tree$tip == child.id]; - dy <- tree$length[tree$tip == child.id]; + n.leaves <- v$leaves[v$id == child.id]; + j <- idx + (n.leaves %/% 2); + if (n.leaves %% 2 == 0) { # if even + current.pos <- x.pos[j] - 0.5 + } else { + current.pos <- x.pos[j] + } + angle <- angles[tree$tip == child.id]; if (is.na(angle)) { - if (i == 1) { - dx <- start.dx; - } else { - pair.spread <- v$spread[v$id %in% child.ids[c(i - 1, i)]]; - dx <- previous.dx + dx.increment * mean(pair.spread); - } - angle <- atan(dx / dy); + y <- tree$length[tree$tip == child.id]; + angle <- atan((current.pos * random.scale) / y); angles[tree$tip == child.id] <- angle; } - previous.dx <- dx; + idx <- idx + n.leaves; } return(angles); } From 6ec021ea6b0220ed2e9d1045a75091faa86b066e Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 28 Aug 2024 12:28:04 -0700 Subject: [PATCH 50/51] save reverted version with edits --- R/add.segs.R | 2 ++ R/angles.R | 19 +++++++++---------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 8e0ec5c..6368c26 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -97,6 +97,7 @@ calculate.coords.dendrogram <- function( x, v, length.colname, + parent.id, offset, side ) { @@ -163,6 +164,7 @@ calculate.seg.coords <- function( tree, v, length.colname, + parent.id, offset, side ) { diff --git a/R/angles.R b/R/angles.R index 23b4f4f..b20a4e0 100644 --- a/R/angles.R +++ b/R/angles.R @@ -2,7 +2,6 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { root.node.id <- v$id[[1]]; node.ids <- c(root.node.id); - random.scale <- median(tree$length1) * spread; angles <- v$angle; x <- numeric(nrow(v)); @@ -43,7 +42,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { v = v ); if (v$mode[v$id == current.node.id] == 'radial') { - #if parent is 'radial' angjust starting angle + #if parent is 'radial' adjust starting angle angles[tree$tip %in% child.ids] <- parent.angle + angles[tree$tip %in% child.ids]; } } else if (unique(v$mode[v$id %in% child.ids]) == 'dendrogram') { @@ -51,12 +50,12 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { child.ids <- v$id[v$id %in% child.ids]; # if all children are dendrogram, spread evenly by x distance angles <- split.equal.x.dist( - current.node.id, - child.ids, - angles, - tree, - v, - random.scale + current.node.id = current.node.id, + child.ids = child.ids, + angles = angles, + tree = tree, + v = v, + dx.scale = median(tree$length1) ); } @@ -106,7 +105,7 @@ split.equal.x.dist <- function( angles, tree, v, - random.scale + dx.scale ) { num.slices <- v$leaves[v$id == current.node.id]; @@ -132,7 +131,7 @@ split.equal.x.dist <- function( angle <- angles[tree$tip == child.id]; if (is.na(angle)) { y <- tree$length[tree$tip == child.id]; - angle <- atan((current.pos * random.scale) / y); + angle <- atan((current.pos * dx.scale) / y); angles[tree$tip == child.id] <- angle; } idx <- idx + n.leaves; From 82d349eb901e0d8f85d2ef8b3006ce9782d882a1 Mon Sep 17 00:00:00 2001 From: whelena Date: Wed, 28 Aug 2024 13:14:40 -0700 Subject: [PATCH 51/51] edit dendrogram expected test result --- .../data/branching.dendrogram.plots.Rda | Bin 5104 -> 5115 bytes tests/testthat/test-dendrogram.R | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/data/branching.dendrogram.plots.Rda b/tests/testthat/data/branching.dendrogram.plots.Rda index 0145777c77b4f0d81a13d69ac36ca8137f792aa3..d29306d8d69308752ad99b1760e0068c8d839d49 100644 GIT binary patch literal 5115 zcmds*cUY6z(!gmE2vs2KN*IkL=6?G1Cxse)K$ts#W2(`37So|)hv-ORpEm=$S4D7frgm&mWdSaqjw80hRl* zX715^ZkwMs+Mvzpvp$gy?hS}WmSyhMNbJLdsa;lt3sXzEYAEZ#7`530$9tv9t^T5=Z+|)t`TW*b~Mpz z1;BaqwM)F8#^`iLi)3Zf*-MpYvndOUL<_G9w9T`RYHAot4LWAv@s>}7`B>NMwJNUL zhOR<43af9mLcO;^7*5#!Lsk?4xR})?Mn)p^c~;;ZiG!6(#2%#*AY|jErPrrDrBsJMwgL z;+Z!t_^yb|mC)7XdOl2Q#XZLw6q@0rygV6TQld}1hfE7aByBV;y*kd}%f{E-*>jA$ zys{tkc}*=ThOCbo#o{lf{ca$y&+)%NTJ)F z3AO0vSZ7D$A}+RHl~|;a9zeD1+JwZwA2!(9EJ~!yJuxUUZ=_D}TYg-?R=YB~-+mt| zTZ{FY=-Q~+y2@wx;iIy>mcv%X2Q44hWsJMuWDxSB7cZ*jTkDw8=+q*!_FYfZ3Yw|K zm>0DSbvrVJFZqO!E#PHG%jX+j-QYzX>Uyl(P*#j4`R}aKv3g6O^^Z8b5?CboA2L!}~r@CD~=<8q6lN;HKX~24K4~0{s4A>w+9ht3= zx=LnkqauiooE1_Z3V>|^Z|cdVty|<2j&%W-2^yWyGk!#blb)mrdnr;F3I`Ky^~#H%5g(#tVUr;6O$> z5OMWem0{3#0Tnn<>30Px@ULcMn4c>JaK-U`RN$%XLnjR$OZnD9|0IL-13&JfCXo5S z9Pk9pyy$~J@Jse(6j{o^Y3-*9R3~64#sE^#&IphkqD@ur4`fy#D1#VjF>+uEqDbB! z2>OfYhgFY9fdbL6j_CNBqCJM-h_JVekU*3i7gM1>5d0$oA#H>D3{>Fr$svCx@p96xlf)Jlm9Nb^T%LVwP=AthN}TJEA(e z*aZmPkS0n;K||W!+yMcw zhf~3lE3v*?`an$QCLUq9Jxs~0?bluNaJ{=y7VW?HA)IqAW7t^+(03PUxYl^P6+wXV z&QN0WQH3)(pf9F2RobhYiGbaTqlMH#cRc4!l#I0aqi)3mvJz_0SU3@)7eq|%A^San zm@lBq`(I9yLXued&*Xl4Nd`GXafl>b?{sp+-0*MZ7UZKQdA_ri*i!!=(+HD|k|6=Y zt~@5u#kfF7kP!gl^AgS@(*FQnvLAT<4lfAc)4YzCq-s#gN8=ZNLhKk} zQnlw{B!5iDKMvi^MV)#D!X?eT{uP9HHd29=sK8=1#?-`51uCg5off6r$LHo1VS^uP z1*$;}68*m(moC=XsRA?#-*-Cb=V5#7aOb~1K#m-8G2`3D+XKn2G58BF4>wP(ZtcEX zEnPh8D&1>^=f}^zU87f<)^K&2UIPpnSK0FjDq`R6uH=(xu7;4A7WJrqCBDxLxQyUl z&C>em32W^kCe>2sJUqD8xCUukD`rkC;YA)Yc|W^*c}7+z9c}4S5-ZFq;M>VrpA6XlgKaDwTscxKdnOGo8}5ayf4vZIFek|%bW)oLEojT&0rO~Yn= z5?6QK>o!$i8T7*J;maHLB}@*><2It z+M3hR6!R z6@FmldI+u3ICtg|>)bWnX^#_uI2}#o)o0DUO{>G{@Xv2f88-`(f$ zmljap@Xcln1}(HcAdZ!Y;mu<5jk;?3OkE}6y<$R_KxI8cj3TArdZrU@?4B9e8m42L zH1ug=_!91*qUctCxvIms<0)B>kpZm)zXDas$7hs6ZEi_&C}Xu4xOI9n~0~FcIHivr?Pz%Ir|vP^>E5UQtJgL%95vBz#(MT3^ChHQElk zZBe9KJ#Gb1_N~FS{+S@c=`{njt|R_ywOh25x8%}cY)jah(DQ?{mr|EHgyWrUd1`No ze_Yk0Z9FPL&4(cCwm~JQgyQJEYSAvkpQ0>}{2MV2VNY-)XuI&wkjx2mKb&+v1pO+8 zR&@Ac^My&!3&~ybtg>@^6J5y41+m?&phd9kNaEoTKXmz_LG3ADPj?6N%%o^`$EIvV zr4@7(E~YtWnFrd|VB65bHw1c3u=(^F9k?xjy^?{P%^Ous_&ShS=sK`3jrck+A9o?H zbN4mA5KU1rV$sgFHP`K!*d1`7HFEOvFpb1=d)$a?t38E?ZF5i6cz|Eg`MYtVD&f|T zoM3p1SbWM2PRbs7UAin^U5RHg^(OX@bg?0sfQ%2ecw0dgsrHlvNjTYO1L@(f+^d}n zk)7EsR)Ufi?J3;p9%=DoBJrP7YsI@)(l>>b4m6GJeEXJr<@ATyD7<+K%mQRp6O-w) z&>0YSBP%`rnTxVK&n?wAd!CdEuW}5lBH-!g?2M8;pCsRV?dP^Qeu^)4gQvYKKi|#V zxdL^=1rn9{!u_Vr1Uo;GQ*^~-*@ z!L1IYY|=EoOmCIl?;=`wGb9^&fHR_d6;XAATFX^9%*3@LY1boRX`?w~Y0GcnKsguh zJ1CxYJFn`{)6ad0&OWc&H>bAJ#H_#8WYygnn`&g0ArO1ibyI)gT5Q2U!Io-{TrV!81spqsm8Em8@hwUNTbP90*!K|KcT}ZRuzI1rm zk^^dEmS^w8%P-%#j-L?OwiTMbm^~I*wZGRH_Js>U_T7o$ly^~_ye-7{6Ud7SoQCs<89KSa{(AYojc z8389F5p%;IwHDkWKL-O62AD#V0~pwS#=aBd|Bf90(>cCxuDRapdY^fo-@W|q`*+VHbdL$N^P!(kz7++r7kody zGQEPncf$B2l*5+pl&imzDo3nh@Z+_RhJ{S{b)c=a!P-_$;BXY+!J;^zF>7W9ol$W!eiD z7ZS$Zo~^fv4g}U~iQZAUknL<{+%j5$UmVPQQoWMsHg1*eTox72_W}DUrbOBHPDW45 zxkB_AqbUFSf;ab-&Cl{I^@ZE}YCRj9Hk_mC{RdJw**rb_Hr;c1r6tdEO7LaGy^8FN zuepvm$_;$atJ`L!o)!}FCh|#x{^E`1R9uzoWUc^OQow=jZKnRs9K6$ltPSqNP*oY} z+zSqqZHgh4c&hE0Lh)u~pDm`UamlIuo?Z8>a9>^gOyE|{9r+32MEt|3?Ce*Ui629n zA=+KITp6?} z@93H73uvjLH>-$xzkEzwiwm#h4%<*_lIhK#a(LCHonmtiUk7at(*9AB5?gZ1+czPY zp{zhm*L^Ts7Gs@`konW)YB#yJO`*iO?WujG^QUDg8AG>5VR7@!ehKkX`vJ-;YZvK+ zX3Db5X6#GJPd68szX=<;^tv|{jK3Xu;-*`i^~60P?os=xb#=Y*nutHwdXtAPj`&qX z%71T7qsF>HL*4x8AHuC~6Cb|1WN`j0>TsZVoMYWm%$h=**adGH6jr0U0+Jy<&q8-< zgXCbwEqOT;t_eq-yNoW+@DAxXx8!uEKYM0|xkO8_j+FDn;Lt+(YLHEf?3h4tN9XX3 zLXO;f*42_l)$>`wt<#P(5#4!~3o|#-rK1AVL#$R_L#Wl_%x7C&M)Gd!)D%OlHk{L< zsC&xfS>=E;c7z*Jt6 zYSAP;%(Ueb=^>QAjL3Jkud`$()=lRxE##6!-(5F~^gZua5ycDV z?>;7t!O0FcIem3r-dReA#PAk3=F~f3tc9Cn&HV-E{OX0hviaUC}admX!!+er`D`)%l@5PS&pgf8GyFRR4X|8ud=zJP=LRV67 zYrXTcLfW9p>bT>eRqIXFtu}?c3g0hh7}yA_RL60yp31@DAb+2)#g#)Bw)G(hpX%## zwe1!Q{Pdm0s-se-Bn^7sVEWe+##h-0Hu?M`L9pXs4K_l+@oYC~ONB^Gw56`R2uORs%Sk_yta5lmJumUXVDHeih6@nNL$!lPw4u5J}q+H zqHdy@7g#?ycaafE&VjHIgzajCkBT1$ zL(<`2OM+S<2*5(-8ekx?By+J!O0pQBxC12je4U1~F@zh^2*)xtR%HeBjK4G!9_HQ8i#m zjfnw?V0s?J%nUt%Fo1^A!NfulstjQqf7`U+m!D4CCk4O)$>rw;4lekys)unLA-JmX z5dH<$ENU0b3_Xgtv_BqT6pTdvG`im=AZ>Is8#~Tv4w(XJML;DZqBb_+CesRz z9>v?N*G4Cp!N?+WPE`#?I32;MGZ6&iw}b{oYML;mr4Qu*kDrEsrQPU2Fj(l45I2w7 zzQ3h1!o@>5R5dc-2N3I5a;%}DAXsXTswv=U^KW)wmY*4-VE~)LIOqrgYCQQIY9Maz z{qg>nEgHrs7cqzi10)a>N0v8MhO+G13QpHEP_0jg0}Q%rfVm;rKr#$4%!F&6VE~_& z09}D4=`_yvNgvIfUy0q_1cV2pahn0a0^#kD4TOhef(8TO?L!z4-oLs1yV0FA{H;)S z2-~eDz{U=3KMU$-GXSh=(|X|#!cnRW7f?dT4L1-UMBk_4B;rZQpbYIw>K*a zCyT5KRR`Y6u6Il7iFL9%f!eXE+yjyIo*IXZ0X2@)0?n=T;*s;$Zpi@BXt}NkJP&QM z08i4v;e{HZfaWW=2{vqV7XX~X3n}!kpXLQd(ZBX(0a<*cX6(prMM3fUJFw~V1!oXY zX>Q8%U2>^08f({X(QI3;Gt&GBNB~Znsk{dpRpf650q0paVT{OmY-K9=`$=3#OuY|Z zn#(-aqH}WUf%kntht$pK4c?zuO3aL>++f5D^5AG;sD#XYDBEUvl>^k^B{V zuSWN6xP6rL5GqX>bOR(BvtC zYdU-nd1uCc(At^JyOSCi%wQN0o2XEbJ|u`6mU{3HQM>2ABHcosK@&1yG@tjNYC(XL zqKdGjiO7HYvN!T~_FD%5!?UJ|@yq`wZqLV^KMWt)JG+j<*d=}Ou}W0ELwb^ILT^5E zXLRQ0)W5d$sS|DtQ{=8qVK#biT5+xA!b`pWvc+7tggBC@Is>oWu{xo zxunou@l#RaJ@Qz9h|w~!3Jcsv-gyn&2(G!F3S1_j`cETfoO-h#i)WzSx-I+~%9SyV zTd!Hmx?El`5s5Wn(IRx%DM4cCYZE?qR15>F^C=@JJr~yYP5;x!0=$jUETat?gQ$kO z;{Jl7zy6=NscbhJ;oAC=QXWyHtYRDk7SNT5!Pb0Co1FN!Poa^HP$8xU;iOw_mmMVUW{4CalkN334;OG+wu1eSa;xpC~PY<@=b)qC}g|imFs5=C> zVv~=pzy@&=2bNP^S)i^RWC~UX!PKmoc~IkPqn-3x0rFYgld#=|k3qZF?)oa1;J$_7SM#G!lvX33S|8U|}6IwjH zjIz?`ndeuV@0)!cvJm5)%xSLUIiJE z-Piz^qA5Z!InAu4SRS{u;aG07-RE_%cq6hk+@rOooWnaLs@S!!bW+W;pwvRn;r=s; zFPqs_9p1I(`a^6V*_oA+0?|IhcWPYBuMeK3gx{0>nhq(_Q&-A)p5oEZ@HQ?sI zZ8aODwv^DE1{FkA`gqE_Q@J}z8i0}EC0mA{@c45j1t8}kGKc)wI2Ty1ipAGfukDNa(vz2LXtZwF_ z1hH(JF1W)psIySN6xE3`5!AN&My5Jh^nTmwn3nWfsqwM!ov-J$@J2oE_g*j7mH5mf zQZm7N)%BHn(}D=EMN!>$!&%Qi&5uw{CXkKH3k=@#p`ODp(Ezk{Wa1c@4R;x*->6f z)IFG9iK_nKyx40xOAJM}*~qiR0oi>z?)5p3QxTa^jCRGm_ke*~2fx3?+R^p{J~zXY zt?Pw8+1x`}`kF}i5We0GbXj>@?7WbN>Y#fD)N za&z6G^K2=u` zS2dzvu*EC