From 910865cdba344cbbf2f820d3e5a7a6a0d5916835 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 06:51:53 -0700 Subject: [PATCH 01/39] Include specified angles in tree prep --- R/prep.tree.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/prep.tree.R b/R/prep.tree.R index c51b74a..981388a 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -13,10 +13,7 @@ prep.tree <- function( get.root.node(tree.df); if ('angle' %in% colnames(tree.df)) { - message(paste( - 'Overriding branch angles will be supported in a future version.', - 'The angle column will not be used.' - )); + tree.df$angle <- as.numeric(tree.df$angle); } tree.df$parent <- prep.tree.parent(tree.df$parent); @@ -75,6 +72,7 @@ prep.tree <- function( label.text = c('', tree.df$label), ccf = if (is.null(tree.df$CP)) NA else c(1, tree.df$CP), color = colour.scheme[1:(nrow(tree.df) + 1)], + angle = c(NA, tree.df$angle), parent = as.numeric(c(NA,tree.df$parent)), excluded = c(TRUE, rep(FALSE, nrow(tree.df))), bell = c(FALSE, rep(bells, nrow(tree.df))), From 6b76e08f3413267795df7819c8c9ffd0ffa94e25 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 07:20:06 -0700 Subject: [PATCH 02/39] Recalculate node positions after calculating angles --- R/position.clones.R | 53 +++++++++++++++++++++++++++++++-------------- 1 file changed, 37 insertions(+), 16 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index 242728e..08293b0 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -85,6 +85,8 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { vi <- v[i, ]; if (!is.na(vi$parent) && vi$parent == -1) { + angle <- 0; + # If root the clone extends the full width of the plot x0 <- 0; y0 <- tree$length[tree$parent == -1]; @@ -94,41 +96,60 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { par <- v[v$id == vi$parent, ]; #get parent clone - siblings <- v[which(v$parent == par$id),] + siblings <- v[which(v$parent == par$id),]; if (nrow(siblings) == 1) { - parent.angle <- 0; + angle <- 0; } else if (nrow(siblings) == 2) { if (any(siblings$x > par$x)) { - parent.angle <- -(fixed.angle); + angle <- -(fixed.angle); } else { - parent.angle <- fixed.angle; + angle <- fixed.angle; } } else if (nrow(siblings) == 3) { if (any(siblings$x > par$x)) { - parent.angle <- -(fixed.angle); + angle <- -(fixed.angle); } else if (any(siblings$x < par$x)) { - parent.angle <- fixed.angle; + angle <- fixed.angle; } else { - parent.angle <- 0; + angle <- 0; } } - r <- tree$length[which(tree$parent == par$id & tree$tip == vi$id)]; - x.shift <- r * sin(parent.angle); + r <- tree$length[tree$tip == vi$id]; + x.shift <- r * sin(angle); x0 <- par$x + x.shift; - y.shift <- r * cos(parent.angle); + y.shift <- r * cos(angle); y0 <- par$y + y.shift; len0 <- par$len + y.shift; - - tree$angle[which(tree$parent == par$id & tree$tip == vi$id)] <- parent.angle; } - v[i,]$len <- len0; - v[i,]$y <- y0; - v[i,]$x <- x0; - } + tree$angle[tree$tip == vi$id] <- angle; + + v[i,]$len <- len0; + v[i,]$y <- y0; + v[i,]$x <- x0; + } + + for (i in seq_along(v$id)) { + angle <- tree$angle[tree$tip == v[i, 'id']]; + + if (!is.na(vi$parent) && vi$parent == -1) { + x0 <- 0; + y0 <- tree$length[tree$parent == -1]; + len0 <- len + y0; + } else { + par <- v[v$id == vi$parent, ]; + r <- tree$length[tree$tip == vi$id]; + x.shift <- r * sin(angle); + x0 <- par$x + x.shift; + y.shift <- r * cos(angle); + y0 <- par$y + y.shift; + len0 <- par$len + y.shift; + } + } + clone.env <- new.env(parent = emptyenv()); clone.env$v <- v; clone.env$tree <- tree; From ecfe791d9def8f8e8231618e1a64302fc80cd236 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 07:27:44 -0700 Subject: [PATCH 03/39] Override angles in fixed angle mode --- R/position.clones.R | 11 +++++++++-- R/utility.R | 4 ++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index 08293b0..c0411fd 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -131,13 +131,16 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { v[i,]$x <- x0; } + tree$angle[!is.na(v$angle)] <- degrees.to.radians(v$angle[!is.na(v$angle)]); + for (i in seq_along(v$id)) { - angle <- tree$angle[tree$tip == v[i, 'id']]; + vi <- v[i, ]; + angle <- tree$angle[tree$tip == vi$id]; if (!is.na(vi$parent) && vi$parent == -1) { x0 <- 0; y0 <- tree$length[tree$parent == -1]; - len0 <- len + y0; + len0 <- 0; } else { par <- v[v$id == vi$parent, ]; @@ -148,6 +151,10 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { y0 <- par$y + y.shift; len0 <- par$len + y.shift; } + + v[i,]$len <- len0; + v[i,]$y <- y0; + v[i,]$x <- x0; } clone.env <- new.env(parent = emptyenv()); diff --git a/R/utility.R b/R/utility.R index 5e10a8e..ec2b060 100644 --- a/R/utility.R +++ b/R/utility.R @@ -51,3 +51,7 @@ data.frame.to.array <- function( return(arr); } + +degrees.to.radians <- function(degrees) { + return(degrees * pi / 180); + } From 073257247b5ea43c9a0f3b851b07d8aed0beabda Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 07:35:10 -0700 Subject: [PATCH 04/39] Fix tree segment bug with 90 degree angles --- R/add.segs.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/add.segs.R b/R/add.segs.R index 8747232..ef283d9 100644 --- a/R/add.segs.R +++ b/R/add.segs.R @@ -149,8 +149,6 @@ get.seg.coords <- function( } ); - tree.segs.adjusted <- tree.segs.adjusted[which(tree.segs.adjusted$basey != tree.segs.adjusted$tipy), ]; - 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); From 2746fc451fce7b470b613e1ada175e79e15f426d Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 07:57:36 -0700 Subject: [PATCH 05/39] Support angle specification in radial mode --- R/position.nodes.radial.R | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index b30a94a..39fb967 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -88,6 +88,32 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { spread = spread ); + tree$angle[!is.na(v$angle)] <- degrees.to.radians(v$angle[!is.na(v$angle)]); + + for (i in seq_along(v$id)) { + vi <- v[i, ]; + angle <- tree$angle[tree$tip == vi$id]; + + if (!is.na(vi$parent) && vi$parent == -1) { + x0 <- 0; + y0 <- tree$length[tree$parent == -1]; + len0 <- 0; + } else { + par <- v[v$id == vi$parent, ]; + + r <- tree$length[tree$tip == vi$id]; + x.shift <- r * sin(angle); + x0 <- par$x + x.shift; + y.shift <- r * cos(angle); + y0 <- par$y + y.shift; + len0 <- par$len + y.shift; + } + + v[i,]$len <- len0; + v[i,]$y <- y0; + v[i,]$x <- x0; + } + v$len <- sapply( v$y, FUN = function(x) { From 043a26c266c0a9475a0ab56e19440b2869a8df61 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 08:03:25 -0700 Subject: [PATCH 06/39] Support degrees and radians in "angle" column --- R/SRCGrob.R | 4 +++- R/position.clones.R | 2 +- R/position.nodes.radial.R | 2 +- R/prep.tree.R | 6 +++++- 4 files changed, 10 insertions(+), 4 deletions(-) diff --git a/R/SRCGrob.R b/R/SRCGrob.R index 3480a8a..22feb74 100644 --- a/R/SRCGrob.R +++ b/R/SRCGrob.R @@ -26,6 +26,7 @@ SRCGrob <- function( colour.scheme = CancerEvolutionVisualization::colours, draw.nodes = TRUE, add.normal = FALSE, + angle.unit = 'degrees', normal.cex = 1, sig.shape = 3, label.nodes = TRUE, @@ -45,7 +46,8 @@ SRCGrob <- function( inputs <- prep.tree( tree, node.text, - colour.scheme = colour.scheme + colour.scheme = colour.scheme, + angle.unit = angle.unit ); fixed.angle <- pi / 6; diff --git a/R/position.clones.R b/R/position.clones.R index c0411fd..87d8972 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -131,7 +131,7 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { v[i,]$x <- x0; } - tree$angle[!is.na(v$angle)] <- degrees.to.radians(v$angle[!is.na(v$angle)]); + tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; for (i in seq_along(v$id)) { vi <- v[i, ]; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 39fb967..2879f71 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -88,7 +88,7 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { spread = spread ); - tree$angle[!is.na(v$angle)] <- degrees.to.radians(v$angle[!is.na(v$angle)]); + tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; for (i in seq_along(v$id)) { vi <- v[i, ]; diff --git a/R/prep.tree.R b/R/prep.tree.R index 981388a..a8d8839 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -2,7 +2,8 @@ prep.tree <- function( tree.df, text.df, bells = TRUE, - colour.scheme + colour.scheme, + angle.unit = NULL ) { if (!('parent' %in% colnames(tree.df))) { @@ -14,6 +15,9 @@ prep.tree <- function( if ('angle' %in% colnames(tree.df)) { tree.df$angle <- as.numeric(tree.df$angle); + if (angle.unit == 'degrees') { + tree.df$angle <- degrees.to.radians(tree.df$angle); + } } tree.df$parent <- prep.tree.parent(tree.df$parent); From 1be6a9c48a755fd8bc876ec7ff1e20cb23f411c9 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 08:04:59 -0700 Subject: [PATCH 07/39] Update changelog --- DESCRIPTION | 4 ++-- NEWS | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c58c736..ea414ac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots -Version: 1.1.1 -Date: 2023-03-24 +Version: 1.1.0 +Date: 2023-09-19 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 ebaca32..555ff07 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,8 @@ -CancerEvolutionVisualization 1.1.1 2022-11-18 (Helena Winata) +CancerEvolutionVisualization 1.1.0 2023-09-19 (Dan Knight, Helena Winata) ADDED +* Support for specifying tree angles in either radians or degrees using + an optional "angle" column * Generic functions to generate accompanying heatmaps From 055a0804ac299cab0b054c997318d786905b063e Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 08:07:04 -0700 Subject: [PATCH 08/39] Fix code style --- R/position.clones.R | 2 +- R/position.nodes.radial.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index 87d8972..aa9e000 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -156,7 +156,7 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { v[i,]$y <- y0; v[i,]$x <- x0; } - + clone.env <- new.env(parent = emptyenv()); clone.env$v <- v; clone.env$tree <- tree; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 2879f71..5781730 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -100,7 +100,7 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { len0 <- 0; } else { par <- v[v$id == vi$parent, ]; - + r <- tree$length[tree$tip == vi$id]; x.shift <- r * sin(angle); x0 <- par$x + x.shift; From ee2183375c5571d11045dd67c1a93daf5cb91344 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Tue, 19 Sep 2023 08:17:16 -0700 Subject: [PATCH 09/39] Refactor tree angle override code --- R/position.clones.R | 60 +++++++++++++++++++++++---------------- R/position.nodes.radial.R | 27 ++---------------- 2 files changed, 37 insertions(+), 50 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index aa9e000..d3c8ecf 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -131,31 +131,8 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { v[i,]$x <- x0; } - tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; - - for (i in seq_along(v$id)) { - vi <- v[i, ]; - angle <- tree$angle[tree$tip == vi$id]; - - if (!is.na(vi$parent) && vi$parent == -1) { - x0 <- 0; - y0 <- tree$length[tree$parent == -1]; - len0 <- 0; - } else { - par <- v[v$id == vi$parent, ]; - - r <- tree$length[tree$tip == vi$id]; - x.shift <- r * sin(angle); - x0 <- par$x + x.shift; - y.shift <- r * cos(angle); - y0 <- par$y + y.shift; - len0 <- par$len + y.shift; - } - - v[i,]$len <- len0; - v[i,]$y <- y0; - v[i,]$x <- x0; - } + tree <- override.angles(tree, v); + v <- reposition.clones(tree, v); clone.env <- new.env(parent = emptyenv()); clone.env$v <- v; @@ -234,3 +211,36 @@ position.clones.no.vaf <- function(v, wid, spread = TRUE) { return(v); } + +override.angles <- function(tree, v) { + tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; + return(tree); + } + +reposition.clones <- function(tree, v) { + for (i in seq_along(v$id)) { + vi <- v[i, ]; + angle <- tree$angle[tree$tip == vi$id]; + + if (!is.na(vi$parent) && vi$parent == -1) { + x0 <- 0; + y0 <- tree$length[tree$parent == -1]; + len0 <- 0; + } else { + par <- v[v$id == vi$parent, ]; + + r <- tree$length[tree$tip == vi$id]; + x.shift <- r * sin(angle); + x0 <- par$x + x.shift; + y.shift <- r * cos(angle); + y0 <- par$y + y.shift; + len0 <- par$len + y.shift; + } + + v[i,]$len <- len0; + v[i,]$y <- y0; + v[i,]$x <- x0; + } + + return(v); + } diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 5781730..5572996 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -88,31 +88,8 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { spread = spread ); - tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; - - for (i in seq_along(v$id)) { - vi <- v[i, ]; - angle <- tree$angle[tree$tip == vi$id]; - - if (!is.na(vi$parent) && vi$parent == -1) { - x0 <- 0; - y0 <- tree$length[tree$parent == -1]; - len0 <- 0; - } else { - par <- v[v$id == vi$parent, ]; - - r <- tree$length[tree$tip == vi$id]; - x.shift <- r * sin(angle); - x0 <- par$x + x.shift; - y.shift <- r * cos(angle); - y0 <- par$y + y.shift; - len0 <- par$len + y.shift; - } - - v[i,]$len <- len0; - v[i,]$y <- y0; - v[i,]$x <- x0; - } + tree <- override.angles(tree, v); + v <- reposition.clones(tree, v); v$len <- sapply( v$y, From 1628e3feb77ec49fb43cc7db4384cd82def6deac Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 20 Sep 2023 16:01:13 -0700 Subject: [PATCH 10/39] Update manpage --- man/SRCGrob.Rd | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/man/SRCGrob.Rd b/man/SRCGrob.Rd index 0164650..65ebb2f 100644 --- a/man/SRCGrob.Rd +++ b/man/SRCGrob.Rd @@ -82,6 +82,7 @@ SRCGrob( \item{colour.scheme}{Vector of colour values to be used for CP polygons} \item{draw.nodes}{Enable or disable drawing tree nodes} \item{add.normal}{Adds a normal} + \item{angle.unit}{Unit to be used for "angle" column, either "degrees" or "radians"(degrees by default)} \item{normal.cex}{Font size within the normal "box"} \item{sig.shape}{ Changes the shape of the CP shading. @@ -130,6 +131,27 @@ SRCGrob( ); +# Override Branch Angles in Degrees +degrees.tree <- data.frame( + parent = c(NA, 1, 2), + angle = c(NA, NA, 90) + ); + +SRCGrob(angle.tree); + + +# Override Branch Angles in Radians +radians.tree <- data.frame( + parent = c(NA, 1, 2), + angle = c(NA, NA, pi / 2) + ); + +SRCGrob( + angle.tree, + angle.unit = 'radians' + ); + + # Plot Title SRCGrob( simple.tree, From c9c6661a7193a4319065a7af141279a6731eaddc Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 20 Sep 2023 16:01:44 -0700 Subject: [PATCH 11/39] Fix bug in manpage --- man/SRCGrob.Rd | 1 + 1 file changed, 1 insertion(+) diff --git a/man/SRCGrob.Rd b/man/SRCGrob.Rd index 65ebb2f..2bed8e6 100644 --- a/man/SRCGrob.Rd +++ b/man/SRCGrob.Rd @@ -34,6 +34,7 @@ SRCGrob( colour.scheme = CancerEvolutionVisualization::colours, draw.nodes = TRUE, add.normal = FALSE, + angle.unit = 'degrees', normal.cex = 1, sig.shape = 3, label.nodes = TRUE, From 13c0b47adf096cdea9133517b9f7ab9d6ebecd43 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Wed, 20 Sep 2023 16:32:04 -0700 Subject: [PATCH 12/39] Fix bug in examples --- man/SRCGrob.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/SRCGrob.Rd b/man/SRCGrob.Rd index 2bed8e6..8e4039f 100644 --- a/man/SRCGrob.Rd +++ b/man/SRCGrob.Rd @@ -138,7 +138,7 @@ degrees.tree <- data.frame( angle = c(NA, NA, 90) ); -SRCGrob(angle.tree); +SRCGrob(degrees.tree); # Override Branch Angles in Radians @@ -148,7 +148,7 @@ radians.tree <- data.frame( ); SRCGrob( - angle.tree, + radians.tree, angle.unit = 'radians' ); From 2ffc4a5b8cfbcc6da0826c6878c97be04f5c91d5 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 28 Sep 2023 16:59:33 -0700 Subject: [PATCH 13/39] Reimplement fixed node angle assignment --- R/position.clones.R | 56 ++++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index d3c8ecf..271dd1b 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -81,41 +81,47 @@ position.clones <- function(v, tree, wid) { } position.nodes.fixed <- function(v, tree, fixed.angle, len) { + calculate.angles <- function(tree, fixed.angle) { + node.ids <- c(v$id[[1]]); + + while (length(node.ids) > 0) { + current.node.id <- node.ids[1]; + node.ids <- node.ids[-1]; + + child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; + + if (length(child.ids) > 0) { + # Safe to hardcode temporarily. as this will only ever apply to + child.angles <- if (length(child.ids) == 1) c(0) else c(-1, 1) * fixed.angle; + + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + angle <- child.angles[i]; + tree$angle[tree$tip == child.id] <- angle; + } + } + + node.ids <- append(node.ids, child.ids); + } + + return(tree); + } + + tree <- calculate.angles(tree, fixed.angle); + for (i in seq_along(v$id)) { vi <- v[i, ]; - if (!is.na(vi$parent) && vi$parent == -1) { - angle <- 0; + angle <- tree$angle[tree$tip == vi$id]; + if (!is.na(vi$parent) && vi$parent == -1) { # If root the clone extends the full width of the plot x0 <- 0; y0 <- tree$length[tree$parent == -1]; len0 <- len + y0; } else { - # Parent not root -- not trunk clone par <- v[v$id == vi$parent, ]; - #get parent clone - siblings <- v[which(v$parent == par$id),]; - - if (nrow(siblings) == 1) { - angle <- 0; - } else if (nrow(siblings) == 2) { - if (any(siblings$x > par$x)) { - angle <- -(fixed.angle); - } else { - angle <- fixed.angle; - } - } else if (nrow(siblings) == 3) { - if (any(siblings$x > par$x)) { - angle <- -(fixed.angle); - } else if (any(siblings$x < par$x)) { - angle <- fixed.angle; - } else { - angle <- 0; - } - } - r <- tree$length[tree$tip == vi$id]; x.shift <- r * sin(angle); x0 <- par$x + x.shift; @@ -124,8 +130,6 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { len0 <- par$len + y.shift; } - tree$angle[tree$tip == vi$id] <- angle; - v[i,]$len <- len0; v[i,]$y <- y0; v[i,]$x <- x0; From eb2f3102bd44462e443e3d2fa827ac382ce381f5 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 28 Sep 2023 19:10:23 -0700 Subject: [PATCH 14/39] Fix bug in angle override utility function --- R/position.clones.R | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index 271dd1b..8fd02f2 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -81,7 +81,7 @@ position.clones <- function(v, tree, wid) { } position.nodes.fixed <- function(v, tree, fixed.angle, len) { - calculate.angles <- function(tree, fixed.angle) { + calculate.angles <- function(v, tree, fixed.angle) { node.ids <- c(v$id[[1]]); while (length(node.ids) > 0) { @@ -103,11 +103,12 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { node.ids <- append(node.ids, child.ids); } - + + tree <- override.angles(tree, v); return(tree); } - tree <- calculate.angles(tree, fixed.angle); + tree <- calculate.angles(v, tree, fixed.angle); for (i in seq_along(v$id)) { vi <- v[i, ]; @@ -135,7 +136,6 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { v[i,]$x <- x0; } - tree <- override.angles(tree, v); v <- reposition.clones(tree, v); clone.env <- new.env(parent = emptyenv()); @@ -217,7 +217,22 @@ position.clones.no.vaf <- function(v, wid, spread = TRUE) { } override.angles <- function(tree, v) { - tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; + angle.overrides <- as.list(v$angle); + names(angle.overrides) <- v$id; + angle.overrides <- angle.overrides[!is.na(angle.overrides)]; + + angles <- apply( + tree, + MARGIN = 1, + FUN = function(x) { + node.id <- as.character(x['tip']); + angle.override <- angle.overrides[[node.id]]; + angle <- if (is.null(angle.override)) x['angle'] else angle.override; + return(angle); + } + ); + + tree$angle <- angles; return(tree); } From b32f6afcf747973f5a1744303a3fe3d3d168c4af Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 28 Sep 2023 19:10:23 -0700 Subject: [PATCH 15/39] Fix bug in angle override utility function --- R/position.clones.R | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index d3c8ecf..e2c5005 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -131,7 +131,6 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { v[i,]$x <- x0; } - tree <- override.angles(tree, v); v <- reposition.clones(tree, v); clone.env <- new.env(parent = emptyenv()); @@ -213,7 +212,22 @@ position.clones.no.vaf <- function(v, wid, spread = TRUE) { } override.angles <- function(tree, v) { - tree$angle[!is.na(v$angle)] <- v$angle[!is.na(v$angle)]; + angle.overrides <- as.list(v$angle); + names(angle.overrides) <- v$id; + angle.overrides <- angle.overrides[!is.na(angle.overrides)]; + + angles <- apply( + tree, + MARGIN = 1, + FUN = function(x) { + node.id <- as.character(x['tip']); + angle.override <- angle.overrides[[node.id]]; + angle <- if (is.null(angle.override)) x['angle'] else angle.override; + return(angle); + } + ); + + tree$angle <- angles; return(tree); } From 7b6461232a192590f0ea2542d897c3ecb1042856 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 28 Sep 2023 19:22:07 -0700 Subject: [PATCH 16/39] Change angle unit parameter name --- R/SRCGrob.R | 4 ++-- R/prep.tree.R | 4 ++-- man/SRCGrob.Rd | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/SRCGrob.R b/R/SRCGrob.R index 22feb74..3ca93f0 100644 --- a/R/SRCGrob.R +++ b/R/SRCGrob.R @@ -26,7 +26,7 @@ SRCGrob <- function( colour.scheme = CancerEvolutionVisualization::colours, draw.nodes = TRUE, add.normal = FALSE, - angle.unit = 'degrees', + use.radians = FALSE, normal.cex = 1, sig.shape = 3, label.nodes = TRUE, @@ -47,7 +47,7 @@ SRCGrob <- function( tree, node.text, colour.scheme = colour.scheme, - angle.unit = angle.unit + use.radians = use.radians ); fixed.angle <- pi / 6; diff --git a/R/prep.tree.R b/R/prep.tree.R index a8d8839..d1746d6 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -3,7 +3,7 @@ prep.tree <- function( text.df, bells = TRUE, colour.scheme, - angle.unit = NULL + use.radians = FALSE ) { if (!('parent' %in% colnames(tree.df))) { @@ -15,7 +15,7 @@ prep.tree <- function( if ('angle' %in% colnames(tree.df)) { tree.df$angle <- as.numeric(tree.df$angle); - if (angle.unit == 'degrees') { + if (!use.radians) { tree.df$angle <- degrees.to.radians(tree.df$angle); } } diff --git a/man/SRCGrob.Rd b/man/SRCGrob.Rd index 8e4039f..583ae2d 100644 --- a/man/SRCGrob.Rd +++ b/man/SRCGrob.Rd @@ -34,7 +34,7 @@ SRCGrob( colour.scheme = CancerEvolutionVisualization::colours, draw.nodes = TRUE, add.normal = FALSE, - angle.unit = 'degrees', + use.radians = FALSE, normal.cex = 1, sig.shape = 3, label.nodes = TRUE, @@ -83,7 +83,7 @@ SRCGrob( \item{colour.scheme}{Vector of colour values to be used for CP polygons} \item{draw.nodes}{Enable or disable drawing tree nodes} \item{add.normal}{Adds a normal} - \item{angle.unit}{Unit to be used for "angle" column, either "degrees" or "radians"(degrees by default)} + \item{use.radians}{Unit to be used for "angle" column (degrees or radians)} \item{normal.cex}{Font size within the normal "box"} \item{sig.shape}{ Changes the shape of the CP shading. @@ -149,7 +149,7 @@ radians.tree <- data.frame( SRCGrob( radians.tree, - angle.unit = 'radians' + use.radians = TRUE ); From bb9446a6f2b00ad078d5052402a2962868fee56a Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 29 Sep 2023 15:03:28 -0700 Subject: [PATCH 17/39] Reimplement radial node angle calculation --- R/position.nodes.radial.R | 53 ++++++++++++++++++++++++++++++++++----- 1 file changed, 47 insertions(+), 6 deletions(-) diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 5572996..5dc3aa1 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -39,6 +39,49 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { tau <- -(pi / 2.5); vi <- v[v$parent == -1, ]; + calculate.angles <- function(v, tree, spread) { + root.node.id <- v$id[[1]]; + node.ids <- c(root.node.id); + + total.angle <- abs(tau) * spread; + + while (length(node.ids) > 0) { + current.node.id <- node.ids[1]; + node.ids <- node.ids[-1]; + + parent.id <- tree$parent[tree$tip == current.node.id]; + + if (parent.id == -1) { + tree$angle[tree$tip == current.node.id] <- 0; + } + + child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; + num.children <- length(child.ids); + + if (length(child.ids) > 0) { + parent.angle <- parent.angle <- tree$angle[tree$tip == current.node.id]; + child.weight <- assign.weight(current.node.id, v); + + start.angle <- parent.angle - (total.angle) * (num.children > 1) / 2; + num.slices <- max(num.children - 1, 1); + angle.increment <- total.angle / num.slices; + + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + angle <- start.angle + (i - 1) * (angle.increment); + tree$angle[tree$tip == child.id] <- angle; + } + + node.ids <- append(node.ids, child.ids); + } + } + + tree <- override.angles(tree, v); + return(tree); + } + + tree <- calculate.angles(v, tree, spread); + preorder.traversal <- function( node = NULL, tree = NULL, @@ -52,13 +95,12 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { d <- tree$length[tree$tip == vi$id & tree$parent == vi$parent]; if (vi$parent != -1) { - v$x[v$id == vi$id] <<- v$x[v$id == vi$parent] + d * sin(tau + w / 2); - v$y[v$id == vi$id] <<- v$y[v$id == vi$parent] + d * cos(tau + w / 2); - tree$angle[tree$tip == vi$id & tree$parent == vi$parent] <<- tau + w / 2; + angle <- tree$angle[tree$tip == vi$id & tree$parent == vi$parent]; + v$x[v$id == vi$id] <<- v$x[v$id == vi$parent] + d * sin(angle); + v$y[v$id == vi$id] <<- v$y[v$id == vi$parent] + d * cos(angle); } else { - v$x[v$id == vi$id] <<- 0; + v$x[v$id == vi$id] <<- 0; v$y[v$id == vi$id] <<- d; - tree$angle[tree$tip == vi$id & tree$parent == vi$parent] <<- 0; } eta <- tau; @@ -88,7 +130,6 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { spread = spread ); - tree <- override.angles(tree, v); v <- reposition.clones(tree, v); v$len <- sapply( From a3e3426f0745c4d43686a4dd37fb37ea9c05ebb8 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 29 Sep 2023 15:23:26 -0700 Subject: [PATCH 18/39] Update changelog --- DESCRIPTION | 4 ++-- NEWS | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ea414ac..1603a68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CancerEvolutionVisualization Title: Publication Quality Phylogenetic Tree Plots -Version: 1.1.0 -Date: 2023-09-19 +Version: 2.0.0 +Date: 2023-09-29 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 555ff07..25b0c0c 100644 --- a/NEWS +++ b/NEWS @@ -1,10 +1,13 @@ -CancerEvolutionVisualization 1.1.0 2023-09-19 (Dan Knight, Helena Winata) +CancerEvolutionVisualization 2.0.0 2023-09-29 (Dan Knight, Helena Winata) ADDED * Support for specifying tree angles in either radians or degrees using an optional "angle" column * Generic functions to generate accompanying heatmaps +UPDATE +* Reimplemented tree angle calculations +* Fixed lopsided radial tree bug -------------------------------------------------------------------------- CancerEvolutionVisualization 1.0.1 2022-10-03 (Dan Knight) From 17f7172152b6aae670b2de6c76d03e0f5972ea34 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 09:54:15 -0700 Subject: [PATCH 19/39] Fixed branching end-to-end tests --- tests/testthat/data/branching.fixed.data.Rda | Bin 0 -> 212 bytes tests/testthat/data/branching.fixed.plots.Rda | Bin 0 -> 4319 bytes tests/testthat/test-branching.R | 12 ++++++++++++ 3 files changed, 12 insertions(+) create mode 100644 tests/testthat/data/branching.fixed.data.Rda create mode 100644 tests/testthat/data/branching.fixed.plots.Rda create mode 100644 tests/testthat/test-branching.R diff --git a/tests/testthat/data/branching.fixed.data.Rda b/tests/testthat/data/branching.fixed.data.Rda new file mode 100644 index 0000000000000000000000000000000000000000..53ec65e8f436c61ffdc6887e3bbae61a108ed75d GIT binary patch literal 212 zcmV;_04x6=iwFP!0000016@x&3c@fLeKx7J1x0Z35C+7>O$YG+qTm{9Yzs9?8qiJ8 z;tAaaYtkCQE_vVk@_v%lVmpbp5dZ>8S|Gj|;cwQ<(G;MbAuUjZ28TPvWt?U*VTbH0 z_DqXHvpv@w@CKC-#G*CzY|8Cv!-B`GLST+BcK*@nn>xpT`=9>rVZP)?QJA4$mDkJm znJXdnmj$_yiB88&XPooGIo&d{Ut$MkLL2f>oi5Ckb#2+*9A#O)47_WxS2p6PRzlSG Ocz*y$9YJ+(0RR9(`eDof literal 0 HcmV?d00001 diff --git a/tests/testthat/data/branching.fixed.plots.Rda b/tests/testthat/data/branching.fixed.plots.Rda new file mode 100644 index 0000000000000000000000000000000000000000..1f093e0ea0a2e9c153b0770f5dfb5e4701a7c0c5 GIT binary patch literal 4319 zcma)93p~^N``?)6QiqhtrCO45NfJxMj3kPMQEpvCGE&MghU1cMbTdS9*BTpf7-nvX zGS}R5PYV;%VQw}4-|2EX=YM|vetW(4`97cLdA^_L@_F9R_w(6$TM)GRyC(=fXGR#`USkMT7ewbETW@$KC0%&Z-$SR<*aX_t{E-U} z7)=dL4Kt5M7Y{Y-&h%QGWz^ETo=%x>zTWCtL!;f93a7g7C>prJD3w_!zhy?N^iFZ> zD4x>yAz`uMMpAQTtV$sfq)--4Tr+dgrBV1J>xpKd@SbKPu*P!>zPHLVi{)OfM zJ=GVsE{o`7WTa{22)#eLDIlmwVQP#r4;nsGrP)_q~0JDpk- z#O^KxM<{W<>f9Mud^p{UuNAP#E0qyzRcA%CJG1U}_es2&U#^!YbaXXZ!HmiG;xFY? zwUxGhsr~4Fao(@BiS6c@SElVwuoIOnl6x9KS$3qjl^P5e4t;z}Hk~zy&N21eHKo%E z|D$i^*f`hFmOjn;Ni))n1C|&iErT23=oP(&Hv4PB%-NIAnc@YDW&*n$-D%j~ zEBIba*tyc3v!;i;`ihfO??Pk_$;T$iw0gEz;4eJ$5bfPu;34^ERntidF?;VwH;#TG zEk>RGMA`#gZ7-yej0t4M6ROP}tG5>t_G~h}NZmW&>XkJ#<|nNor;|ugzo=LEbn$&l zQ*Fs7JHN3Bzja8h zTZ6zSJDJ5_a{eeNx*_Vy9vc}#Z>QrM+RTYukvP_wfn!Fe4^Uf`T<#bTvexNgBu}wU z?;t*mt#kBvGvD0xHn4GcDB7^O|HBB9>QjR% zZnBL&ionkezf81HoQerqnz0fc`26RvqC(1+<+ivf9F2WKh^XKAWMTMzM6MZv+X^2z zFrQt;0OZ|^AJ}?vW+n*y(nxSHhpLR*krMPdxcBbB;#54O{Yb!^F6Vt|g(-qtudJB6 z^7c4e5J6V5779b71uB)rQD~}?83G-K&V^WW1Wim4gqbsB(s=z*A)>qZf~pYFJF64T zsm@39ksfzdl5izXyZF$@>eG}IUDnsI%*0V0f|uhU)|wPO1u)wDE59Mf<|qO^({V|N zxNKkfX91u@>nH}+uU(Q9A}WbaW57fMEOR|TgPdYRNTmd2FgjDkC?m8(9)ZLvEU2Ez zgjj3uzHI>fhq@~9;wS-bEzjZtNW>`R*3nZpkP;6a@3)g7>ukL9JMW8$3&H*x_)zk& z9pcDv-IJ@&?YxOmhRW*muK|)`j5OI1Zp0f*UQt$`M#xtRT!zn%a0eFgT)y&yQbJ0V zsd?u?apYg`ZHF0w+mQtNI^J7yh&+8)TPYOt82JP&9E@(lY*PwH@zR!p6y#Uh6%N?@PSpP!^M@25 zz)DI#>;Ej`Cq0f4_%0=-44!0WsGwlsyz<~XOn%~Mr89l230irlM`De2p1pcXXqW^L zTcPXM*v?=hz!G10ac@LQp$q^=e4Gd{4-XRE0>}RRPKGvcKLj@xAUb~+@Ba+ao}A>A&(>f* zTKOacW~l|u)P2%t(;fL(SK-~w4n^!BA!2i`S@G?-WhV&Bs;=ww+$%)*K~eBDRES8j zzZp*d4pIA2|BS4fOM(1F&`-bQVxLiIQhbIWCDc9ieT0O2*nJ+6;eoX z6SqL^77{DteOH5C`wFDkpvloD2=sHidm$ua(0Xu6ZAUtw+~)paMSMG$l)zsGK({d` z7HAKz#FZ9H}m&V_VrAl(s z8tc8ZRak5!o~+-Fq=$gw)p-maHdgCx6?xy0@VCnT4iaAVi>0LfQs*y3@$kUn2axuf z{|1t<0R-fL2S%WA{r>N0{RV9aktl`?ao-<1e!_NbS8VEUY1LnWw`%%_5C0_8R3Jn* zYy{{lAYu-OAN&l8*QNoz!PRyZKOl)l%CDC|nv9+}3(J@x<^c`>E#<2xzaW5Ez@I^D ziRbtC#O@UE~3Ea^x@gxI&l{1*afj@{5R2#JSKu?Qta(EALPGq7+F@EPa( zrOT^kW_~}|YsDECVte5eD-@P9JDzbDk)5WJBIXLVui}u@ikga$gG9wqI|9b5bcn27 zZb#O8_mJh>jeUHEu48rCj&yv`OV@UPzwseWM-u!%76zGX9ZHB#TGwfb)tWrH=-{7` zksA*`qKbE*5W8w`sY3copNG~{_)8)@t8m+Sr>>2U2E|0|NE8er*CE@sbAm82ThAGI zeLM7n7j12MVQMkk$lZ|h@$2z1f-fp5dFL6;K+^fUo8&MU`MIoULjiTaTDAA}L%~^p z=r4GUt%b7Moel2#1Ea~X=xOh#;Pe#hAU+o7SH2g06_VQ#+$ovDl8E?X_ zyYwk;h;*~cYJ%&M)x0~c_pTe={kQ|-vRaG!2WN}TbJ?&3*%?=rP4`huu_h^W!`-r%2g7k-yo=)Hrnw9qoVc@EjvP z8&q)sxOeD&Q1cYN+2{zvvvYMVPvQG@CEodl$5SZAg^Qk@9n$rObt=*o!Y2k74Y>`D zmF#jF8Wz-Z#3s{S{`6pr_lid5yr?6mI=ik*uK2B+3fZtqJKaCt?dnzz`-Lw3@Kcm| z7hlCVaLZ^*N5!d^*ybkX%PZDSdiWcO`tU9n&wP9AEQ%s0@0=={XihbTM_rJ$&z(OO zvo9;1=53)+M%X)3QfnK1YWK%>1rx z)qADYHuX*4kitB&kSb+tEm=-&4hkBLzLvOWP{&vPeemGtnyKLa1N%;om@Z6lBTF$6 zIQL@7?6Xr%{kQ-UG|=>r%@;)%=RiyN%+}y-dU`LruN~D-`W$M?YUSu;=!d1ql&UOz zahvu>TeUg7@>flFwu(}lO;op<&hmE(_V9caOijAdSPr9w!4WG3ih@h=>K7kXj2qDN zjOh){=SvGiH>7`<3zg}^O-ydPGN{3sVO*05Tk(+B8t(Sb4iERR6t$F0PujDse3ado zla2GPN0#b)`08qVGqA2l#`%pdSwe?vG;w6h(}_|e7fqC|yX_K)vQTzVntYj&sB zEUd!VYAv=Zgm-Qz(Q#lT z6bN@#$vxReO~M~%{igAx)!O`=o>F!|k&k8FO(;}ldMS@EcYV~-?(VGWZq88g<$Bbl z@F*pV%(feT?yq$1&ALohS7)5oPP{oK+W(?lRC~bZ*hF|lFT_n{q;Ca$be>|a> Date: Fri, 6 Oct 2023 09:54:38 -0700 Subject: [PATCH 20/39] Fix bug in tree comparison test helper --- tests/testthat/helper-compare.R | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/tests/testthat/helper-compare.R b/tests/testthat/helper-compare.R index 7ba2d20..57836ce 100644 --- a/tests/testthat/helper-compare.R +++ b/tests/testthat/helper-compare.R @@ -19,16 +19,20 @@ compare.trees <- function(example, test) { # Grob comparisons test.segment.grobs <- function(example, test) { get.segment.grobs <- function(x) { - c( - list(getGrob(x, 'tree.segs.1')), - list(getGrob(x, 'tree.segs.2')), - sapply( - x$children[get.axis.keys(x)], - FUN = function(ax) { - list(getGrob(ax, gPath('axis.content', 'ticks'))); - } + edges <- Filter( + Negate(is.null), + c( + list(getGrob(x, 'tree.segs.1')), + list(getGrob(x, 'tree.segs.2')) ) ); + axes <- sapply( + x$children[get.axis.keys(x)], + FUN = function(ax) { + list(getGrob(ax, gPath('axis.content', 'ticks'))); + } + ); + c(edges, axes); } example.grobs <- get.segment.grobs(example); @@ -192,8 +196,10 @@ compare.trees <- function(example, test) { )); } + + segments.match <- test.segment.grobs(example, test) all( - test.segment.grobs(example, test), + segments.match, test.text.grobs(example, test), test.polygon.grobs(example, test), test.line.grobs(example, test) From 439c4685048006ea934d71441883244f0e6bb096 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 10:00:27 -0700 Subject: [PATCH 21/39] Radial end-to-end test case --- tests/testthat/data/branching.radial.data.Rda | Bin 0 -> 218 bytes tests/testthat/data/branching.radial.plots.Rda | Bin 0 -> 5595 bytes tests/testthat/test-branching.R | 13 +++++++++++++ 3 files changed, 13 insertions(+) create mode 100644 tests/testthat/data/branching.radial.data.Rda create mode 100644 tests/testthat/data/branching.radial.plots.Rda diff --git a/tests/testthat/data/branching.radial.data.Rda b/tests/testthat/data/branching.radial.data.Rda new file mode 100644 index 0000000000000000000000000000000000000000..db8951b0cb362c424863c837cefbfb34982d6108 GIT binary patch literal 218 zcmV<0044t)iwFP!000001AR|T4*@X{efGn$36Z$@51NRJ8wc?Ngv7OWYe`l~w}~Ua z#V>SqQSGjh?ZKh*=FPk}GhNO%<9HJT@Dcb8_@Pb_u2+lU1PDA$8VJzVIM@oxll_5b zM9}m=b0S$GNlGOJynd;KZ_v29`bF1=nHJrrB?2>iu=O9U-}PDkt+(p^pTBl_$mx+4 zI_Z_iRmJ9+3dZG!MLFY{+>cymlGDOEZ80`qCOe^rI`XzSU5H)QG0Sc`D5ahnUX|EW U&bUAd#;QJEZ{z?iRFDAx0FoeQE&u=k literal 0 HcmV?d00001 diff --git a/tests/testthat/data/branching.radial.plots.Rda b/tests/testthat/data/branching.radial.plots.Rda new file mode 100644 index 0000000000000000000000000000000000000000..6c929e53cc6a89f8d1124c87d90daa624b535570 GIT binary patch literal 5595 zcmds*`9D6!RAg^zK9v?rO_>>cv@o)#jCB}7A6unDS%(Q@WXY0@ z7%FQbYh=r(hC(JXWdGhf$w!~mAMo|VeH`!mzVG`!=lwe8dFD!l@^Y~MxIV`d!h{%N zRRa@vX1JG~!1|rXTU%`IVxCM##SE(oDukyC3+;0Vc{!4!mQz^VVLmaEBm5xclZ35) zens?)2RlbIw`LZ=EN-ewy+D5>>sKVF1{f)%D8z*rH6Owa+{d}$nO5`+(XVqD>7wDf z;o*8*LZL^0abj6hg&NDPtL5D0qj?+b9hG7ZPf$0|MuRdonK^DQCzdo`+%(Zye52@k zf)yPfEf7Ae+?6tjE_c0@VM)hp%v91PLekDpJ@qQJcEcU(fj4#;O;aZAT0HG85v(pp z=qAP#n8?1b1w2`g&!lgqjd|7B%MT-16!#L|5} zPJiqujQ4G9!ezJ2kO#WnmQWdea$&Vi=IN(!8vRqTAChaCULGcS>3Wi8b#30-JAB0y zb?&@XG{>VXCX7ce#RRcx|5hxLlsmoIS$P;p_E+#S5z>f6TV z0i$zJ=C`RgbN?e&v1=bfQvuS9e0lqq~v3 z(f9TxzBQOT*HB-JyOz?QM6b$nS2lMZ?ClgbYxhU+GE^QKsCs5#U^jZ~uk@^`;_3d3 zXW^}mnJOB5i83=yf9hgw_P$W|)>ttY7JiQTx)YlBF*645RZPXlWxuSf<>BVJFjX+( ziL0-}ozYhA8;*U#lMhq4A{$!+3#)yy<*G$zmrt*4i+sejuU{oZ)$@0aHTpXY)N2VQ z47>VY-tL~fnyiHWP~Bc@d_fL(%xj{KzI)c%_v(Zgb3$>-eez(2j#N6nDteZ^K55;j-BWfd#lAGEv8ZU>{FFOWg-R1kWJsT61KG1wx*m2#T!EY~hC z+xxXR=a|(VFKIGey{Nse3PH%jl&E$zOOhL=1Pk?S9i#m&GwHdXV|mmPi(ZwSZy*#; ztCMrxZ)RkEL(bW@Ne~Jyx3GHM9ls_iLMgi!RF%4v$6~l!qDMxGMx1SmxLY;}^c0MR zJKQ{u?0!6{B{$z%s?9m*BhW=V`28C zgmvL@2$P{VuSTSO;^Tt1XKqH7mxn-LdYM~L9R_0NcWe3EM@ zq!o-q#E{?JdPaoHB=9A>6P}Z|wvt-PZpB>_bz~KSwNy*C%;8f-0!NE^_ z5Ncey3TW4QtO)@3us32A`_|9%t2u=a@uGkzfbsg(m^~I4xSkV@=9NTh|6%|~RrX^w zzUgqx$%_zvAWFc&ZEl@w2%mN0U^T-y(fOtuNXge=5O|EqM)uC&FEQ5>$Cnv@ zFHmy+3)(K?T<5?O)B|6=6rRQTGP%TG_PpGSh10;ZEBnn0 zihOAs-(?B-%0<0b&3RPJlumbQuGgCTKXp(${Bib2?*%`FufP$yHp5nS={I9{d z;P*_FN&a9u-pkrU@~4BtKvdwe0lF-b1-ZvqG5sj-tqIr|R zVnbTC!s7guGIDvk|1QhHIe;GhexxS+qZ(EtV%1`nTejSP{zkkT;gYbhmgECw8eWbQ zeKlu0Qrp0e6TQzIP&=sHaW`OiCGC$&z*bHhpt`U%r4J-EP+dS9tS<6EG=S=2`HS3^ ztL(o?4yyQ{gYaLHb}8+tKsoub4a{q&hd@m>0tyXlZ?4T3a*CXdl1RxRa;~07V8jl9 z#Npj%yt+rlQ-tf;n*lNtkzLwq*+sF4$FbQ+ChKHyn0yIx7uf zF9?Qr<8Cn&4sbybd*M)Lgsvohy_=H4VO(MJcyU=SI8oQx=%I zf+VWQkRFs`OLIBGNsZy2HwUgJZx*79p{Q1_mw5oSF1$MhkmUN%1_;H_y6TLY1e2i0 zF-U>8LV)!$t$}+RkVm*s?*|2-ltD+#0=-fSiMc{tx06J@-zpC*UFw+!5K0KO;2XOG z3DmBzT95N$k$1TMJ`~x^@d0GoSnFv3MP3);6(AUW!vnWLHu3<^r?bR?HT@X7fa~5b zKESna8U~^4cDTAdv}zS;YowJrwp#bSuY!5Y{ zBql>z^g*J5XaixkWc>W(GR`fP>z~Q@D+?FN2as$X(hn}pvpx`>2C4p@Tg$U#MaX?G zrncy)^wYTBQAg%&U#Ia6zmfmX93faP<`EiD<*FTkli_N_X#h>%0RYy1HVIaMz!Kcp zH27l{ETse60Qwb62_gUlfo*)4lU%pHBWii3{GM|Qr^9QNR0g|BcbH~*)ty2ctw_D) z1OZBfUmynz%yxED5hi~!NwtS#FzpAyL3p!Kz7oZkcm?A8x7ho&0RXxRB7p-Sx&~1e zt+5u#<}ScOF#T8J^x}@$MQiq$3jAdY1xL^Keg3BH7~x3Z9}&4&{v?cm9_1?FDcDn$ zSN|hq`+l)-g1rj6a4i|X^OSvv-)^!IzEY|Cxx-<*)6Qdwg#DYKAdf-c|F~li>MwlJ zK-~-X?AJ1#9PurlP}ljT@cyh+u=Q!=5ne3)V7Ig}REdEf1*63CLzt#RraL6k{I;fGBp$wh}6q?HKUSh<8+?l_GCIPMDazHYwiI zC-VnT{QKhRG9b*~j|%8%j|!)uL>8MEHuS*AE*UFy)`P0+1 z&7SeQ&+rsTUFok*mP@r7l1fNNCzM}i6us3+>0tC*Z+ydD1JvxMFZ$0t ztzMWzji7Fs&vgO}tTl}{R}VSqRjt-1m?>qv3F+ACZ*AV;xHHnvHNiK zpOV~lFWS$|m+EUV!+vyB$;#KW5j3w4`(1bWy*IcDC3uK=*zJi`a(b9QQe#T<4-wsB zs$pl(7+&Pb@Xh+t_uV}^C7AeynN*)ii_gX*wI&EhiIS@^B&rEUw@YtRo!KjFN-Vxu zrcL)cuCsI4TD@BtW@?pctCe=(0V^&ezGAMet-9O?cWK=9_I%$sw8U1xH)Le*;leWm zO46U@%2kHOXcrH2^@Jzm$Qsd&8Rnx9z9!8!uZ4P+J)KCkZHZS{BFVcD&4G&>n4_* zVctx*VmC>Rx}LoUuKW45a~(xoRr<+|v6-_8ZT4^j-sr79t%m!?(vGD_U+~U8VApg* zbZf3)AOtbK_8!)S)McfM=wN?s$?%rRxY}&F-|7=9s?U3WRFip;)r(?SNXnha!ZVK| z>NE*Kjs;c?He-Ee);9hnk)sdEn{_)1tr|WyrA(lG+w=0qjG5}q=M0}B%CuNa2Yy9+ z$xXULu|AabgC(ctd+x6s`!L*?xJg1rU*_5l*I1|?V(;OEX=U2 znxff1^hP@GiLw~Va_g`2md5PcSYI0Kg*0tcx}JMK&h5yWmb&9>x*3JLr<=yCbglQR z{}t_oxV+;-)o!!7&!>D;akNSpvsFuND(=&#^q#X1gNhg;tci(41)m)WNtfo`B78wqz39!xDTbgBwl{9zWc3u_b#^wns6p{%#Z zJsjN6dGtQp*yz(aX6^D?JdY&((CHt^?!bN6omkm4C}Vx!n2VkItcK0nly!s022l0N zMbrdwy+}yQfm``##Jq2e@XmShgMF~;x8InkVpu6rRaUNa%HVC43gfKo)dvh*v+x9m zN6(I|vOkrmfS44x56x(*l2%9xmKibkoS~T|-`$Rh3>pbdif9r#l31Q6uG0g2LfVKe zqh0orp>C}At8~3iOQdL?veD$rC~8#N^`5(%%etM=zNYh<^?`>~y)nGqh Date: Fri, 6 Oct 2023 10:07:26 -0700 Subject: [PATCH 22/39] Fix code style --- R/position.clones.R | 2 +- tests/testthat/test-branching.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index d4d1d76..53f1d03 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -83,7 +83,7 @@ position.clones <- function(v, tree, wid) { position.nodes.fixed <- function(v, tree, fixed.angle, len) { calculate.angles <- function(v, tree, fixed.angle) { node.ids <- c(v$id[[1]]); - + while (length(node.ids) > 0) { current.node.id <- node.ids[1]; node.ids <- node.ids[-1]; diff --git a/tests/testthat/test-branching.R b/tests/testthat/test-branching.R index 1fc1107..6c79846 100644 --- a/tests/testthat/test-branching.R +++ b/tests/testthat/test-branching.R @@ -15,7 +15,7 @@ test_that( 'Radial branching case values', { load('data/branching.radial.plots.Rda'); load('data/branching.radial.data.Rda') - + result.tree <- SRCGrob(branching.radial.test.data$tree); expect_true(compare.trees( result.tree, From b126804f80fc0732b250733c5d5d8ec3927ed476 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 12:23:38 -0700 Subject: [PATCH 23/39] Update branching test plots --- tests/testthat/data/branching.fixed.plots.Rda | Bin 4319 -> 4260 bytes .../testthat/data/branching.radial.plots.Rda | Bin 5595 -> 5315 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/tests/testthat/data/branching.fixed.plots.Rda b/tests/testthat/data/branching.fixed.plots.Rda index 1f093e0ea0a2e9c153b0770f5dfb5e4701a7c0c5..0a5fcd85f2b8d854a93c29a35f4bc35f8f286c88 100644 GIT binary patch literal 4260 zcmds4cQ~Bs79TAbY$jr4Lqtf?O~hgmB}y7%Fk?htlF@q^WyR>dtq7t7QO2mj=))yJ zqW4}y^b!oB#r;TjH+Rdu`}dvane(2vocf;M`JR_Oga&l-qgYAu2)*!_t!Zc5d2PFt zSegmz1T{3?JqTbJ2$n0U5dHxXI^5Y!E)=DVncL1x8W~%*Uds^bOuOnY6G;hWIs3Vg z_L5QFRtC~5FFlB(G|sfd^m@saQ>it*vJEn(OUpMmms@K_S1>JlJNw1L?;e|=O=fpn zHxH6cl6P0QRx-DCa#hBoLlroQQCc>t>0+z7x8LimRvtF$a7JnM4$TL>;iPDvLyiRB z7L-DND9To|Xl_k!%`1^U(id|MGbo15HIRJ zywJISM|17Gg#CO>&l%5$Gi6y-x-yQg*`H2 znhd8s*s`YDbcd{t4EbFOADcjU&9us_Nt(6z3&eQaTIGx;;tJUoq4u&`Ypjn*EUq8b zrEGB^O{Ko?+*%~u{v9z%h|60=c+zr!5bj>#ttNR%)cUEj%Mx7(n#V>p?mWg|>0)GD zVe31&8m;h8)9BWHWtT(gi(avrb{wK8A5{jUPowzDnB*b%!?*7#TAY){Z4Dna;Hu_3 zTFAS~5#!DQ!A`H|^vaiJp+=1?<<3K|UbC`4sb@_YkK+o=RI|8MVfsA#mw15;|LV>l z(F=?dXjU_>Q+;>Ef1znqvT_M_qu$xmD;-E~1sP+eWn(*E_x7r|Syh&biXcX^2HxN9 zVwd!O?JLu+nDf%UrBdlfjP$DGlsZFeeDFM-$v{GePNlIB7pLxz!w*)rH5LQ1~vOHC?b?(4|!? z)2Thu6%{1g8j3ia-kQjpkH+qe?Ub>P?5+Az_BQQr-`pgHc}8R1jx4gQpUn4TC{r|< z@V<5UH1bIiS{z;{=4uMQ4sSq?ccZ*=C8gQ5P_x(Z!&6Fx2<<^BB|=`5Q5VMK#e40sT2yq=N24t$EzX>>T!$Rbf_f2!<>mUaj@IM@RPLG=P$G5&40l~= zaf@T->VSUZ!yHOP4D}}h2m!0wh@(V6K?V0^kz;snGGqq7Lb`X~Wm!4rhJAraURs>J zI`eDbKVIOqe>DZX7lwS$T)#=i94HHoE`s>+UaR8F)}dv|oq3ce&vAuGPVP5Cnc^>Z zm)n=dweV#0J)Q*KeRwkdPH1Eq{378rw8tbWQtxC02;W}p5}c-@Tdm;{>WUNJEuWag zTqkbd-{pMe0ztjUauANw{a@vQ$r+xI-zFz&A!N8z2qT!|gfJHIeVy1V9@(>jIrJ3z zj$GAtC{nDP{m7upn)J9y!v-uEop&Byw+yD>jnn%{mddltNS4YEatZ;b0cPJYp5DZ*lmNL7BcXKuZ6-_}ebP z(7*xN-_L)$^*#JUIzRl^U8=)I;P$=1985SPb!P6xkGsfKud&nE(jn+6M4^sQink9G zh>C!gr7Gs5#~B_+eJ~dM*Q)={Dze=NdK|-XhVY5mBD}uWfpTR~@PmL6LOgVT&WZS6 zEq;?s4%w4*eY5gSo@1hmWPi;$l*F2o_>_v*7oOrQ^tfv(dzDRhne^S|&o}njl5@tV z3$%9g9}l;C$1fpRftK|s&KK>+-n zz=0l@0`TBtApVh|#Ni-vSeEtJAvIK}X6%@rf}bDc7}+OP`L~RL77e^>8GP&`5C=~P zgs=%ReW3>k74v;j8H`4qAP5A2<*%9aeOw`=+XJEXKWzQ#4*&(M2j~<+$Q7i9vnQ7Y z+6FVA8n|pj4&VQ2rZ=#*HQa5b$T&budQ{~f872AofuL>qUoRo9h(=BFGQC5#51-iu`wIT3%p$0xLT%egR(H-~5<6wbC z_}BKnnhE>VvW&~wp=T2(jWkYk|C&0W!TjG`b73dagW#E_s4jpf-9EzG20g;cK;l-M)WkVuNrlZ3L1 z9r(@+Ed=7S0gJKE;Sn?HcOi(czdrK zoo~s^T6*xH_${9n?A^bduLm-hCpC(e#ycCwb_I|;XPhzX`7G?x#r=B29_^4ZYlS7G z!y==%yH~i-Irql95mplqyG72k(^)H1in@ik5+&j;3in8=@6r~VvP$epuAF^UB#yLb z8In+_o(iW9<;j_GeA{I|nbN1fyhZ<_TVRMuC#nMcu|?zU+xqF%?zG7HQ7EH~#}Pw; zOu0=m*iKRofr>S-vQF6g!QcM)jX^Utj9Gqq)Tpur9X)?wPXM7If108U1dxbL$Z1A}3Ug%|^PHJTx*&ep<>O6=NF>X06CQim_6j!z?l~XA79pYZkg1<5H5T#YbuFs?921vLt0c%#Ip2%z8|(AFKf0jR}$-B zS`IVkDRFApA`;OL6LeMp2iX4=K?>Iysc-< z*EU}}sdT?vXL$LO9s|rVK_Cf}>Ga^p!m@lvyS-4trd)q5tmANb)B7finf9!W1e~w6 zAa*zYrkJMf&!dCMFt@UC7sj(L~uHaO6KF=($(T%TS!e=&=?n7Aoc6G`eLt{U7|2=Z(!tDbh*-h3vH z^vogHJ(PkiRz8w<>L1SWaae3->D)m-)j<{tdz6w!C9To?wGnMv@_AgVK5p*DLK zeSQ9`A?pi^ObW3Otq7Af-siK4$inYdClv@EF5t2yOQc@rCw}@Fp=p!lr2aa{m73pn zuQ1;JRGa$!h+2jq%e8XDvyC(=fXGR#`USkMT7ewbETW@$KC0%&Z-$SR<*aX_t{E-U} z7)=dL4Kt5M7Y{Y-&h%QGWz^ETo=%x>zTWCtL!;f93a7g7C>prJD3w_!zhy?N^iFZ> zD4x>yAz`uMMpAQTtV$sfq)--4Tr+dgrBV1J>xpKd@SbKPu*P!>zPHLVi{)OfM zJ=GVsE{o`7WTa{22)#eLDIlmwVQP#r4;nsGrP)_q~0JDpk- z#O^KxM<{W<>f9Mud^p{UuNAP#E0qyzRcA%CJG1U}_es2&U#^!YbaXXZ!HmiG;xFY? zwUxGhsr~4Fao(@BiS6c@SElVwuoIOnl6x9KS$3qjl^P5e4t;z}Hk~zy&N21eHKo%E z|D$i^*f`hFmOjn;Ni))n1C|&iErT23=oP(&Hv4PB%-NIAnc@YDW&*n$-D%j~ zEBIba*tyc3v!;i;`ihfO??Pk_$;T$iw0gEz;4eJ$5bfPu;34^ERntidF?;VwH;#TG zEk>RGMA`#gZ7-yej0t4M6ROP}tG5>t_G~h}NZmW&>XkJ#<|nNor;|ugzo=LEbn$&l zQ*Fs7JHN3Bzja8h zTZ6zSJDJ5_a{eeNx*_Vy9vc}#Z>QrM+RTYukvP_wfn!Fe4^Uf`T<#bTvexNgBu}wU z?;t*mt#kBvGvD0xHn4GcDB7^O|HBB9>QjR% zZnBL&ionkezf81HoQerqnz0fc`26RvqC(1+<+ivf9F2WKh^XKAWMTMzM6MZv+X^2z zFrQt;0OZ|^AJ}?vW+n*y(nxSHhpLR*krMPdxcBbB;#54O{Yb!^F6Vt|g(-qtudJB6 z^7c4e5J6V5779b71uB)rQD~}?83G-K&V^WW1Wim4gqbsB(s=z*A)>qZf~pYFJF64T zsm@39ksfzdl5izXyZF$@>eG}IUDnsI%*0V0f|uhU)|wPO1u)wDE59Mf<|qO^({V|N zxNKkfX91u@>nH}+uU(Q9A}WbaW57fMEOR|TgPdYRNTmd2FgjDkC?m8(9)ZLvEU2Ez zgjj3uzHI>fhq@~9;wS-bEzjZtNW>`R*3nZpkP;6a@3)g7>ukL9JMW8$3&H*x_)zk& z9pcDv-IJ@&?YxOmhRW*muK|)`j5OI1Zp0f*UQt$`M#xtRT!zn%a0eFgT)y&yQbJ0V zsd?u?apYg`ZHF0w+mQtNI^J7yh&+8)TPYOt82JP&9E@(lY*PwH@zR!p6y#Uh6%N?@PSpP!^M@25 zz)DI#>;Ej`Cq0f4_%0=-44!0WsGwlsyz<~XOn%~Mr89l230irlM`De2p1pcXXqW^L zTcPXM*v?=hz!G10ac@LQp$q^=e4Gd{4-XRE0>}RRPKGvcKLj@xAUb~+@Ba+ao}A>A&(>f* zTKOacW~l|u)P2%t(;fL(SK-~w4n^!BA!2i`S@G?-WhV&Bs;=ww+$%)*K~eBDRES8j zzZp*d4pIA2|BS4fOM(1F&`-bQVxLiIQhbIWCDc9ieT0O2*nJ+6;eoX z6SqL^77{DteOH5C`wFDkpvloD2=sHidm$ua(0Xu6ZAUtw+~)paMSMG$l)zsGK({d` z7HAKz#FZ9H}m&V_VrAl(s z8tc8ZRak5!o~+-Fq=$gw)p-maHdgCx6?xy0@VCnT4iaAVi>0LfQs*y3@$kUn2axuf z{|1t<0R-fL2S%WA{r>N0{RV9aktl`?ao-<1e!_NbS8VEUY1LnWw`%%_5C0_8R3Jn* zYy{{lAYu-OAN&l8*QNoz!PRyZKOl)l%CDC|nv9+}3(J@x<^c`>E#<2xzaW5Ez@I^D ziRbtC#O@UE~3Ea^x@gxI&l{1*afj@{5R2#JSKu?Qta(EALPGq7+F@EPa( zrOT^kW_~}|YsDECVte5eD-@P9JDzbDk)5WJBIXLVui}u@ikga$gG9wqI|9b5bcn27 zZb#O8_mJh>jeUHEu48rCj&yv`OV@UPzwseWM-u!%76zGX9ZHB#TGwfb)tWrH=-{7` zksA*`qKbE*5W8w`sY3copNG~{_)8)@t8m+Sr>>2U2E|0|NE8er*CE@sbAm82ThAGI zeLM7n7j12MVQMkk$lZ|h@$2z1f-fp5dFL6;K+^fUo8&MU`MIoULjiTaTDAA}L%~^p z=r4GUt%b7Moel2#1Ea~X=xOh#;Pe#hAU+o7SH2g06_VQ#+$ovDl8E?X_ zyYwk;h;*~cYJ%&M)x0~c_pTe={kQ|-vRaG!2WN}TbJ?&3*%?=rP4`huu_h^W!`-r%2g7k-yo=)Hrnw9qoVc@EjvP z8&q)sxOeD&Q1cYN+2{zvvvYMVPvQG@CEodl$5SZAg^Qk@9n$rObt=*o!Y2k74Y>`D zmF#jF8Wz-Z#3s{S{`6pr_lid5yr?6mI=ik*uK2B+3fZtqJKaCt?dnzz`-Lw3@Kcm| z7hlCVaLZ^*N5!d^*ybkX%PZDSdiWcO`tU9n&wP9AEQ%s0@0=={XihbTM_rJ$&z(OO zvo9;1=53)+M%X)3QfnK1YWK%>1rx z)qADYHuX*4kitB&kSb+tEm=-&4hkBLzLvOWP{&vPeemGtnyKLa1N%;om@Z6lBTF$6 zIQL@7?6Xr%{kQ-UG|=>r%@;)%=RiyN%+}y-dU`LruN~D-`W$M?YUSu;=!d1ql&UOz zahvu>TeUg7@>flFwu(}lO;op<&hmE(_V9caOijAdSPr9w!4WG3ih@h=>K7kXj2qDN zjOh){=SvGiH>7`<3zg}^O-ydPGN{3sVO*05Tk(+B8t(Sb4iERR6t$F0PujDse3ado zla2GPN0#b)`08qVGqA2l#`%pdSwe?vG;w6h(}_|e7fqC|yX_K)vQTzVntYj&sB zEUd!VYAv=Zgm-Qz(Q#lT z6bN@#$vxReO~M~%{igAx)!O`=o>F!|k&k8FO(;}ldMS@EcYV~-?(VGWZq88g<$Bbl z@F*pV%(feT?yq$1&ALohS7)5oPP{oK+W(?lRC~bZ*hF|lFT_n{q;Ca$be>|a>RPi5Q;cI7OJr#% zg)|{C_N8vw8N%3y@0{Tl_g3Hc_veo@&w1YGywCf4pWpL)k0TYr!^ZmK7>*OXB|(#{ z^qRWtIwBwGom6+rO6)r7etN}pX_?F2O#<1iI;Oh&I)+RpD~2>KPc0k`HoLHUt3{TJ z04E3h4#tp{ADkCsY@_=ak@tjVVMu&W%JUb#!{j*BKlJ=cajuX5WN{32ZXrgL-W=W1 z5?%ZJ%1HI25kGlrubH*7+}KS#fm-T`=S-Cv*1Mn8&K}I9*w5%Dq7?p;3(&4Zm5vvk zc2LF`gti7cC&j*PPPHwIG3qu{rp^odMKt!7Zmt7Bryq2CrT|GKXEbA|+|*)w)66@^KRK#i?CN_qew{ENwLNKX z<0uSQ*B&B@Egr3VaI(4G?o( zBRPsHb1L*}HN&+UQeFkfFy8$sU&yO^T#_MjRez7FDnPC)v#CH}d>+P`V215q+K5&~ zc>I>^o*zFFm;U&;$#F(R^1NX-TDr|wHZlfruYa4IxnZz*_Jds;WzJeXlJD`riJ5i} z870*`o@t0_6r8g-q#>SRDM*p(Ewc#(e3(qnmp3w0C@9@mMQ4bSe*qUK>=WkBZjGCY zn4`5-!*SjAG&?sOV+>(){%%*Arr5~6*1|ivT6-PSFD*Xl_lmH|yjNUo4rCuuNC2EC zd$_3;;Kh!I!x}U)K2h@X*AUdwQy{}i!Jnhyjjkz z82dm%EX3~f{C3mok*oDH(Zh@=%{D&mWqJZ`a}Kn`={jd$^<8 zIG)&>Eav`DR%~#>Rt|%mRA0a*x0vb;P-gF(Y3hx=(%H|BSi8@07tt%0(hfY&;4wn3$;BiM4M%QNbmr&CjE%qN2M*?0AwqI2}NjJ6p>hJW!Szf`|(G(+ERU^Am} zFTG??ihl>;@Ko-ns`bgIBJi_AI2l{qmP1=%jA%i6$7n^pDmcsxdPH9ISvDANDO;(;!pPxmX?JY{Wi5Oqgp+@WUM=uW1ZiAd zc}Y$}(=NOux0{Vf#tXN&HE89~Ye>dL^f12*Q2Hj+%Z3;j+{h9%JOW|x`A*QiL2DE0h;+azg9l~y z56@Bzrsggj4#q=IV`|=uL3XzqSCSSFClK|99lBjL6~^TBH9lzp5<#d8&-Wu^4T8j8P|^WVZD7QbrQUt&U#h!1K!}i3eVYwFoX&%)YlvZk z8(V^gM<5%V*$KMgS}ZiHjCaH`Egl#G0X@3X0Aj^u42q$apEdLHsY5P-By{e8FlE*Xqn5J;d{UTB)AEW z;2el%>-~i5sYnh4tET;Y9EfQO=-w3oR#=N?mB9kG%Ci&$Aw)p&;L{L7$OaMW1Pbv% z2w6ibrvhSsP}Y^4`59GMG2J>M-|Bn4#36jWHDQ@5y2dx3xwd69tL&o5Y?AeGE_4bjvc}pm}Y(V$Q75xntD&N0xgJ=q~!J01Z(Oc0IM9>CeD>czPiJEX${(tPs z60KIze>IDt0lJ+~Yru>T@f~9iHx< z9KP3IUN99d>tL#ueUyFRMwb#ZKY0Df1N`jhjTGEM4cyc~lesW?!Bt~y+E5skaAJbd zH;~d9iJ$#E?V?EW84MCed1+kkD*H-~-40{OaNpcKtCcq{Rr(uYVIs0LVfypQK~T}X z5}DHvf=UoD&)PAonSh6Wvh0j7OAGlze_gzaApD~jq{_nkZO!6nD!iltk@qvTygVq{ zUB+oplnchf)}WC*^C95%DSbXDW({fJTDLx^u?`=ffnpjoxEn@_j9Ax$RXZ@D4kIBk z01=$;3(8Rn7_XnrE@j?(xn#dRgpXZ=LcIAs<(0;|( z3?tQIJ-3DEa}sXG)W?#l60@g~4qr34%zmt2D~SuL7`F%)dLPtW5c}nFcu*Qgmh}?q zEmm87Gk!!tDCV1j{D_PHCN9J_DLg1*>$dP=OgQf^G4g-wGB#vGY>%EgvUIR|o<2Fe zD^Q3XjpmWo)cu7aWwoq@EZKguRdcw6-NWQ>frPY?rIbGs$yFkD>k8WHzohzm6=0XY zILyWYL`i6F0Al&Juw;!L4YtO=^mC;GN9hL!3XPKzdlVE0L}faC8WZ=%=zy;OSByCe zp0%!p%IAgPzdS*ftAP6*taCja+6<7d+d|m#=J?(#pZw-rY5Z)@_J{KEOZS-l@%Nbn z_QTlQI0*BybA|C!+K-d6gjg&12bdqe z1}uRQe1S*o@r1ItKXzw9(ezX=I|tO z_VcA)uWpG_ZMt-WyoktcQCTxYPjXJVR=K5sHvL|M9;GD*=}9ji&+!llMenWcdpg#B zy4S7K*R&|=g6!p!CUwrcG1v%qYNmp(w|TA6m4m;jey(2I9IaD>IGsj>Q!2F(uKmL~ zJJc0VIc@8!+t^lYu$JI`fZ#pvnL6UtQ|)V2Nnr(Y|_dQuB;?O;M(Gu_L*k&uN-?LtI3v{o*mVb8>!n#~-SJ z0&Co>&zv&0#0@di)Gw%64;~=j?bI+u?a2caUEqL4p-XCu(Z(y>jrDlf7Q11Qg6e~j zt>?O1#Zx-BmkjZFjZKP4E&TpO)pJh8aPDGTKz!a#jU(e$gbS%YV!8R@eR~|>Cv&pR z7Rw4;6H{y(a{23t7FXSql(6CMyF2`fTrhP2vZWy39hqv?COVa}bNF`sV?_*3d=F#b zthaYUNlyL1iN144yo3AwFCVFlewyeyVdbmb!5QklwRG`>=#(1;YquqZq**)Dk^Ijr zyP*#a7J=d;g^D3H#xGoIY-mT?9Y%irZQ;02(?z9*R+o1dH{YFNs(m%jv@&jx^`nB{ z7HAZ6B?Ss*Z(N>q<<21^PqY_~7!fDwqR?{HFki8yA5FuySH)B-#MHE0E%C~EVAAbz zoE|r}x7<9?c|60`2~bK7%`(`dye;Nfl5K3%A1=8X;+ssnW7~4bUe=_>r+&@Pa%Qak zH4c8X^-j6rMJ_Fs_s*iZ0R-1s3bv*1NdZEF(%f4TZP4qvk=TjN>~mMq@ULRfsAu>_8Td5yq8|;_R{O@xv{UrChdjZo+*7x`gFN3Lv|t8%XRDwwaJ{B zVdd$*&4w}NtT+$zw7E3$XZ6C-xOb%;@zdefv&o-l>FpzMbE8OC^U|x~@`bN`n9kH4 z{b%R$JF}hyaCcB6*v>Ui*a9wpw0^< zxA7}Qn0A=U`J{CEsTin_#4-KC5sIpF*bC?695<%(nd{DZq9^c5gx)A@qEDx8v z`El=Jw^2${0}$6~JF@|qXKGng1q=|cj*`JjTr$r=8-lA`Gku7nng>32~jO{<*2jn#X literal 5595 zcmds*`9D6!RAg^zK9v?rO_>>cv@o)#jCB}7A6unDS%(Q@WXY0@ z7%FQbYh=r(hC(JXWdGhf$w!~mAMo|VeH`!mzVG`!=lwe8dFD!l@^Y~MxIV`d!h{%N zRRa@vX1JG~!1|rXTU%`IVxCM##SE(oDukyC3+;0Vc{!4!mQz^VVLmaEBm5xclZ35) zens?)2RlbIw`LZ=EN-ewy+D5>>sKVF1{f)%D8z*rH6Owa+{d}$nO5`+(XVqD>7wDf z;o*8*LZL^0abj6hg&NDPtL5D0qj?+b9hG7ZPf$0|MuRdonK^DQCzdo`+%(Zye52@k zf)yPfEf7Ae+?6tjE_c0@VM)hp%v91PLekDpJ@qQJcEcU(fj4#;O;aZAT0HG85v(pp z=qAP#n8?1b1w2`g&!lgqjd|7B%MT-16!#L|5} zPJiqujQ4G9!ezJ2kO#WnmQWdea$&Vi=IN(!8vRqTAChaCULGcS>3Wi8b#30-JAB0y zb?&@XG{>VXCX7ce#RRcx|5hxLlsmoIS$P;p_E+#S5z>f6TV z0i$zJ=C`RgbN?e&v1=bfQvuS9e0lqq~v3 z(f9TxzBQOT*HB-JyOz?QM6b$nS2lMZ?ClgbYxhU+GE^QKsCs5#U^jZ~uk@^`;_3d3 zXW^}mnJOB5i83=yf9hgw_P$W|)>ttY7JiQTx)YlBF*645RZPXlWxuSf<>BVJFjX+( ziL0-}ozYhA8;*U#lMhq4A{$!+3#)yy<*G$zmrt*4i+sejuU{oZ)$@0aHTpXY)N2VQ z47>VY-tL~fnyiHWP~Bc@d_fL(%xj{KzI)c%_v(Zgb3$>-eez(2j#N6nDteZ^K55;j-BWfd#lAGEv8ZU>{FFOWg-R1kWJsT61KG1wx*m2#T!EY~hC z+xxXR=a|(VFKIGey{Nse3PH%jl&E$zOOhL=1Pk?S9i#m&GwHdXV|mmPi(ZwSZy*#; ztCMrxZ)RkEL(bW@Ne~Jyx3GHM9ls_iLMgi!RF%4v$6~l!qDMxGMx1SmxLY;}^c0MR zJKQ{u?0!6{B{$z%s?9m*BhW=V`28C zgmvL@2$P{VuSTSO;^Tt1XKqH7mxn-LdYM~L9R_0NcWe3EM@ zq!o-q#E{?JdPaoHB=9A>6P}Z|wvt-PZpB>_bz~KSwNy*C%;8f-0!NE^_ z5Ncey3TW4QtO)@3us32A`_|9%t2u=a@uGkzfbsg(m^~I4xSkV@=9NTh|6%|~RrX^w zzUgqx$%_zvAWFc&ZEl@w2%mN0U^T-y(fOtuNXge=5O|EqM)uC&FEQ5>$Cnv@ zFHmy+3)(K?T<5?O)B|6=6rRQTGP%TG_PpGSh10;ZEBnn0 zihOAs-(?B-%0<0b&3RPJlumbQuGgCTKXp(${Bib2?*%`FufP$yHp5nS={I9{d z;P*_FN&a9u-pkrU@~4BtKvdwe0lF-b1-ZvqG5sj-tqIr|R zVnbTC!s7guGIDvk|1QhHIe;GhexxS+qZ(EtV%1`nTejSP{zkkT;gYbhmgECw8eWbQ zeKlu0Qrp0e6TQzIP&=sHaW`OiCGC$&z*bHhpt`U%r4J-EP+dS9tS<6EG=S=2`HS3^ ztL(o?4yyQ{gYaLHb}8+tKsoub4a{q&hd@m>0tyXlZ?4T3a*CXdl1RxRa;~07V8jl9 z#Npj%yt+rlQ-tf;n*lNtkzLwq*+sF4$FbQ+ChKHyn0yIx7uf zF9?Qr<8Cn&4sbybd*M)Lgsvohy_=H4VO(MJcyU=SI8oQx=%I zf+VWQkRFs`OLIBGNsZy2HwUgJZx*79p{Q1_mw5oSF1$MhkmUN%1_;H_y6TLY1e2i0 zF-U>8LV)!$t$}+RkVm*s?*|2-ltD+#0=-fSiMc{tx06J@-zpC*UFw+!5K0KO;2XOG z3DmBzT95N$k$1TMJ`~x^@d0GoSnFv3MP3);6(AUW!vnWLHu3<^r?bR?HT@X7fa~5b zKESna8U~^4cDTAdv}zS;YowJrwp#bSuY!5Y{ zBql>z^g*J5XaixkWc>W(GR`fP>z~Q@D+?FN2as$X(hn}pvpx`>2C4p@Tg$U#MaX?G zrncy)^wYTBQAg%&U#Ia6zmfmX93faP<`EiD<*FTkli_N_X#h>%0RYy1HVIaMz!Kcp zH27l{ETse60Qwb62_gUlfo*)4lU%pHBWii3{GM|Qr^9QNR0g|BcbH~*)ty2ctw_D) z1OZBfUmynz%yxED5hi~!NwtS#FzpAyL3p!Kz7oZkcm?A8x7ho&0RXxRB7p-Sx&~1e zt+5u#<}ScOF#T8J^x}@$MQiq$3jAdY1xL^Keg3BH7~x3Z9}&4&{v?cm9_1?FDcDn$ zSN|hq`+l)-g1rj6a4i|X^OSvv-)^!IzEY|Cxx-<*)6Qdwg#DYKAdf-c|F~li>MwlJ zK-~-X?AJ1#9PurlP}ljT@cyh+u=Q!=5ne3)V7Ig}REdEf1*63CLzt#RraL6k{I;fGBp$wh}6q?HKUSh<8+?l_GCIPMDazHYwiI zC-VnT{QKhRG9b*~j|%8%j|!)uL>8MEHuS*AE*UFy)`P0+1 z&7SeQ&+rsTUFok*mP@r7l1fNNCzM}i6us3+>0tC*Z+ydD1JvxMFZ$0t ztzMWzji7Fs&vgO}tTl}{R}VSqRjt-1m?>qv3F+ACZ*AV;xHHnvHNiK zpOV~lFWS$|m+EUV!+vyB$;#KW5j3w4`(1bWy*IcDC3uK=*zJi`a(b9QQe#T<4-wsB zs$pl(7+&Pb@Xh+t_uV}^C7AeynN*)ii_gX*wI&EhiIS@^B&rEUw@YtRo!KjFN-Vxu zrcL)cuCsI4TD@BtW@?pctCe=(0V^&ezGAMet-9O?cWK=9_I%$sw8U1xH)Le*;leWm zO46U@%2kHOXcrH2^@Jzm$Qsd&8Rnx9z9!8!uZ4P+J)KCkZHZS{BFVcD&4G&>n4_* zVctx*VmC>Rx}LoUuKW45a~(xoRr<+|v6-_8ZT4^j-sr79t%m!?(vGD_U+~U8VApg* zbZf3)AOtbK_8!)S)McfM=wN?s$?%rRxY}&F-|7=9s?U3WRFip;)r(?SNXnha!ZVK| z>NE*Kjs;c?He-Ee);9hnk)sdEn{_)1tr|WyrA(lG+w=0qjG5}q=M0}B%CuNa2Yy9+ z$xXULu|AabgC(ctd+x6s`!L*?xJg1rU*_5l*I1|?V(;OEX=U2 znxff1^hP@GiLw~Va_g`2md5PcSYI0Kg*0tcx}JMK&h5yWmb&9>x*3JLr<=yCbglQR z{}t_oxV+;-)o!!7&!>D;akNSpvsFuND(=&#^q#X1gNhg;tci(41)m)WNtfo`B78wqz39!xDTbgBwl{9zWc3u_b#^wns6p{%#Z zJsjN6dGtQp*yz(aX6^D?JdY&((CHt^?!bN6omkm4C}Vx!n2VkItcK0nly!s022l0N zMbrdwy+}yQfm``##Jq2e@XmShgMF~;x8InkVpu6rRaUNa%HVC43gfKo)dvh*v+x9m zN6(I|vOkrmfS44x56x(*l2%9xmKibkoS~T|-`$Rh3>pbdif9r#l31Q6uG0g2LfVKe zqh0orp>C}At8~3iOQdL?veD$rC~8#N^`5(%%etM=zNYh<^?`>~y)nGqh Date: Fri, 6 Oct 2023 12:35:35 -0700 Subject: [PATCH 24/39] Fix partial comment --- R/position.clones.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/position.clones.R b/R/position.clones.R index 53f1d03..7cc91e8 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -91,7 +91,12 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; if (length(child.ids) > 0) { - # Safe to hardcode temporarily. as this will only ever apply to + # Safe to hardcode temporarily. This will only ever apply to + # cases with 0, 1, or 2 children. 3+ will use radial calculation. + + # 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 (length(child.ids) == 1) c(0) else c(-1, 1) * fixed.angle; for (i in seq_along(child.ids)) { From d33706a598bb2a6fff97a5d381f2cb9145178b25 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 12:36:27 -0700 Subject: [PATCH 25/39] Refactor test helper function --- R/position.clones.R | 2 +- tests/testthat/helper-compare.R | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/R/position.clones.R b/R/position.clones.R index 7cc91e8..82eb2a0 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -93,7 +93,7 @@ position.nodes.fixed <- function(v, tree, fixed.angle, len) { if (length(child.ids) > 0) { # Safe to hardcode temporarily. This will only ever apply to # cases with 0, 1, or 2 children. 3+ will use radial calculation. - + # 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. diff --git a/tests/testthat/helper-compare.R b/tests/testthat/helper-compare.R index 57836ce..9197284 100644 --- a/tests/testthat/helper-compare.R +++ b/tests/testthat/helper-compare.R @@ -196,12 +196,14 @@ compare.trees <- function(example, test) { )); } - segments.match <- test.segment.grobs(example, test) + text.match <- test.text.grobs(example, test); + polygons.match <- test.polygon.grobs(example, test); + lines.match <- test.line.grobs(example, test); all( segments.match, - test.text.grobs(example, test), - test.polygon.grobs(example, test), - test.line.grobs(example, test) + text.match, + polygons.match, + lines.match ); } From e5ea00b466bbeb6a02d9762df27653f59c70e1c7 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 14:35:55 -0700 Subject: [PATCH 26/39] Separate angle calculation functions --- R/angles.R | 72 +++++++++++++++++++++++++++++++++++++++ R/position.clones.R | 34 +----------------- R/position.nodes.radial.R | 43 +---------------------- 3 files changed, 74 insertions(+), 75 deletions(-) create mode 100644 R/angles.R diff --git a/R/angles.R b/R/angles.R new file mode 100644 index 0000000..120028b --- /dev/null +++ b/R/angles.R @@ -0,0 +1,72 @@ +calculate.angles.radial <- function(v, tree, spread, total.angle) { + root.node.id <- v$id[[1]]; + node.ids <- c(root.node.id); + + total.angle <- total.angle * spread; + + while (length(node.ids) > 0) { + current.node.id <- node.ids[1]; + node.ids <- node.ids[-1]; + + parent.id <- tree$parent[tree$tip == current.node.id]; + + if (parent.id == -1) { + tree$angle[tree$tip == current.node.id] <- 0; + } + + child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; + num.children <- length(child.ids); + + if (length(child.ids) > 0) { + parent.angle <- parent.angle <- tree$angle[tree$tip == current.node.id]; + child.weight <- assign.weight(current.node.id, v); + + start.angle <- parent.angle - (total.angle) * (num.children > 1) / 2; + num.slices <- max(num.children - 1, 1); + angle.increment <- total.angle / num.slices; + + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + angle <- start.angle + (i - 1) * (angle.increment); + tree$angle[tree$tip == child.id] <- angle; + } + + node.ids <- append(node.ids, child.ids); + } + } + + tree <- override.angles(tree, v); + return(tree); + } + +calculate.angles.fixed <- function(v, tree, fixed.angle) { + node.ids <- c(v$id[[1]]); + + while (length(node.ids) > 0) { + current.node.id <- node.ids[1]; + node.ids <- node.ids[-1]; + + child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; + + if (length(child.ids) > 0) { + # Safe to hardcode temporarily. This will only ever apply to + # cases with 0, 1, or 2 children. 3+ will use radial calculation. + + # 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 (length(child.ids) == 1) c(0) else c(-1, 1) * fixed.angle; + + for (i in seq_along(child.ids)) { + child.id <- child.ids[i]; + angle <- child.angles[i]; + tree$angle[tree$tip == child.id] <- angle; + } + } + + node.ids <- append(node.ids, child.ids); + } + + tree <- override.angles(tree, v); + return(tree); + } diff --git a/R/position.clones.R b/R/position.clones.R index 82eb2a0..2cd3212 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -81,39 +81,7 @@ position.clones <- function(v, tree, wid) { } position.nodes.fixed <- function(v, tree, fixed.angle, len) { - calculate.angles <- function(v, tree, fixed.angle) { - node.ids <- c(v$id[[1]]); - - while (length(node.ids) > 0) { - current.node.id <- node.ids[1]; - node.ids <- node.ids[-1]; - - child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; - - if (length(child.ids) > 0) { - # Safe to hardcode temporarily. This will only ever apply to - # cases with 0, 1, or 2 children. 3+ will use radial calculation. - - # 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 (length(child.ids) == 1) c(0) else c(-1, 1) * fixed.angle; - - for (i in seq_along(child.ids)) { - child.id <- child.ids[i]; - angle <- child.angles[i]; - tree$angle[tree$tip == child.id] <- angle; - } - } - - node.ids <- append(node.ids, child.ids); - } - - tree <- override.angles(tree, v); - return(tree); - } - - tree <- calculate.angles(v, tree, fixed.angle); + tree <- calculate.angles.fixed(v, tree, fixed.angle); for (i in seq_along(v$id)) { vi <- v[i, ]; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 5dc3aa1..58f939f 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -39,48 +39,7 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { tau <- -(pi / 2.5); vi <- v[v$parent == -1, ]; - calculate.angles <- function(v, tree, spread) { - root.node.id <- v$id[[1]]; - node.ids <- c(root.node.id); - - total.angle <- abs(tau) * spread; - - while (length(node.ids) > 0) { - current.node.id <- node.ids[1]; - node.ids <- node.ids[-1]; - - parent.id <- tree$parent[tree$tip == current.node.id]; - - if (parent.id == -1) { - tree$angle[tree$tip == current.node.id] <- 0; - } - - child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; - num.children <- length(child.ids); - - if (length(child.ids) > 0) { - parent.angle <- parent.angle <- tree$angle[tree$tip == current.node.id]; - child.weight <- assign.weight(current.node.id, v); - - start.angle <- parent.angle - (total.angle) * (num.children > 1) / 2; - num.slices <- max(num.children - 1, 1); - angle.increment <- total.angle / num.slices; - - for (i in seq_along(child.ids)) { - child.id <- child.ids[i]; - angle <- start.angle + (i - 1) * (angle.increment); - tree$angle[tree$tip == child.id] <- angle; - } - - node.ids <- append(node.ids, child.ids); - } - } - - tree <- override.angles(tree, v); - return(tree); - } - - tree <- calculate.angles(v, tree, spread); + tree <- calculate.angles.radial(v, tree, spread, abs(tau)); preorder.traversal <- function( node = NULL, From d08d22b1e44853c60c8205ac879b5d87c47a21c4 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 14:38:25 -0700 Subject: [PATCH 27/39] Simplify angle calculation return format --- R/angles.R | 4 ++-- R/position.clones.R | 2 +- R/position.nodes.radial.R | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/angles.R b/R/angles.R index 120028b..6817d3b 100644 --- a/R/angles.R +++ b/R/angles.R @@ -36,7 +36,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { } tree <- override.angles(tree, v); - return(tree); + return(tree$angle); } calculate.angles.fixed <- function(v, tree, fixed.angle) { @@ -68,5 +68,5 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { } tree <- override.angles(tree, v); - return(tree); + return(tree$angle); } diff --git a/R/position.clones.R b/R/position.clones.R index 2cd3212..64b7829 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -81,7 +81,7 @@ position.clones <- function(v, tree, wid) { } position.nodes.fixed <- function(v, tree, fixed.angle, len) { - tree <- calculate.angles.fixed(v, tree, fixed.angle); + tree$angle <- calculate.angles.fixed(v, tree, fixed.angle); for (i in seq_along(v$id)) { vi <- v[i, ]; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 58f939f..37d8815 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -39,7 +39,7 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { tau <- -(pi / 2.5); vi <- v[v$parent == -1, ]; - tree <- calculate.angles.radial(v, tree, spread, abs(tau)); + tree$angle <- calculate.angles.radial(v, tree, spread, abs(tau)); preorder.traversal <- function( node = NULL, From 3bfb9cd037ff52f356a8b957c33331c6d460ef64 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 14:45:42 -0700 Subject: [PATCH 28/39] Improve angle calculation memory efficiency --- R/angles.R | 16 +++++++++------- R/position.clones.R | 13 ++++++------- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/R/angles.R b/R/angles.R index 6817d3b..deb9925 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); total.angle <- total.angle * spread; + angles <- numeric(nrow(tree)); while (length(node.ids) > 0) { current.node.id <- node.ids[1]; @@ -28,18 +29,19 @@ 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); - tree$angle[tree$tip == child.id] <- angle; + angles[tree$tip == child.id] <- angle; } node.ids <- append(node.ids, child.ids); } } - - tree <- override.angles(tree, v); - return(tree$angle); + + angles <- override.angles(tree, v, angles); + return(angles); } calculate.angles.fixed <- function(v, tree, fixed.angle) { + angles <- numeric(nrow(tree)); node.ids <- c(v$id[[1]]); while (length(node.ids) > 0) { @@ -60,13 +62,13 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { for (i in seq_along(child.ids)) { child.id <- child.ids[i]; angle <- child.angles[i]; - tree$angle[tree$tip == child.id] <- angle; + angles[tree$tip == child.id] <- angle; } } node.ids <- append(node.ids, child.ids); } - tree <- override.angles(tree, v); - return(tree$angle); + angles <- override.angles(tree, v, angles); + return(angles); } diff --git a/R/position.clones.R b/R/position.clones.R index 64b7829..0612445 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -189,24 +189,23 @@ position.clones.no.vaf <- function(v, wid, spread = TRUE) { return(v); } -override.angles <- function(tree, v) { - angle.overrides <- as.list(v$angle); - names(angle.overrides) <- v$id; - angle.overrides <- angle.overrides[!is.na(angle.overrides)]; +override.angles <- function(tree, v, angles) { + angle.index <- as.list(angles); + names(angle.index) <- v$id; + angle.index <- angle.index[!is.na(angle.index)]; angles <- apply( tree, MARGIN = 1, FUN = function(x) { node.id <- as.character(x['tip']); - angle.override <- angle.overrides[[node.id]]; + angle.override <- angle.index[[node.id]]; angle <- if (is.null(angle.override)) x['angle'] else angle.override; return(angle); } ); - tree$angle <- angles; - return(tree); + return(angles); } reposition.clones <- function(tree, v) { From d4e78fb92d459f45ac0516643137099f12e56310 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 6 Oct 2023 14:46:21 -0700 Subject: [PATCH 29/39] Move angle override function --- R/angles.R | 19 +++++++++++++++++++ R/position.clones.R | 19 ------------------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/R/angles.R b/R/angles.R index deb9925..b602d27 100644 --- a/R/angles.R +++ b/R/angles.R @@ -72,3 +72,22 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { angles <- override.angles(tree, v, angles); return(angles); } + +override.angles <- function(tree, v, angles) { + angle.index <- as.list(angles); + names(angle.index) <- v$id; + angle.index <- angle.index[!is.na(angle.index)]; + + angles <- apply( + tree, + MARGIN = 1, + FUN = function(x) { + node.id <- as.character(x['tip']); + angle.override <- angle.index[[node.id]]; + angle <- if (is.null(angle.override)) x['angle'] else angle.override; + return(angle); + } + ); + + return(angles); + } diff --git a/R/position.clones.R b/R/position.clones.R index 0612445..13870a5 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -189,25 +189,6 @@ position.clones.no.vaf <- function(v, wid, spread = TRUE) { return(v); } -override.angles <- function(tree, v, angles) { - angle.index <- as.list(angles); - names(angle.index) <- v$id; - angle.index <- angle.index[!is.na(angle.index)]; - - angles <- apply( - tree, - MARGIN = 1, - FUN = function(x) { - node.id <- as.character(x['tip']); - angle.override <- angle.index[[node.id]]; - angle <- if (is.null(angle.override)) x['angle'] else angle.override; - return(angle); - } - ); - - return(angles); - } - reposition.clones <- function(tree, v) { for (i in seq_along(v$id)) { vi <- v[i, ]; From e6ddf73427c312028e151c3683f93026fe126122 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Fri, 20 Oct 2023 18:02:09 -0700 Subject: [PATCH 30/39] Unit tests for angle calculation --- R/angles.R | 9 ++- tests/testthat/test-angles.R | 150 +++++++++++++++++++++++++++++++++++ 2 files changed, 156 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test-angles.R diff --git a/R/angles.R b/R/angles.R index b602d27..afb8c57 100644 --- a/R/angles.R +++ b/R/angles.R @@ -74,7 +74,7 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { } override.angles <- function(tree, v, angles) { - angle.index <- as.list(angles); + angle.index <- as.list(v$angle); names(angle.index) <- v$id; angle.index <- angle.index[!is.na(angle.index)]; @@ -84,8 +84,11 @@ override.angles <- function(tree, v, angles) { FUN = function(x) { node.id <- as.character(x['tip']); angle.override <- angle.index[[node.id]]; - angle <- if (is.null(angle.override)) x['angle'] else angle.override; - return(angle); + if (!is.null(angle.override)) { + angle.override <- as.numeric(angle.override); + } + angle <- if (is.null(angle.override) || is.na(angle.override)) x['angle'] else angle.override; + return(as.numeric(angle)); } ); diff --git a/tests/testthat/test-angles.R b/tests/testthat/test-angles.R new file mode 100644 index 0000000..af3bdc4 --- /dev/null +++ b/tests/testthat/test-angles.R @@ -0,0 +1,150 @@ +test_that( + 'calculate.angles.fixed orders nodes correctly', { + 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 + ); + + total.angle <- pi / 2; + + result <- calculate.angles.radial( + test.v, + test.tree, + spread = 1, + total.angle = total.angle + ); + result.order <- order(result); + child.ids <- as.numeric(test.tree$tip[test.tree$parent == 1]); + result.order <- result.order[result.order %in% child.ids]; + + expect_equal(result.order, child.ids); + } + ); + +test_that( + 'calculate.angles.radial spreads nodes equally', { + 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 + ); + + total.angle <- pi / 2; + + result <- calculate.angles.radial( + test.v, + test.tree, + spread = 1, + total.angle = total.angle + ); + + num.digits <- 6; + deltas <- sapply( + # Iterate through all children in pairs if i, i + 1. + # Last index not needed, as i + 1 out of bounds. + 2:(length(result) - 1), + FUN = function(i) round(abs(result[i + 1] - result[i]), num.digits) + ); + expected.delta <- round( + total.angle / (num.children - 1), + num.digits + ); + + expect_true(all(deltas == expected.delta)); + } + ); + +test_that( + 'calculate.angles.radial applies spread to angle range', { + 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 + ); + + spread <- 2.5; + total.angle <- pi / 4; + + result <- calculate.angles.radial( + test.v, + test.tree, + spread = spread, + total.angle = total.angle + ); + + result.range <- range(result); + expected.range <- c(-1, 1) * (spread * total.angle / 2); + + expect_equal(result.range, expected.range); + } + ); + +test_that( + 'calculate.angles.radial overrides angles', { + num.children <- 3; + test.tree <- data.frame( + parent = c(-1, rep(1, num.children)) + ); + test.tree$tip <- rownames(test.tree) + + angles.to.override <- c(2, 3); + override.values <- c(-1, 1) * (pi / 2); + + test.v <- data.frame( + id = test.tree$tip, + parent = test.tree$parent, + angle = NA + ); + test.v[angles.to.override, 'angle'] <- override.values; + + result <- calculate.angles.radial( + test.v, + test.tree, + spread = 1, + total.angle = pi / 2.5 + ); + + expect_equal(result[angles.to.override], override.values); + } + ); + +test_that( + 'calculate.angles.fixed sets angle correctly', { + test.tree <- data.frame( + parent = c(-1, 1, 1) + ); + test.tree$tip <- rownames(test.tree) + + test.v <- data.frame( + id = test.tree$tip, + parent = test.tree$parent + ); + + angle <- pi / 2; + + result <- calculate.angles.fixed( + test.v, + test.tree, + fixed.angle <- angle + ); + expected.result <- c(0, -(angle), angle); + + expect_equal(result, expected.result); + } + ); From efb95ab1cb82b3aff692c1d0f1625633d2491660 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 30 Oct 2023 15:42:11 -0700 Subject: [PATCH 31/39] Fix angle calculation test cases --- R/angles.R | 9 +++++++-- tests/testthat/test-angles.R | 38 +++++++++++++++++++++++++++++++----- 2 files changed, 40 insertions(+), 7 deletions(-) diff --git a/R/angles.R b/R/angles.R index afb8c57..aed2955 100644 --- a/R/angles.R +++ b/R/angles.R @@ -74,12 +74,17 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { } override.angles <- function(tree, v, angles) { + if (is.null(v$angle)) { + v$angle <- NA; + } + angle.index <- as.list(v$angle); + names(angle.index) <- v$id; angle.index <- angle.index[!is.na(angle.index)]; angles <- apply( - tree, + data.frame(tip = tree$tip, angle = angles), MARGIN = 1, FUN = function(x) { node.id <- as.character(x['tip']); @@ -87,7 +92,7 @@ override.angles <- function(tree, v, angles) { if (!is.null(angle.override)) { angle.override <- as.numeric(angle.override); } - angle <- if (is.null(angle.override) || is.na(angle.override)) x['angle'] else angle.override; + angle <- if (is.null(angle.override) || is.na(angle.override)) x['angle'] else angle.override; return(as.numeric(angle)); } ); diff --git a/tests/testthat/test-angles.R b/tests/testthat/test-angles.R index af3bdc4..7c057ba 100644 --- a/tests/testthat/test-angles.R +++ b/tests/testthat/test-angles.R @@ -4,7 +4,7 @@ test_that( test.tree <- data.frame( parent = c(-1, rep(1, num.children)) ); - test.tree$tip <- rownames(test.tree) + test.tree$tip <- rownames(test.tree); test.v <- data.frame( id = test.tree$tip, @@ -12,7 +12,7 @@ test_that( ); total.angle <- pi / 2; - + result <- calculate.angles.radial( test.v, test.tree, @@ -48,7 +48,7 @@ test_that( spread = 1, total.angle = total.angle ); - + num.digits <- 6; deltas <- sapply( # Iterate through all children in pairs if i, i + 1. @@ -135,7 +135,7 @@ test_that( id = test.tree$tip, parent = test.tree$parent ); - + angle <- pi / 2; result <- calculate.angles.fixed( @@ -145,6 +145,34 @@ test_that( ); expected.result <- c(0, -(angle), angle); - expect_equal(result, expected.result); + expect_equal(result, expected.result, tolerance = 10 ** -3); } ); + +test_that( + 'calculate.angles.fixed overrides angles', { + num.children <- 2; + test.tree <- data.frame( + parent = c(-1, rep(1, num.children)) + ); + test.tree$tip <- rownames(test.tree) + + angles.to.override <- c(2, 3); + override.values <- c(-1, 1) * (pi / 2); + + test.v <- data.frame( + id = test.tree$tip, + parent = test.tree$parent, + angle = NA + ); + test.v[angles.to.override, 'angle'] <- override.values; + + result <- calculate.angles.fixed( + test.v, + test.tree, + fixed.angle = pi / 4 + ); + + expect_equal(result[angles.to.override], override.values); + } +); From d455a17a47bb18ea23f98198891d281023643fda Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 30 Oct 2023 17:10:43 -0700 Subject: [PATCH 32/39] Remove angle calculation from node positioning --- R/calculate.clone.polygons.R | 11 ++++++++-- R/position.clones.R | 2 -- R/position.nodes.radial.R | 40 ++++-------------------------------- 3 files changed, 13 insertions(+), 40 deletions(-) diff --git a/R/calculate.clone.polygons.R b/R/calculate.clone.polygons.R index 476271d..ff20daf 100644 --- a/R/calculate.clone.polygons.R +++ b/R/calculate.clone.polygons.R @@ -333,13 +333,20 @@ compute.clones <- function( if (no.ccf && (is.null(fixed.angle) && nrow(v) > 6) || any(table(v$parent) > 2)) { v <- count.leaves.per.node(v); - tmp <- position.nodes.node.radiusial(v, tree, extra.len, spread); + + tau <- -(pi / 2.5); + vi <- v[v$parent == -1, ]; + + tree$angle <- calculate.angles.radial(v, tree, spread, abs(tau)); + + tmp <- position.nodes.node.radiusial(v, tree, extra.len); clone.env <- new.env(parent = emptyenv()); clone.env$v <- tmp$v; clone.env$tree <- tmp$tree; return(clone.env); } else if (no.ccf && !is.null(fixed.angle)) { - #position nodes fixed angle + tree$angle <- calculate.angles.fixed(v, tree, fixed.angle); + clone.env <- position.nodes.fixed( v, tree, diff --git a/R/position.clones.R b/R/position.clones.R index 13870a5..f40d0ea 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -81,8 +81,6 @@ position.clones <- function(v, tree, wid) { } position.nodes.fixed <- function(v, tree, fixed.angle, len) { - tree$angle <- calculate.angles.fixed(v, tree, fixed.angle); - for (i in seq_along(v$id)) { vi <- v[i, ]; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 37d8815..6d06a89 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -33,23 +33,11 @@ assign.weight <- function(node,v, extra.len, spread) { return(node.weight); } -position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { - w <- spread * pi; +position.nodes.node.radiusial <- function(v, tree, extra.len) { xpos <- ypos <- 0; - tau <- -(pi / 2.5); vi <- v[v$parent == -1, ]; - tree$angle <- calculate.angles.radial(v, tree, spread, abs(tau)); - - preorder.traversal <- function( - node = NULL, - tree = NULL, - w = NULL, - tau = NULL, - eta = NULL, - spread = 1 - ) { - + preorder.traversal <- function(node, tree) { vi <- v[v$id == node, ]; d <- tree$length[tree$tip == vi$id & tree$parent == vi$parent]; @@ -62,32 +50,12 @@ position.nodes.node.radiusial <- function(v, tree, extra.len, spread = 1) { v$y[v$id == vi$id] <<- d; } - eta <- tau; - for (child in v$id[v$parent == vi$id]) { - child.weight <- assign.weight(child, v); - w <- child.weight * spread * pi; - tau <- eta; - eta <- eta + w; - - preorder.traversal( - node = child, - tree = tree, - w = w, - tau = tau, - eta = eta, - spread = spread - ); + preorder.traversal(node = child, tree = tree); } } - preorder.traversal( - node = 1, - tree = tree, - w = w, - tau = tau, - spread = spread - ); + preorder.traversal(node = 1, tree = tree); v <- reposition.clones(tree, v); From dd0c88628301caad236a089c3a67746c54253c2c Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 30 Oct 2023 17:34:10 -0700 Subject: [PATCH 33/39] Use same node position algorithm for radial and fixed angles --- R/calculate.clone.polygons.R | 46 +++++++++++++++--------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/R/calculate.clone.polygons.R b/R/calculate.clone.polygons.R index ff20daf..c7b85ce 100644 --- a/R/calculate.clone.polygons.R +++ b/R/calculate.clone.polygons.R @@ -330,34 +330,26 @@ compute.clones <- function( root <- v[!is.na(v$parent) & v$parent == -1, ]; v <- v[is.na(v$parent) | v$parent != -1, ]; v <- rbind(root, v); + v <- count.leaves.per.node(v); + + if (no.ccf) { + tree$angle <- if ((is.null(fixed.angle) && nrow(v) > 6) || any(table(v$parent) > 2)) { + tau <- -(pi / 2.5); + vi <- v[v$parent == -1, ]; + calculate.angles.radial(v, tree, spread, abs(tau)); + } else { + calculate.angles.fixed(v, tree, fixed.angle); + } + tmp <- position.nodes.node.radiusial(v, tree, extra.len); + + clone.env <- new.env(parent = emptyenv()); + clone.env$v <- tmp$v; + clone.env$tree <- tmp$tree; + + return(clone.env) + } - if (no.ccf && (is.null(fixed.angle) && nrow(v) > 6) || any(table(v$parent) > 2)) { - v <- count.leaves.per.node(v); - - tau <- -(pi / 2.5); - vi <- v[v$parent == -1, ]; - - tree$angle <- calculate.angles.radial(v, tree, spread, abs(tau)); - - tmp <- position.nodes.node.radiusial(v, tree, extra.len); - clone.env <- new.env(parent = emptyenv()); - clone.env$v <- tmp$v; - clone.env$tree <- tmp$tree; - return(clone.env); - } else if (no.ccf && !is.null(fixed.angle)) { - tree$angle <- calculate.angles.fixed(v, tree, fixed.angle); - - clone.env <- position.nodes.fixed( - v, - tree, - fixed.angle = fixed.angle, - len = extra.len - ); - - return(clone.env) - } else{ - v <- position.clones(v, tree, wid); - } + v <- position.clones(v, tree, wid); v$x <- v$y <- v$len <- 0; len <- extra.len; From 3fddd04da558828aa1b4925f390905ca336b1df7 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 30 Oct 2023 17:36:31 -0700 Subject: [PATCH 34/39] Fix code style --- R/calculate.clone.polygons.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/calculate.clone.polygons.R b/R/calculate.clone.polygons.R index c7b85ce..d5c1e7e 100644 --- a/R/calculate.clone.polygons.R +++ b/R/calculate.clone.polygons.R @@ -341,12 +341,12 @@ compute.clones <- function( calculate.angles.fixed(v, tree, fixed.angle); } tmp <- position.nodes.node.radiusial(v, tree, extra.len); - + clone.env <- new.env(parent = emptyenv()); clone.env$v <- tmp$v; clone.env$tree <- tmp$tree; - - return(clone.env) + + return(clone.env); } v <- position.clones(v, tree, wid); From 62f7e9ee184f9da86cca5afa9061089d6dae7581 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Mon, 30 Oct 2023 17:37:18 -0700 Subject: [PATCH 35/39] Clean up node positioning code --- R/calculate.clone.polygons.R | 2 +- R/position.clones.R | 36 ------------------------------------ R/position.nodes.radial.R | 2 +- 3 files changed, 2 insertions(+), 38 deletions(-) diff --git a/R/calculate.clone.polygons.R b/R/calculate.clone.polygons.R index d5c1e7e..1caed88 100644 --- a/R/calculate.clone.polygons.R +++ b/R/calculate.clone.polygons.R @@ -340,7 +340,7 @@ compute.clones <- function( } else { calculate.angles.fixed(v, tree, fixed.angle); } - tmp <- position.nodes.node.radiusial(v, tree, extra.len); + tmp <- position.nodes(v, tree, extra.len); clone.env <- new.env(parent = emptyenv()); clone.env$v <- tmp$v; diff --git a/R/position.clones.R b/R/position.clones.R index f40d0ea..260e900 100644 --- a/R/position.clones.R +++ b/R/position.clones.R @@ -80,42 +80,6 @@ position.clones <- function(v, tree, wid) { return(v); } -position.nodes.fixed <- function(v, tree, fixed.angle, len) { - for (i in seq_along(v$id)) { - vi <- v[i, ]; - - angle <- tree$angle[tree$tip == vi$id]; - - if (!is.na(vi$parent) && vi$parent == -1) { - # If root the clone extends the full width of the plot - x0 <- 0; - y0 <- tree$length[tree$parent == -1]; - len0 <- len + y0; - } else { - par <- v[v$id == vi$parent, ]; - - r <- tree$length[tree$tip == vi$id]; - x.shift <- r * sin(angle); - x0 <- par$x + x.shift; - y.shift <- r * cos(angle); - y0 <- par$y + y.shift; - len0 <- par$len + y.shift; - } - - v[i,]$len <- len0; - v[i,]$y <- y0; - v[i,]$x <- x0; - } - - v <- reposition.clones(tree, v); - - clone.env <- new.env(parent = emptyenv()); - clone.env$v <- v; - clone.env$tree <- tree; - - return(clone.env); - } - position.clones.no.vaf <- function(v, wid, spread = TRUE) { v$y.mid <- v$y1 <- v$y2 <- 0; diff --git a/R/position.nodes.radial.R b/R/position.nodes.radial.R index 6d06a89..3f84c69 100644 --- a/R/position.nodes.radial.R +++ b/R/position.nodes.radial.R @@ -33,7 +33,7 @@ assign.weight <- function(node,v, extra.len, spread) { return(node.weight); } -position.nodes.node.radiusial <- function(v, tree, extra.len) { +position.nodes <- function(v, tree, extra.len) { xpos <- ypos <- 0; vi <- v[v$parent == -1, ]; From 492dd11fd96d5b5b9b3fdc7934337dd07301ef0b Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 9 Nov 2023 16:13:37 -0800 Subject: [PATCH 36/39] Fix merge conflicts --- R/SRCGrob.R | 5 +---- R/angles.R | 2 +- tests/testthat/helper-compare.R | 15 +-------------- 3 files changed, 3 insertions(+), 19 deletions(-) diff --git a/R/SRCGrob.R b/R/SRCGrob.R index 6e68d4e..9537900 100644 --- a/R/SRCGrob.R +++ b/R/SRCGrob.R @@ -48,11 +48,8 @@ SRCGrob <- function( tree, node.text, colour.scheme = colour.scheme, -<<<<<<< HEAD - use.radians = use.radians -======= + use.radians = use.radians, default.node.colour = node.col ->>>>>>> e9fd02b08dad613689f57f3c74b7c0ee522d25be ); fixed.angle <- pi / 6; diff --git a/R/angles.R b/R/angles.R index aed2955..83d433c 100644 --- a/R/angles.R +++ b/R/angles.R @@ -35,7 +35,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { node.ids <- append(node.ids, child.ids); } } - + angles <- override.angles(tree, v, angles); return(angles); } diff --git a/tests/testthat/helper-compare.R b/tests/testthat/helper-compare.R index 7205387..b929b71 100644 --- a/tests/testthat/helper-compare.R +++ b/tests/testthat/helper-compare.R @@ -23,7 +23,7 @@ compare.trees <- function(example, test) { Negate(is.null), c( list(getGrob(x, 'tree.segs.1')), - list(getGrob(x, 'tree.segs.2'))= + list(getGrob(x, 'tree.segs.2')) ) ); axes <- sapply( @@ -201,7 +201,6 @@ compare.trees <- function(example, test) { )); } -<<<<<<< HEAD segments.match <- test.segment.grobs(example, test) text.match <- test.text.grobs(example, test); polygons.match <- test.polygon.grobs(example, test); @@ -211,17 +210,5 @@ compare.trees <- function(example, test) { text.match, polygons.match, lines.match -======= - segs.equal <- test.segment.grobs(example, test); - text.equal <- test.text.grobs(example, test); - polygons.equal <- test.polygon.grobs(example, test); - lines.equal <- test.line.grobs(example, test); - print(c(segs.equal, text.equal, polygons.equal, lines.equal)) - all( - segs.equal, - text.equal, - polygons.equal, - lines.equal ->>>>>>> e9fd02b08dad613689f57f3c74b7c0ee522d25be ); } From c5cb65d1bfd6fc1da98baa8e936e37e3e95d8b7d Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 9 Nov 2023 17:32:14 -0800 Subject: [PATCH 37/39] Fix test plots --- tests/testthat/data/branching.data.Rda | Bin 294 -> 0 bytes tests/testthat/data/branching.fixed.plots.Rda | Bin 4260 -> 4559 bytes tests/testthat/data/branching.plots.Rda | Bin 3118 -> 0 bytes .../testthat/data/branching.radial.plots.Rda | Bin 5315 -> 5627 bytes 4 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 tests/testthat/data/branching.data.Rda delete mode 100644 tests/testthat/data/branching.plots.Rda diff --git a/tests/testthat/data/branching.data.Rda b/tests/testthat/data/branching.data.Rda deleted file mode 100644 index ad26edb81e09b66ad9cd928d5c4c0cbb30e8d593..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 294 zcmV+>0onc^iwFP!000001C>%iPQx$|+$K&S0V<@v178q=8ypZ1Kp^$%#7h%l;>t0q zdV;s`LLPuxHeub;00%5>)-&E2kF4BYPfzn{4gfKTcm#1mTS)HjZcZ)$L_}Z&0y658 z!l|aL>SiWAwq9!G6+krUMm_vsIoOJz9OADT%MmX ziXG~~0ow=Lf7&OlHTA|)tG3!+psn|W{ty;Mm5;vxQJ81ksJ`V620!}Fn)YV9lL4w&=HIWmfd~l>EwEB`n>%o-p4*48bpRm3MSb72g0KjO2c>n+a diff --git a/tests/testthat/data/branching.fixed.plots.Rda b/tests/testthat/data/branching.fixed.plots.Rda index 0a5fcd85f2b8d854a93c29a35f4bc35f8f286c88..9b1affef9c009b10a1cb03b3793d9eccb9dcbbc6 100644 GIT binary patch literal 4559 zcma)92|SeR8aHGwiH5S(6v@~syRtN`CMVsNW}Sa~j*P$BgKRV!DTum3cSUKli484t>YTDMA|DZXW7yz-dR4UWkZ9 zU_?@v>3cIZ_NiI0NZWRp^Ts8qSzs$a9Q9RWaYH9~qR|r+$0}CB%)CB2(v>{1*1V)# zwQ*54$J-LQ_|)>`!QjB8rC1SZ~2#Mk8 zp2Encc3~e!=JF6E&S=($RRtw9U6Hjf^*6>WrBP+0Li%))?;Lt4(HoO{s*AN*qh9mj zOsYugXUp?hJkw^=ADfp7LUR$&+g=B#Hw%+urHz`6Dk2W_ZH!YaWYi!!TTRZc3XlYW zN@=OuhE!2aK_yEem-0);hSxL%{f6$kQsu_WqOLYv6BJ{$o5>cF&N@Z)850n<4dUOV z6+Ov`sr4WJGi_Q~apFd9O4MvkOJff~BgN(}pK;_3qh4=ltO+`Yadcrhhag0jKTEmT zV9fRBn5{Usl7CTolqYp8lC&qRwoE?Yzk~k{ zqC~{ly?!MRqtC!URRUcot0_}u2haHI>$^(Q@w;l+)EM%?xv zGl`5y!ECIYOP;A^c>i?+Vcl3}Z-3PnxAzM+)@I60aG?FLq|llOR`v;dla8V~P)Q=v zj+}J(6eUi*-s^^%v&19KlURNV1&+!&xPrqKhZj479^=w9vB6`QhFQ5}ilP~TYQSWI zUS=h(P5JOWDp+cYIOl?I5B~$cg1e9DpkCqwVdrq|5r`ME;%giWI$8_c@nhgpSIFv@7p2B|?>0oy9 zbuLZM_jRsuC_LZ`WnCWF43~hEy;@fP8>V(!YEzu420mY(r32>3CVu=(eo4UT(wkdm1FeU;&BSEciq7F^f_$1 zcYM{*yV(#Fc^y5GaaP6Eqiyh^0=|+`RIuK#?97&trz};tU~ezV*qQjkbG?8NUfv8^ zX_!~p`ZCCnFcGkxJo9RvpWiEnZfdn^om?wd=QtYRb!&0MROLyCv#Rfyh5yD#UUZ!T z-fyI;FT!CXzYesr_I1uza&Xg{EyL7@x*V_7?;8%nT)?}0&gMy?EpGuKrL&-n2qJ35 zRTX?e^&TBG@oq6BO*CBrAFMXiEstM}HI%DiY~o_e@KL7Y{WRkBh#ngE3b$qBq~uvt@kh!vxc1el_3VWJDZb z{Hj2QI9s|X#)!}ckv|1MamZM@OeR!56MYCI;DTH2rudK-U=GG*0sJU=cfA$xXV$|2 z?bQ?z0}5ZrjLL^uaT*VIW*>6b^GWKu%g(_B`MK?nckWt*`m?AqY*Bv2C1Z%bgYg^X}WB7m7ewV$PMur_m3kiJxhUdqP>SLA% zer$Hw?4khe0Q7>J(DoJB8d2+_dIJRr@}(&?E9u+N$(tMOiX#cH(HE zhm2nauw2$ZiN9B61jvKfSu*hKFcA143=qMX=n-%xNI)_7_4w;xoossQOQF+$9d+XrRA|!gsHB zm8=w9H;hs%et!i&W`kM@>2X_>87R$^^M0v{NB;J4?af9 zojc2ezx|T-TQps!jhzW-| z+yk#=Y}zl64{m!i0jv?zwhS4oQJXJSyljUFhw!o&bH{;3FEtzufO^qzfmN5Y>H!!r zv*N2J4YC=e49L-X8h~hRDwz*ntFP)E6Ga0}1g1nAx7~d$z5p;Zk>!oBC2@$;)Zq&= z>LcB>4qJwK>7o{}a(FzT%Y1H_2n+&cgUTil(ubk40a$NTwbHDRjP)8mff+I&cVanZ zlw58uwBAuBX&`=7+>ZqRLzjHHAGF&`+XY$hoh^N$y}ZKs|?@%xp29P@_4jkYh@7E=t6Fg~-VAC?rv)l_$46lF{hsztJS(p3D{1P_ z5WO8Cps=j5|l~b|5vUim7rpQ zJE{Fq#lH{pcKVcQ=n=BcGOx|U-uHokwdr1g0HM}OAQ;4 zOW?JdduLuYPP+(|AVt@hjup;*w3?^EhV)s=j&;4lh8``Ns>MsrQ!kIz@w-@H`whh9 z=A<1>Zg$s2YmD44POV6fw5yj8Q&}8}Rgz=TKxCr?2X9`jqfQl zr`c4PsLgv}i6oe-d2I6KNLTx@r(eDaaj1NGQ?kLkWUO9;VKR#~c6^Pp>YB)F6w1ke zrymsW+VzB3$!xICFXn2EI`wm83Q0dL1~m=xJm)*@@K~-jTCXOwKRotN zl*go3rEq776n&CYN_wW!z0yoj#BQA+4zZ6TzDX0iMf#ri$Yy!nJq0@=!d z&$hD1^+QE>Uz=dqJ-G)oS>Gz$-#*BR#@^!_9nm8FTwGge!Zg=%bLH(Fn40UsucOe!q%K&*l@W1Qt~iz2_>fm?-w-_|;M= zUDEh$FT+d%IK{I@t< zmr~DmIQTQvpNN{RE!>#e>^?u`=|fpi7b%PPO_z~Qv!gG*had*dMCD#qaEIrWt+sS^ z%PZL(d%6`P7mw1-GDKe)W5HlxdZnd%@qy{_IqMm&_HN2kPDx4QCqk83GpnVlnK+vE z9hWEGFB`4nNtb<5!GO8%nf%Qy9INy!YkczU4Q<*jMzwMg)msWO!5fDL7sD({wCos= zOIeB=g@+_@xD?5=@rzSK32A>YjFyRz^bXr!OO#Pq4S$7daj+;FhfhDI=JyX8wBnr8 z()w@FUg{V>crk6LCwxo*nl)8!m7m>DevD~S_z*h&ffAnPW$ zC!BuW^fh9uZS~D&1i1v=GUYw*e!F{+usP@5eYQ*#TXtC=9Y4@KkTu_n-o%}{_1-}7 zs&#@tQ%NMd6L&%Gr+KMQ>ksBVdX-}}rSq)Rf(#`WZdtq7t7QO2mj=))yJ zqW4}y^b!oB#r;TjH+Rdu`}dvane(2vocf;M`JR_Oga&l-qgYAu2)*!_t!Zc5d2PFt zSegmz1T{3?JqTbJ2$n0U5dHxXI^5Y!E)=DVncL1x8W~%*Uds^bOuOnY6G;hWIs3Vg z_L5QFRtC~5FFlB(G|sfd^m@saQ>it*vJEn(OUpMmms@K_S1>JlJNw1L?;e|=O=fpn zHxH6cl6P0QRx-DCa#hBoLlroQQCc>t>0+z7x8LimRvtF$a7JnM4$TL>;iPDvLyiRB z7L-DND9To|Xl_k!%`1^U(id|MGbo15HIRJ zywJISM|17Gg#CO>&l%5$Gi6y-x-yQg*`H2 znhd8s*s`YDbcd{t4EbFOADcjU&9us_Nt(6z3&eQaTIGx;;tJUoq4u&`Ypjn*EUq8b zrEGB^O{Ko?+*%~u{v9z%h|60=c+zr!5bj>#ttNR%)cUEj%Mx7(n#V>p?mWg|>0)GD zVe31&8m;h8)9BWHWtT(gi(avrb{wK8A5{jUPowzDnB*b%!?*7#TAY){Z4Dna;Hu_3 zTFAS~5#!DQ!A`H|^vaiJp+=1?<<3K|UbC`4sb@_YkK+o=RI|8MVfsA#mw15;|LV>l z(F=?dXjU_>Q+;>Ef1znqvT_M_qu$xmD;-E~1sP+eWn(*E_x7r|Syh&biXcX^2HxN9 zVwd!O?JLu+nDf%UrBdlfjP$DGlsZFeeDFM-$v{GePNlIB7pLxz!w*)rH5LQ1~vOHC?b?(4|!? z)2Thu6%{1g8j3ia-kQjpkH+qe?Ub>P?5+Az_BQQr-`pgHc}8R1jx4gQpUn4TC{r|< z@V<5UH1bIiS{z;{=4uMQ4sSq?ccZ*=C8gQ5P_x(Z!&6Fx2<<^BB|=`5Q5VMK#e40sT2yq=N24t$EzX>>T!$Rbf_f2!<>mUaj@IM@RPLG=P$G5&40l~= zaf@T->VSUZ!yHOP4D}}h2m!0wh@(V6K?V0^kz;snGGqq7Lb`X~Wm!4rhJAraURs>J zI`eDbKVIOqe>DZX7lwS$T)#=i94HHoE`s>+UaR8F)}dv|oq3ce&vAuGPVP5Cnc^>Z zm)n=dweV#0J)Q*KeRwkdPH1Eq{378rw8tbWQtxC02;W}p5}c-@Tdm;{>WUNJEuWag zTqkbd-{pMe0ztjUauANw{a@vQ$r+xI-zFz&A!N8z2qT!|gfJHIeVy1V9@(>jIrJ3z zj$GAtC{nDP{m7upn)J9y!v-uEop&Byw+yD>jnn%{mddltNS4YEatZ;b0cPJYp5DZ*lmNL7BcXKuZ6-_}ebP z(7*xN-_L)$^*#JUIzRl^U8=)I;P$=1985SPb!P6xkGsfKud&nE(jn+6M4^sQink9G zh>C!gr7Gs5#~B_+eJ~dM*Q)={Dze=NdK|-XhVY5mBD}uWfpTR~@PmL6LOgVT&WZS6 zEq;?s4%w4*eY5gSo@1hmWPi;$l*F2o_>_v*7oOrQ^tfv(dzDRhne^S|&o}njl5@tV z3$%9g9}l;C$1fpRftK|s&KK>+-n zz=0l@0`TBtApVh|#Ni-vSeEtJAvIK}X6%@rf}bDc7}+OP`L~RL77e^>8GP&`5C=~P zgs=%ReW3>k74v;j8H`4qAP5A2<*%9aeOw`=+XJEXKWzQ#4*&(M2j~<+$Q7i9vnQ7Y z+6FVA8n|pj4&VQ2rZ=#*HQa5b$T&budQ{~f872AofuL>qUoRo9h(=BFGQC5#51-iu`wIT3%p$0xLT%egR(H-~5<6wbC z_}BKnnhE>VvW&~wp=T2(jWkYk|C&0W!TjG`b73dagW#E_s4jpf-9EzG20g;cK;l-M)WkVuNrlZ3L1 z9r(@+Ed=7S0gJKE;Sn?HcOi(czdrK zoo~s^T6*xH_${9n?A^bduLm-hCpC(e#ycCwb_I|;XPhzX`7G?x#r=B29_^4ZYlS7G z!y==%yH~i-Irql95mplqyG72k(^)H1in@ik5+&j;3in8=@6r~VvP$epuAF^UB#yLb z8In+_o(iW9<;j_GeA{I|nbN1fyhZ<_TVRMuC#nMcu|?zU+xqF%?zG7HQ7EH~#}Pw; zOu0=m*iKRofr>S-vQF6g!QcM)jX^Utj9Gqq)Tpur9X)?wPXM7If108U1dxbL$Z1A}3Ug%|^PHJTx*&ep<>O6=NF>X06CQim_6j!z?l~XA79pYZkg1<5H5T#YbuFs?921vLt0c%#Ip2%z8|(AFKf0jR}$-B zS`IVkDRFApA`;OL6LeMp2iX4=K?>Iysc-< z*EU}}sdT?vXL$LO9s|rVK_Cf}>Ga^p!m@lvyS-4trd)q5tmANb)B7finf9!W1e~w6 zAa*zYrkJMf&!dCMFt@UC7sj(L~uHaO6KF=($(T%TS!e=&=?n7Aoc6G`eLt{U7|2=Z(!tDbh*-h3vH z^vogHJ(PkiRz8w<>L1SWaae3->D)m-)j<{tdz6w!C9To?wGnMv@_AgVK5p*DLK zeSQ9`A?pi^ObW3Otq7Af-siK4$inYdClv@EF5t2yOQc@rCw}@Fp=p!lr2aa{m73pn zuQ1;JRGa$!h+2jq%e8XDvqe|r)jJR3hg4k02@#znS~ zxxknX^VK2m#nfT+PS@qCFb0UXC)!Y#)eYa+x0ryNN2Z6S&ohHHkA#PZ==0~GKMD$w zF?Be1K8rf*S*$HF;bxs^_)4_-%L{NN?|NJBg9~cjgkiU=;r{BX>BV9Oz2@C7r5T}r zb3UG!f706Ot5=~(=a%254=%x5;_c$D;-O{&36}ni3(}g`TT8`D_I9`^QiEz&a?YsP zH%$_q*vm1AYe-0jK|zrx;R@2hRA zT_Ht!E*hk}t`R+?Be&bPVLiN(=ia9bIccE}mJysZvgx9ECV8IqrYtAN-L9P)MUoQl zQ~wMoWn4>VwGEo87EQYQh4rXupEFgm501zBxxlSn;nl~FhgF7;wCBbYO5K;pdEiXL zdHVQw3fJ2Z{=ymO85`&^pv*LzKM&GqI_Ou0f1K@3KbmdZ8RqBgGT*0P5XzbdLwzNm zbC;6Kv7+TN+x6%-3ml~hY;#E?NcFSmv zk3G?xS`^A3f8>1PbY{^>((R9|!NugEQ0^(^#y1HGtAf+%J@bnS^8$5a38V$H^ITVr zOvjh4_>`-!Ka4-PyPw2e;dP-qTd>u_%L#Lw%YfqCU#RX5VU|Aa8`8yb*%#f{q^cjiw7xUiWlh5Wez{2NXZ_gdzmG}eC(&9Qsz!(t zM@~v|r7zUpyQzD{C!ga+bsc>x#1xD%>%(_xT&^P2r+MiW&jd6EN4Ps$ziEmn3#vJN zDRH{jVYZ~Ln<^3!$|Z+HF7(@fl1hnMdRAn}>{XKi&`QjtukP(92E6RGOCm$uCAzXA zaeBE^(r1-PGg2U~?OPr&bCCIv5AMpoKFP{(Om>h51t?f>G>0!!*k9~Cu&T=&=b@u6-v(44vBn6`G!V8t@j4F3LxJy~C zYGsFG|0642cCy^?_0fKkV_MWw>q|}X!K_ddUUqx<^v9KsDzh_)h=o{@A1&#RPx7+W z%(l<0Iaki_sSzXUE)MFot%mkuz+IAs0aC=S-wl|blf zf$Mg>l(0$%(WtP9x4GfV{bPF|hyqIf9Y8n(9_G9hDUkkA9*sh}0th`^aQu__J`g2L z;HnWYsg$M?}57t(F=^k+U)d z{6HkS5ikIw$zEWTOxpu6MbXKC%+-1Y!9?9iUmfS!6dsFwEy9i)B3+0|?+%{qP&CUN4(2D_~bU?qT z^OS@@5cdaSKp>U}npC(UArMT;{>$nXknaOrnGqJdF>I*(`$=0vKs9}W7XTv>1iX<1 zY7(+}iiChDnK*tp=F6tA?*OU}4344dP`Wew%r_lz(?)TN+LUxw{I}M*LSFaETbm>V z0T>l-g0Cr#?-nw(lV<`0-|Do65F6pHZaIpGh<};kfbL)1PRd^b!u3=F3_6TGU-CNE zzzn0U_>4dc$f_>>c*mVhJ9H5?-QQpS1M~PXt+)4&XyZ*3l!k4pIDNT}frKglxM{C} zcFlk`i5AA*JdeG1J%4R)r1n(OGKC_vf_&l*HUNt(E75c)t?vWn;yvi?xoq9`J%5>SX=@vqPn@&&HEsSY)$&&F%igfc70u z2&0_(lgKBr&gR41W$jK1URJAsDS2Q%ZLNn;BJ48gX`-P$gi0^TTH5#4-R^Bs$Z<`b z%T?E%AH`Xo&b2EG&ZvBHuH3GIWf|#}t6Ol?*E5BN>PX8fVU8NiPxl_;xfdxf0ycAq057lp(n^IB6?rFw@X^GEGg@MsPQZ|Re9;DY*v$32db=JqB8JK9MU+p=jy_k00VmKq4%xf zT9R2^lEru#X(9cAZ6H5pp}MNg+8%CY=3xJ5pk^ozYk0lhc(7={h*6%MOb=I5mG?rr zSl0pJj08g)u}%iq?y~*)OqrpStlo|cGG}(OB|;fJAl!Rh#*1j zOPyF$L6cKc3dr#N)Jd-7?JKpWDWQVryR(Q@<#l|Cr*-_$Z=SXyA3UV)5u6#MniAlD zWEm)uTaeubMp=_2H{`6F`%HpS^BBet>sjbsrZVQf#ni_8(wQXkUk1+}DlA6X9k%r* zP-!MsRE^EXv4k$(k>vev-LjaS0lsps2)SD6SC8^ek8fAaBIs6j${%qlG@elCkhDv6 zHhHBereTt7HaWI@{W9|JUXy3&(eYBSJKWZO{?>SyV6O)>Ju{O2S>JsKHayx~;gfHk z{JG>-`$tEEDht;LPsRR*yhwN(<0k(Tf3G(0#;L89cE!#w^ppotbN6F?%F25*rIjzK z#x0ER709;sbj~R#aUa_epZc88gC>vHVIW;W zOwi6j5=)|tFc0({q%S?3N*$`oj`#S|+@4XTC^jFfv0n}pcRC?CKlykB; zy~@5wL|p;@>FhT7n0dI;ZuR~C-G_`(yAhghhoo{HC{qfPsmFwl%!81{TV|KZv4``B zWo5Rr?*e?>P&q`iyi3jct#jeT2WhD$K4|*>8AV#({QX|=5u)RiiM~UrM@fhLPMzMS zEZTkO?!&os#eoqcr&1FojiBKO2Y=eMgKus1r`A%6zdf!kvgOW>05ttVr`GcM6`aFT z$J@A-SNfZ9{fkV-`{8-3eQ7~+;}5m`rJ>Rw`pdbLqq7NOrbgO+8so0=7_b*ljBIea}joK&d*#;EZ&T8p8! z=5fZ*GqXuw15WDm)D+^R8f~eJqrF%c(`sD=2Q#v`VI4U(BIa-;CLshL8B)OwQ|EHE zJ#9rY(uOD0^e2QskS-L2puFHIZOn{#H$t#$uZ;Q2aQSy0x;ujG0#9?|si5PsAUHkS z%vc+E&TP1X$MY%@b`_)G_A6Ryv)CUFH5f=?kh?@z5!tV)5mIofK#0KG@l$`%PPTq9d7&| z@e#kl4v|HTnopS{_shCq`J|(TeqaBP;ZPCQ6_Gyqx+eLXPR8lp`hab^X0?xPs_V6% z^$iSiscK!(LLNmKx1)0nT@Ya!a_Sc2C;5!RK<@h^6U3&BStPbt$sxuJlB=vR&`!7APTWrza8yTa^#|7!m5jU?T-3E!q*eIuk zv1-by0e@A=1#K{^BIbPOzY|#7eXm)y!6@eghXDY=?z}cexk#V2Ry{5hIEhfmuTG&q zfdS}}pOqUi^Pix?wgFmd9Y|q)&l@*cr|I&6fd&KLwlTpT4ff*sp}C(qnB<)2cMhP{pqXveOWoatBIYZMdM<~mrAet%+RLQO z{>F(#5)sfIn|pdI_{+;wV{OglrY<$o(n1lS9e6QnS>0x{tW+(W#vF=c27Qr|s&?R{ z&Y?=GE9qJN@gZnugW~7&@2W*Z7iP1eCCAkh({fLM8PH8Qymj;+xi}IvjT@%Iox|+f z#An`7gT?|QyLoL+d@?ul4j>oVFDto-q~UoJwE!O9!xe1BiAR^Fh=ri7mLJcw4w1D) zLf#?DG!B5^9UaL4>2pQlIPeaEMx6Lv1jI^`&?fT^$q#{>a4yb8dVtrwhn~ z?v8L8fQmndjy*3Pst27+Z_MHV>fxq7-BJ7~K0+(sUI_$0ZN;=?g;E7v1g8l=I`}c$^#?}!o?+Nz72pUo3X2od zfF`&dAurM%XTAnW7KGTHwL1MhNqz^3bt3r}n+;Q}wp!o-06D<%*n9}a0Wbj@r)-M* zCs42T_bQ91gk8GSE|HlM>`C>SJ$C9F-K_J@j{=!@2Pf=E`5KfRU(4uBR&(a;v0I}$ zHWBJuvDx@5b^YkVLYhrx(Ndy2HZtG_viorbi_fG&06vq{-j097|BI{>h{d`j^>Ke#aMy{S8sRLub6+u{D473 zL_EXduA?=W&P%+NiPDhR3sL;GyWtXm-fysC1@u+5R0HTG?bf=A9IqGl&Iio#SPrlu zV;C0aSxtAe{GZpdx@0Xs!wFoekO=g@+?2JD#XyT3+#4C_9Dqqyu41}t39)xS`xU9| z908R#>>QspZ+lQMJ~+iw3u?uPK^x(WujX_%BGT1fL;kUCD3DANHXX zDB50sdf%;6l34MV1YUK}i$I;T74_2>1K#t%WA73@^bCPW{d1U@T{vVINCrR3YH!vz z*FlT4`rS)@E4L6fHiZ@F9SXY$mm@S}R$b_LR50s@DYt)^Wx&Vdr9gMJ62n7`e!n}0v86YfRu&lNz0b7r9>?@j-nf0Xeet{TqORZITV&*y;(qm&&W2mE zq_}ELW>fAm(oED+Ha7Lx^!srtq77?novSe3D}j1vdE*uO;N`?OY8GG>X6?%pwu*bo ztBz`5i7m^P73Zn*Y7{NziVyX~N~**=nys_{5^1R6Mi_O>p2rwbbV)_VR%fN4!R)M3 zUHas;qTUa5xmdq$kK}Zc%DLj69wXuSYrp z<3u-~2f%}R`Tc@~k9Qxm{-vFfX{DC-Lw+(M;5x<>FS8H_79j37BN0s>iDn z!;dIl#9Mm_twy~|=#*Vr&s-ZGqg`|07t0SvZ#S?Xlh0GQXNaB@Y1mUbTl7}2veY!% zS70xpQ0}#AUeg&e{#;46!CrW&f0INk!kyE;D?d$Sy6yP?^GC#GHP438$*{!IxT)!b zX1P=CHW8*TX=Nw1q$qVyV_p)_y#)g5P}d~egmMY&pA(HvB@Ny-1%dU74-|+{2v747 zOOLCS$B%Z&KZr#&-kkYJ$gw7H-;(sKQYBb+KPi5H#jdaw*R1$lZL}p4Y2q_{hL5f& z(UH<8b<3NlT3}AO4pmFM8DYizSpK1|c$YKW>=&NO3bL&_Mjfq8+bw@T(@QL4D=+jj zYDA1w79d-_3t{w05E4H{HtIbG#WxAK+4MwE35(+ee?=1A@ zdA%es=ajx|H_{q0K-Z;6?wP(#fO$TPK`q|d@jh5Vy^dP_foF-=o#x+~H+bbDxgh9m zDC&YvRZdI&vEi>v@{d9A{xUQ{L7*cF+`EMO0Pmq^K3|psV%&39&?_g5l>i zqmVbYwVl<8dMxo^lxN@6XlLYRD;>AdC37teq(piHoHpzD)K_;l)G1%~{@)fZ_Zf$R z8lWV^)^0^Ojo`g_NyUElNQ0rb_nYjv{@EugPiW0o6)?3^vpt=jv>bTxP1WM7TNN~~ z_v1>mdVlkgIip#Y-h08jN*PQ(5Z+mc;oX&3ZW!@}aE9m%F~Jv&6|wU=QAcqdH?FqQYc-qp4w&vDOoOtPIVU{&3tB3D(BvpjigKsD-2IPw{4^}w_%Ci zQd1Q};^h;H#sPB=nW6!d!sE5Wf1n~iQ!opG(1PkwDfwY5rs~qWi#Zjeo@e9&+5;cW zs4pz3%FO3S1$zzA3v%Th5Yilzq-C&&K*4dA9A literal 5315 zcmds5c_3748#iQETs6v;w5cI&CVONr+t7?9%Dq%djIu;AOhuAP>RPi5Q;cI7OJr#% zg)|{C_N8vw8N%3y@0{Tl_g3Hc_veo@&w1YGywCf4pWpL)k0TYr!^ZmK7>*OXB|(#{ z^qRWtIwBwGom6+rO6)r7etN}pX_?F2O#<1iI;Oh&I)+RpD~2>KPc0k`HoLHUt3{TJ z04E3h4#tp{ADkCsY@_=ak@tjVVMu&W%JUb#!{j*BKlJ=cajuX5WN{32ZXrgL-W=W1 z5?%ZJ%1HI25kGlrubH*7+}KS#fm-T`=S-Cv*1Mn8&K}I9*w5%Dq7?p;3(&4Zm5vvk zc2LF`gti7cC&j*PPPHwIG3qu{rp^odMKt!7Zmt7Bryq2CrT|GKXEbA|+|*)w)66@^KRK#i?CN_qew{ENwLNKX z<0uSQ*B&B@Egr3VaI(4G?o( zBRPsHb1L*}HN&+UQeFkfFy8$sU&yO^T#_MjRez7FDnPC)v#CH}d>+P`V215q+K5&~ zc>I>^o*zFFm;U&;$#F(R^1NX-TDr|wHZlfruYa4IxnZz*_Jds;WzJeXlJD`riJ5i} z870*`o@t0_6r8g-q#>SRDM*p(Ewc#(e3(qnmp3w0C@9@mMQ4bSe*qUK>=WkBZjGCY zn4`5-!*SjAG&?sOV+>(){%%*Arr5~6*1|ivT6-PSFD*Xl_lmH|yjNUo4rCuuNC2EC zd$_3;;Kh!I!x}U)K2h@X*AUdwQy{}i!Jnhyjjkz z82dm%EX3~f{C3mok*oDH(Zh@=%{D&mWqJZ`a}Kn`={jd$^<8 zIG)&>Eav`DR%~#>Rt|%mRA0a*x0vb;P-gF(Y3hx=(%H|BSi8@07tt%0(hfY&;4wn3$;BiM4M%QNbmr&CjE%qN2M*?0AwqI2}NjJ6p>hJW!Szf`|(G(+ERU^Am} zFTG??ihl>;@Ko-ns`bgIBJi_AI2l{qmP1=%jA%i6$7n^pDmcsxdPH9ISvDANDO;(;!pPxmX?JY{Wi5Oqgp+@WUM=uW1ZiAd zc}Y$}(=NOux0{Vf#tXN&HE89~Ye>dL^f12*Q2Hj+%Z3;j+{h9%JOW|x`A*QiL2DE0h;+azg9l~y z56@Bzrsggj4#q=IV`|=uL3XzqSCSSFClK|99lBjL6~^TBH9lzp5<#d8&-Wu^4T8j8P|^WVZD7QbrQUt&U#h!1K!}i3eVYwFoX&%)YlvZk z8(V^gM<5%V*$KMgS}ZiHjCaH`Egl#G0X@3X0Aj^u42q$apEdLHsY5P-By{e8FlE*Xqn5J;d{UTB)AEW z;2el%>-~i5sYnh4tET;Y9EfQO=-w3oR#=N?mB9kG%Ci&$Aw)p&;L{L7$OaMW1Pbv% z2w6ibrvhSsP}Y^4`59GMG2J>M-|Bn4#36jWHDQ@5y2dx3xwd69tL&o5Y?AeGE_4bjvc}pm}Y(V$Q75xntD&N0xgJ=q~!J01Z(Oc0IM9>CeD>czPiJEX${(tPs z60KIze>IDt0lJ+~Yru>T@f~9iHx< z9KP3IUN99d>tL#ueUyFRMwb#ZKY0Df1N`jhjTGEM4cyc~lesW?!Bt~y+E5skaAJbd zH;~d9iJ$#E?V?EW84MCed1+kkD*H-~-40{OaNpcKtCcq{Rr(uYVIs0LVfypQK~T}X z5}DHvf=UoD&)PAonSh6Wvh0j7OAGlze_gzaApD~jq{_nkZO!6nD!iltk@qvTygVq{ zUB+oplnchf)}WC*^C95%DSbXDW({fJTDLx^u?`=ffnpjoxEn@_j9Ax$RXZ@D4kIBk z01=$;3(8Rn7_XnrE@j?(xn#dRgpXZ=LcIAs<(0;|( z3?tQIJ-3DEa}sXG)W?#l60@g~4qr34%zmt2D~SuL7`F%)dLPtW5c}nFcu*Qgmh}?q zEmm87Gk!!tDCV1j{D_PHCN9J_DLg1*>$dP=OgQf^G4g-wGB#vGY>%EgvUIR|o<2Fe zD^Q3XjpmWo)cu7aWwoq@EZKguRdcw6-NWQ>frPY?rIbGs$yFkD>k8WHzohzm6=0XY zILyWYL`i6F0Al&Juw;!L4YtO=^mC;GN9hL!3XPKzdlVE0L}faC8WZ=%=zy;OSByCe zp0%!p%IAgPzdS*ftAP6*taCja+6<7d+d|m#=J?(#pZw-rY5Z)@_J{KEOZS-l@%Nbn z_QTlQI0*BybA|C!+K-d6gjg&12bdqe z1}uRQe1S*o@r1ItKXzw9(ezX=I|tO z_VcA)uWpG_ZMt-WyoktcQCTxYPjXJVR=K5sHvL|M9;GD*=}9ji&+!llMenWcdpg#B zy4S7K*R&|=g6!p!CUwrcG1v%qYNmp(w|TA6m4m;jey(2I9IaD>IGsj>Q!2F(uKmL~ zJJc0VIc@8!+t^lYu$JI`fZ#pvnL6UtQ|)V2Nnr(Y|_dQuB;?O;M(Gu_L*k&uN-?LtI3v{o*mVb8>!n#~-SJ z0&Co>&zv&0#0@di)Gw%64;~=j?bI+u?a2caUEqL4p-XCu(Z(y>jrDlf7Q11Qg6e~j zt>?O1#Zx-BmkjZFjZKP4E&TpO)pJh8aPDGTKz!a#jU(e$gbS%YV!8R@eR~|>Cv&pR z7Rw4;6H{y(a{23t7FXSql(6CMyF2`fTrhP2vZWy39hqv?COVa}bNF`sV?_*3d=F#b zthaYUNlyL1iN144yo3AwFCVFlewyeyVdbmb!5QklwRG`>=#(1;YquqZq**)Dk^Ijr zyP*#a7J=d;g^D3H#xGoIY-mT?9Y%irZQ;02(?z9*R+o1dH{YFNs(m%jv@&jx^`nB{ z7HAZ6B?Ss*Z(N>q<<21^PqY_~7!fDwqR?{HFki8yA5FuySH)B-#MHE0E%C~EVAAbz zoE|r}x7<9?c|60`2~bK7%`(`dye;Nfl5K3%A1=8X;+ssnW7~4bUe=_>r+&@Pa%Qak zH4c8X^-j6rMJ_Fs_s*iZ0R-1s3bv*1NdZEF(%f4TZP4qvk=TjN>~mMq@ULRfsAu>_8Td5yq8|;_R{O@xv{UrChdjZo+*7x`gFN3Lv|t8%XRDwwaJ{B zVdd$*&4w}NtT+$zw7E3$XZ6C-xOb%;@zdefv&o-l>FpzMbE8OC^U|x~@`bN`n9kH4 z{b%R$JF}hyaCcB6*v>Ui*a9wpw0^< zxA7}Qn0A=U`J{CEsTin_#4-KC5sIpF*bC?695<%(nd{DZq9^c5gx)A@qEDx8v z`El=Jw^2${0}$6~JF@|qXKGng1q=|cj*`JjTr$r=8-lA`Gku7nng>32~jO{<*2jn#X From 37eb6871e7dcc292d62f763653e5604fe2ff0b56 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 9 Nov 2023 17:42:06 -0800 Subject: [PATCH 38/39] Fix syntax issues --- R/angles.R | 10 +++++----- tests/testthat/test-angles.R | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/angles.R b/R/angles.R index 83d433c..939e51a 100644 --- a/R/angles.R +++ b/R/angles.R @@ -18,8 +18,8 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; num.children <- length(child.ids); - if (length(child.ids) > 0) { - parent.angle <- parent.angle <- tree$angle[tree$tip == current.node.id]; + if (num.children > 0) { + parent.angle <- tree$angle[tree$tip == current.node.id]; child.weight <- assign.weight(current.node.id, v); start.angle <- parent.angle - (total.angle) * (num.children > 1) / 2; @@ -49,15 +49,15 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { node.ids <- node.ids[-1]; child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]; - - if (length(child.ids) > 0) { + num.children <- length(child.ids); + if (num.children > 0) { # Safe to hardcode temporarily. This will only ever apply to # cases with 0, 1, or 2 children. 3+ will use radial calculation. # 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 (length(child.ids) == 1) c(0) else c(-1, 1) * fixed.angle; + child.angles <- if (num.children == 1) c(0) else c(-1, 1) * fixed.angle; for (i in seq_along(child.ids)) { child.id <- child.ids[i]; diff --git a/tests/testthat/test-angles.R b/tests/testthat/test-angles.R index 7c057ba..f96ed88 100644 --- a/tests/testthat/test-angles.R +++ b/tests/testthat/test-angles.R @@ -141,7 +141,7 @@ test_that( result <- calculate.angles.fixed( test.v, test.tree, - fixed.angle <- angle + fixed.angle = angle ); expected.result <- c(0, -(angle), angle); From 986c581069ff2a7bd99a605f95907673355ea522 Mon Sep 17 00:00:00 2001 From: Dan Knight Date: Thu, 9 Nov 2023 17:47:13 -0800 Subject: [PATCH 39/39] Add comments to clarify tree traversal queue code --- R/angles.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/angles.R b/R/angles.R index 939e51a..8602aa2 100644 --- a/R/angles.R +++ b/R/angles.R @@ -6,6 +6,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { angles <- numeric(nrow(tree)); while (length(node.ids) > 0) { + # "Pops" next element in FIFO queue node.ids current.node.id <- node.ids[1]; node.ids <- node.ids[-1]; @@ -32,6 +33,7 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) { angles[tree$tip == child.id] <- angle; } + # Appending to end of queue for breadth-first traversal node.ids <- append(node.ids, child.ids); } } @@ -45,6 +47,7 @@ calculate.angles.fixed <- function(v, tree, fixed.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]; node.ids <- node.ids[-1]; @@ -66,6 +69,7 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) { } } + # Appending to end of queue for breadth-first traversal node.ids <- append(node.ids, child.ids); }