@@ -1,5 +1,8 @@

 # Bradley Jones

+

++ `ggdensitree` function

+  - <https://github.com/YuLab-SMU/ggtree/pull/253>

 + made data usable with treedata in 'equal_angle' and 'daylight' layouts 

   - <https://github.com/GuangchuangYu/ggtree/pull/201>

@@ -1,7 +1,7 @@

 Package: ggtree

 Type: Package

 Title: an R package for visualization of tree and annotation data

-Version: 1.99.0

+Version: 1.99.1

 Authors@R: c(

 	   person("Guangchuang", "Yu",     email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6485-8781")),

 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com",   role = c("aut", "ths")),

@@ -1,3 +1,8 @@

+# ggtree 1.99.1

+

++ `ggdensitree` (2019-09-11, Wed)

+  - <https://github.com/YuLab-SMU/ggtree/pull/253>

+  

 # ggtree 1.99.0

 + prepare for ggtree v=2.0.0

@@ -4,6 +4,7 @@

 ##' @param data a list of phylo objects or any object with an as.phylo and fortify method

 ##' @param mapping aesthetic mapping

 ##' @param layout one of 'slanted', 'rectangluar', 'fan', 'circular' or 'radial' (default: 'slanted')

+##' @param branch.length variable to be used to scale branch length. Setting to 'branch.length' will use the branch lengths of the tree objects. Default is 'none' to discard branch length and only plot cladogram (more reasonable for densitree).

 ##' @param tip.order the order of the tips by a character vector of taxa names; or an integer, N, to order the tips by the order of the tips in the Nth tree; or 'mds' to order the tips based on MDS of the distance between the tips (default: 'mds')

 ##' @param dangle TRUE to align trees by their tips and FALSE to align treesby their root (default: TRUE)

 ##' @param jitter deviation to jitter tips

@@ -17,106 +18,77 @@

 ##' require(ape)

 ##' require(dplyr)

 ##' library(ape)

-##' library(tidyverse)

 ##' 

 ##' trees <- list(read.tree(text="((a,b),c);"), read.tree(text="((a,c),b);"));

 ##' ggdensitree(trees) + geom_tiplab()

 ##' 

 ##' trees.fort <- list(trees[[1]] %>% fortify %>% mutate(tree="a"), trees[[2]] %>% fortify %>% mutate(tree="b"));

 ##' ggdensitree(trees.fort, aes(colour=tree)) + geom_tiplab(colour='black')

-ggdensitree <- function(data=NULL, mapping=NULL, layout="slanted", tip.order='mds', dangle=TRUE, jitter=0, ...) {

-	# factorize to simplify code

-	trees <- lapply(data, as.phylo)

-	trees.f <- lapply(data, fortify, layout=layout, ...)

-	n.tips <- sum(trees.f[[1]]$isTip)

-	

-	# determine tip order

-	if (length(tip.order) == 1) {

-		if (tip.order == 'mds') {

-			first.label <- subset(trees.f[[1]], isTip)$label

-			

-			tip.order <- lapply(trees, . %$% tip.label %>% match(first.label))

-			

-			tip.2.tip <- lapply(trees, cophenetic.phylo.check.length)

-			tip.2.tip <- lapply(1:length(trees), function(i) tip.2.tip[[i]][tip.order[[i]], tip.order[[i]]])

-			

-			all.tab <- do.call(rbind, tip.2.tip)

-			rownames(all.tab) <- NULL

-			

-			distances <- dist(t(all.tab))

-			

-			res <- cmdscale(distances, k=1)

-			

-			tip.order <- first.label[order(res[,1])]

-		} else if (as.numeric(tip.order) && tip.order <= length(trees)) {

-			labels <- subset(trees.f[[tip.order]], isTip)$label

+ggdensitree <- function(data=NULL, mapping=NULL, layout="slanted", branch.length = "none",

+                        tip.order='mds', dangle=TRUE, jitter=0, ...) {

+    ## factorize to simplify code

+    trees <- lapply(data, as.phylo)

+    trees.f <- lapply(data, fortify, layout=layout, branch.length = branch.length, ...)

+    n.tips <- sum(trees.f[[1]]$isTip)

+

+    ## determine tip order

+    if (length(tip.order) == 1) {

+        if (tip.order == 'mds') {

+            first.label <- trees.f[[1]] %>%

+                dplyr::filter(.data$isTip) %>%

+                dplyr::pull(.data$label)

+            

+            tip.order <- lapply(trees, function(x) {

+                match(x$tip.label, first.label)

+            })

+            

+            tip.2.tip <- lapply(trees, cophenetic.phylo.check.length)

+            tip.2.tip <- lapply(1:length(trees), function(i) {

+                tip.2.tip[[i]][tip.order[[i]], tip.order[[i]]]

+            })

+            

+            all.tab <- do.call(rbind, tip.2.tip)

+            rownames(all.tab) <- NULL

+            

+            distances <- stats::dist(t(all.tab))

+            

+            res <- stats::cmdscale(distances, k=1)

-			tip.order <- labels[as.integer(trees.f[[tip.order]]$y)]

-		}

-	}

+            tip.order <- first.label[order(res[,1])]

+        } else if (as.numeric(tip.order) && tip.order <= length(trees)) {

+            labels <- trees.f[[tip.order]] %>%

+                dplyr::filter(.data$isTip) %>%

+                dplyr::pull(.data$label)

+            

+            tip.order <- labels[as.integer(trees.f[[tip.order]]$y)]

+        }

+    }

-	# reorder tips (and shift x id dangling)

+    ## reorder tips (and shift x id dangling)

+    max.x <- vapply(trees.f, function(x) max(x$x, na.rm = TRUE), numeric(1))

+    farthest <- max(max.x)

     trees.f <- lapply(1:length(trees), function(i) {

-    	trees.f[[i]]$y <- getYcoord_order(trees[[i]], tip.order)

-    	if (i > 1) {

-    		trees.f[[i]]$y[1:n.tips] %<>% add(rnorm(n.tips, mean=0, sd=jitter))

-    		if (dangle)

-   	    		trees.f[[i]]$x <- trees.f[[1]]$x[1] - trees.f[[i]]$x[match(trees.f[[1]]$label, trees.f[[i]]$label)][1] + trees.f[[i]]$x

-    	}

-    	trees.f[[i]]

+        trees.f[[i]]$y <- getYcoord(trees[[i]], tip.order = tip.order)

+        if (dangle) {

+            trees.f[[i]]$x <- trees.f[[i]]$x + (farthest - max.x[i])

+        }

+        if (i > 1 && jitter > 0) {

+            trees.f[[i]]$y[1:n.tips] %<>% add(stats::rnorm(n.tips, mean=0, sd=jitter))

+        }

+        trees.f[[i]]

     })

-	

-    # plot all trees together

-	p <- ggtree(tr=trees.f[[1]], mapping=mapping, layout=layout, ...)

-	for (x in trees.f[-1])

-		p <- p + geom_tree(mapping=mapping, data=x, layout=layout, ...)

-	p

+    

+    ## plot all trees together

+    p <- ggtree(tr=trees.f[[1]], mapping=mapping, layout=layout, ...)

+    for (x in trees.f[-1])

+        p <- p + geom_tree(mapping=mapping, data=x, layout=layout, ...)

+    p

 }

 ## wrapper for cohpenetic to ensure that branch lengths exist

 cophenetic.phylo.check.length <- function(tree) {

-	if (is.null(tree$edge.length))

-		tree$edge.length <- rep(1, nrow(tree$edge))

-	

-	cophenetic(tree)

-}

-

-## this is an adaptation of old code in ggtree

-## 

-##' @importFrom magrittr %>%

-##' @importFrom magrittr equals

-getYcoord_order <- function(tr, tip.order) {

-    Ntip <- length(tr[["tip.label"]])

-    N <- getNodeNum(tr)

-

-    edge <- tr[["edge"]]

-    parent <- edge[,1]

-    child <- edge[,2]

-

-    cl <- split(child, parent)

-    child_list <- list()

-    child_list[as.numeric(names(cl))] <- cl

-

-    y <- numeric(N)

-    y[1:Ntip] <- match(tr$tip.label, tip.order)

-    y[-(1:Ntip)] <- NA

-

-    pvec <- integer(max(tr$edge))

-    pvec[child] = parent

-

-    currentNode <- 1:Ntip

-    while(anyNA(y)) {

-        pNode <- unique(pvec[currentNode])

-

-        idx <- sapply(pNode, function(i) all(child_list[[i]] %in% currentNode))

-        newNode <- pNode[idx]

-

-        y[newNode] <- sapply(newNode, function(i) {

-            mean(y[child_list[[i]]], na.rm=TRUE)

-        })

-

-        currentNode <- c(currentNode[!currentNode %in% unlist(child_list[newNode])], newNode)

-    }

-

-    return(y)

+    if (is.null(tree$edge.length))

+        tree$edge.length <- rep(1, nrow(tree$edge))

+    

+    stats::cophenetic(tree)

 }

@@ -876,7 +876,7 @@ getXcoord <- function(tr) {

 ## @importFrom magrittr %>%

 ##' @importFrom magrittr equals

-getYcoord <- function(tr, step=1) {

+getYcoord <- function(tr, step=1, tip.order = NULL) {

     Ntip <- length(tr[["tip.label"]])

     N <- getNodeNum(tr)

@@ -889,9 +889,15 @@ getYcoord <- function(tr, step=1) {

     child_list[as.numeric(names(cl))] <- cl

     y <- numeric(N)

-    tip.idx <- child[child <= Ntip]

-    y[tip.idx] <- 1:Ntip * step

+    if (is.null(tip.order)) {

+        tip.idx <- child[child <= Ntip]

+        y[tip.idx] <- 1:Ntip * step

+    } else {

+        tip.idx <- 1:Ntip

+        y[tip.idx] <- match(tr$tip.label, tip.order) * step

+    }

     y[-tip.idx] <- NA

+    

     ## use lookup table

     pvec <- integer(max(tr$edge))

@@ -5,7 +5,8 @@

 \title{ggdensitree}

 \usage{

 ggdensitree(data = NULL, mapping = NULL, layout = "slanted",

-  tip.order = "mds", dangle = TRUE, jitter = 0, ...)

+  branch.length = "none", tip.order = "mds", dangle = TRUE,

+  jitter = 0, ...)

 }

 \arguments{

 \item{data}{a list of phylo objects or any object with an as.phylo and fortify method}

@@ -14,6 +15,8 @@ ggdensitree(data = NULL, mapping = NULL, layout = "slanted",

 \item{layout}{one of 'slanted', 'rectangluar', 'fan', 'circular' or 'radial' (default: 'slanted')}

+\item{branch.length}{variable to be used to scale branch length. Setting to 'branch.length' will use the branch lengths of the tree objects. Default is 'none' to discard branch length and only plot cladogram (more reasonable for densitree).}

+

 \item{tip.order}{the order of the tips by a character vector of taxa names; or an integer, N, to order the tips by the order of the tips in the Nth tree; or 'mds' to order the tips based on MDS of the distance between the tips (default: 'mds')}

 \item{dangle}{TRUE to align trees by their tips and FALSE to align treesby their root (default: TRUE)}

@@ -32,7 +35,6 @@ drawing phylogenetic trees from list of phylo objects

 require(ape)

 require(dplyr)

 library(ape)

-library(tidyverse)

 trees <- list(read.tree(text="((a,b),c);"), read.tree(text="((a,c),b);"));

 ggdensitree(trees) + geom_tiplab()