From 2289044788c31588f5025fcbea6f36b2e257df0f Mon Sep 17 00:00:00 2001 From: Brad Jones Date: Mon, 15 Jun 2026 15:34:31 -0700 Subject: [PATCH 1/3] add tidy layout --- R/geom_tree.R | 4 +- R/ggtree.R | 2 +- R/method-fortify.R | 6 +- R/tree-utilities.R | 191 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 199 insertions(+), 4 deletions(-) diff --git a/R/geom_tree.R b/R/geom_tree.R index 954d7a5..03168ce 100644 --- a/R/geom_tree.R +++ b/R/geom_tree.R @@ -5,7 +5,7 @@ ##' @param mapping aesthetic mapping ##' @param data data of the tree ##' @param layout one of 'rectangular', 'dendrogram', 'slanted', 'ellipse', 'roundrect', -##' 'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight', 'tree_and_leaf' or 'ape' +##' 'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight', 'tree_and_leaf', 'ape' or 'tidy' ##' @param multiPhylo logical, whether input data contains multiple phylo class, defaults to "FALSE". ##' @param continuous character, continuous transition for selected aesthetic ('size' ##' or 'color'('colour')). It should be one of 'color' (or 'colour'), 'size', 'all' @@ -71,7 +71,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom=GeomInteractiveSegment, posi rootnode <- FALSE } - layout_rectangular <- c("rectangular", "dendrogram", "fan", "circular", "inward_circular") + layout_rectangular <- c("rectangular", "dendrogram", "fan", "circular", "inward_circular", 'tidy') layout_slanted <- c("slanted", "radial", "equal_angle", "daylight", "tree_and_leaf", "ape") layout_ellipse <- c("ellipse", "roundrect") diff --git a/R/ggtree.R b/R/ggtree.R index ff7a2c4..772752c 100644 --- a/R/ggtree.R +++ b/R/ggtree.R @@ -73,7 +73,7 @@ ggtree <- function(tr, expr = { layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", 'inward_circular', "radial", "unrooted", "equal_angle", "daylight", "tree_and_leaf", "dendrogram", - "ape", "ellipse", "roundrect")) + "ape", "ellipse", "roundrect", "tidy")) } ) diff --git a/R/method-fortify.R b/R/method-fortify.R index edaa35d..6584f91 100644 --- a/R/method-fortify.R +++ b/R/method-fortify.R @@ -32,7 +32,8 @@ fortify.phylo <- function(model, data, if (layout %in% c("equal_angle", "daylight", "ape", "tree_and_leaf")) { res <- layout.unrooted(model, layout.method = layout, branch.length = branch.length, ...) } else { - ypos <- getYcoord(x) + if (layout != "tidy") + ypos <- getYcoord(x) N <- Nnode(x, internal.only=FALSE) if (is.null(x$edge.length) || branch.length == "none") { if (layout == 'slanted'){ @@ -45,6 +46,9 @@ fortify.phylo <- function(model, data, } else { xpos <- getXcoord(x) } + + if (layout == "tidy") + ypos <- getYcoord_tidy(x, xpos) xypos <- tibble::tibble(node=1:N, x=xpos + root.position, y=ypos) diff --git a/R/tree-utilities.R b/R/tree-utilities.R index a4650ea..2a73c5d 100644 --- a/R/tree-utilities.R +++ b/R/tree-utilities.R @@ -1138,7 +1138,198 @@ getXcoord <- function(tr) { ## return(res) ## } +tidy_positionRoot <- function(node, ch, nch, coords.env) { + coords.env$prelim[node] <- (coords.env$prelim[ch[1]] + coords.env$mod[ch[1]] + + coords.env$prelim[ch[nch]] + coords.env$mod[ch[nch]] + + coords.env$w[ch[nch]]) / 2 - + coords.env$w[node] / 2 +} + +tidy_moveSubtree <- function(ch, i, dist, coords.env) { + coords.env$mod[ch[i]] <- coords.env$mod[ch[i]] + dist + coords.env$msel[ch[i]] <- coords.env$msel[ch[i]] + dist + coords.env$mser[ch[i]] <- coords.env$mser[ch[i]] + dist + + # distributeExtra + # si <- as.integer(names(ih)[1]) + # if (!is.na(si) && si != i-1) { + # nr <- i - si + # coords.env$shift[si + 1] <- coords.env$shift[si + 1] + dist / nr + # coords.env$shift[i] <- coords.env$shift[i] - dist / nr + # coords.env$change[i] <- coords.env$change[i] - dist / nr + # } + # end distributeExtra +} + +tidy_nextLeftContour <- function(node, coords.env) { + nc <- length(coords.env$edge[node == coords.env$edge[,1], 2]) + ifelse( + nc == 0, + coords.env$tl[node], + coords.env$edge[node == coords.env$edge[,1], 2][1] + ) +} + +tidy_nextRightContour <- function(node, coords.env) { + nc <- length(coords.env$edge[node == coords.env$edge[,1], 2]) + ifelse( + nc == 0, + coords.env$tr[node], + coords.env$edge[node == coords.env$edge[,1], 2][nc] + ) +} + +tidy_setLeftThread <- function(ch, i, cl, modsumcl, coords.env) { + li <- coords.env$el[ch[1]] + coords.env$tl[li] <- cl + diff <- modsumcl - coords.env$mod[cl] - coords.env$msel[ch[1]] + coords.env$mod[li] <- coords.env$mod[li] + diff + coords.env$prelim[li] <- coords.env$prelim[li] - diff + coords.env$el[ch[1]] <- coords.env$el[ch[i]] + coords.env$msel[ch[1]] <- coords.env$msel[ch[i]] +} + +tidy_setRightThread <- function(ch, i, sr, modsumsr, coords.env) { + ri <- coords.env$er[ch[i]] + coords.env$tr[ri] <- sr + diff <- modsumsr - coords.env$mod[sr] - coords.env$mser[ch[i]] + coords.env$mod[ri] <- coords.env$mod[ri] + diff + coords.env$prelim[ri] <- coords.env$prelim[ri] - diff + coords.env$er[ch[i]] <- coords.env$er[ch[i-1]] + coords.env$mser[ch[i]] <- coords.env$mser[ch[i-1]] +} + +tidy_separate <- function(ch, i, coords.env) { + sr <- ch[i - 1]; + mssr <- coords.env$mod[sr] + cl <- ch[i]; + mscl <- coords.env$mod[cl] + + while (!is.na(sr) && !is.na(cl)) { + # if (length(ih) > 0 && bottom(sr, coords.env) > ih[1]) ih <- ih[-1] + dist <- mssr + coords.env$prelim[sr] + coords.env$w[sr] - (mscl + coords.env$prelim[cl]) + + if (dist > 0) { + mscl <- mscl + dist + + tidy_moveSubtree(ch, i, dist, coords.env) + } + + sy <- coords.env$y[sr] + cy <- coords.env$y[cl] + + if (sy <= cy) { + sr <- tidy_nextRightContour(sr, coords.env) + + if (!is.na(sr)) mssr <- mssr + coords.env$mod[sr] + } + + if (sy >= cy) { + cl <- tidy_nextLeftContour(cl, coords.env) + + if (!is.na(cl)) mscl <- mscl + coords.env$mod[cl] + } + } + + if (is.na(sr) && !is.na(cl)) { + tidy_setLeftThread(ch, i, cl, mscl, coords.env) + } else if (!is.na(sr) && is.na(cl)) { + tidy_setRightThread(ch, i, sr, mssr, coords.env) + } +} + +tidy_first_walk <- function(node, coords.env) { + ch <- coords.env$edge[node == coords.env$edge[,1], 2] + nch <- length(ch) + + if (nch == 0) { + # setExtremes + coords.env$el[node] <- node + coords.env$er[node] <- node + coords.env$msel[node] <- 0 + coords.env$mser[node] <- 0 + # end setExtremes + + return() + } + + tidy_first_walk(ch[1], coords.env) + +# ih <- c("1"=bottom(ch[1], coords.env)) + + for (i in seq_along(ch)[-1]) { + tidy_first_walk(ch[i], coords.env) + + minY <- coords.env$y[coords.env$er[ch[i]]] + + tidy_separate(ch, i, coords.env) + + # updateIYL +# while (length(ih) > 0 && minY > ih[1]) ih <- ih[-1] +# ih <- c(i=minY, ih) +# names(ih)[1] <- as.character(i) + # end updateIYL + } + + tidy_positionRoot(node, ch, nch, coords.env) + + # setExtremes + coords.env$el[node] <- coords.env$el[ch[1]] + coords.env$msel[node] <- coords.env$msel[ch[1]] + coords.env$er[node] <- coords.env$er[ch[nch]] + coords.env$mser[node] <- coords.env$mser[ch[nch]] + # end setExtremes +} +tidy_second_walk <- function(node, modsum, coords.env) { + ch <- coords.env$edge[node == coords.env$edge[,1], 2] + + modsum <- modsum + coords.env$mod[node] + coords.env$x[node] <- coords.env$prelim[node] + modsum + + # addChildSpacing +# d <- 0 +# modsumdelta <- 0 +# for (child in ch) { +# d <- d + coords.env$shift[child] +# modsumdelta <- modsumdelta + d + coords.env$change[child] +# coords.env$mod[child] <- coords.env$mod[child] + modsumdelta +# } + # end addChildSpacing + + for (child in ch) { + tidy_second_walk(child, modsum, coords.env) + } +} + +# from Ploeg (2014) Softw. Pract. Exper. 44:1467–1484 +##' @import from rlang env +getYcoord_tidy <- function(tr, x, step=1) { + Ntip <- length(tr$tip.label) + N <- ggtree:::getNodeNum(tr) + root <- ggtree:::getRoot(tr) + + # environment/output for recursive functions + # x and y are swapped + coords.env <- env( + edge = tr$edge, + w = rep(step, N), + y = x, + # outputs + # set these to 0? + prelim = rep(0, N), mod = rep(0, N), # shift = rep(0, N), change = rep(0, N), + x = rep(NA, N), + tl = rep(NA, N), tr = rep(NA, N), + el = rep(NA, N), er = rep(NA, N), + msel = rep(NA, N), mser = rep(NA, N) + ) + + tidy_first_walk(root, coords.env) + tidy_second_walk(root, 0, coords.env) + + # x and y are swapped + return(coords.env$x) +} ## @importFrom magrittr %>% ##' @importFrom magrittr equals From fb9ae2f029fc075bf876ad73e37a5ce5c1ca4df1 Mon Sep 17 00:00:00 2001 From: Brad Jones Date: Mon, 15 Jun 2026 15:42:05 -0700 Subject: [PATCH 2/3] imports for tidy layout --- NAMESPACE | 1 + R/tree-utilities.R | 2 +- man/geom_tree.Rd | 2 +- man/ggtree.Rd | 2 +- 4 files changed, 4 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 25a7a3e..a95ff5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -308,6 +308,7 @@ importFrom(rlang,.data) importFrom(rlang,abort) importFrom(rlang,as_name) importFrom(rlang,check_installed) +importFrom(rlang,env) importFrom(rlang,new_quosure) importFrom(rlang,parse_expr) importFrom(rlang,quo) diff --git a/R/tree-utilities.R b/R/tree-utilities.R index 2a73c5d..f3fa024 100644 --- a/R/tree-utilities.R +++ b/R/tree-utilities.R @@ -1303,7 +1303,7 @@ tidy_second_walk <- function(node, modsum, coords.env) { } # from Ploeg (2014) Softw. Pract. Exper. 44:1467–1484 -##' @import from rlang env +##' @importFrom rlang env getYcoord_tidy <- function(tr, x, step=1) { Ntip <- length(tr$tip.label) N <- ggtree:::getNodeNum(tr) diff --git a/man/geom_tree.Rd b/man/geom_tree.Rd index df66fb3..9ea533e 100644 --- a/man/geom_tree.Rd +++ b/man/geom_tree.Rd @@ -20,7 +20,7 @@ geom_tree( \item{data}{data of the tree} \item{layout}{one of 'rectangular', 'dendrogram', 'slanted', 'ellipse', 'roundrect', -'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight', 'tree_and_leaf' or 'ape'} +'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight', 'tree_and_leaf', 'ape' or 'tidy'} \item{multiPhylo}{logical, whether input data contains multiple phylo class, defaults to "FALSE".} diff --git a/man/ggtree.Rd b/man/ggtree.Rd index e69f71e..2ae819d 100644 --- a/man/ggtree.Rd +++ b/man/ggtree.Rd @@ -29,7 +29,7 @@ ggtree( \item{mapping}{aesthetic mapping} \item{layout}{one of 'rectangular', 'dendrogram', 'slanted', 'ellipse', 'roundrect', -'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight', 'tree_and_leaf' or 'ape'} +'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight', 'tree_and_leaf', 'ape' or 'tidy'} \item{open.angle}{open angle, only for 'fan' layout} From 454a4dca3d823b3187a93d6885a59ae5d09522e5 Mon Sep 17 00:00:00 2001 From: Brad Jones Date: Thu, 2 Jul 2026 09:28:43 -0700 Subject: [PATCH 3/3] added padding to tips to make sure they don't get hidden --- R/tree-utilities.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/tree-utilities.R b/R/tree-utilities.R index f3fa024..29fbf0d 100644 --- a/R/tree-utilities.R +++ b/R/tree-utilities.R @@ -1304,7 +1304,7 @@ tidy_second_walk <- function(node, modsum, coords.env) { # from Ploeg (2014) Softw. Pract. Exper. 44:1467–1484 ##' @importFrom rlang env -getYcoord_tidy <- function(tr, x, step=1) { +getYcoord_tidy <- function(tr, x, step=1, extra.tip.padding = 0.01) { Ntip <- length(tr$tip.label) N <- ggtree:::getNodeNum(tr) root <- ggtree:::getRoot(tr) @@ -1314,9 +1314,8 @@ getYcoord_tidy <- function(tr, x, step=1) { coords.env <- env( edge = tr$edge, w = rep(step, N), - y = x, + y = x + c(rep(max(x) * extra.tip.padding, Ntip), rep(0, N - Ntip)), # outputs - # set these to 0? prelim = rep(0, N), mod = rep(0, N), # shift = rep(0, N), change = rep(0, N), x = rep(NA, N), tl = rep(NA, N), tr = rep(NA, N),