1. ggtree
  2. Commit 3002ff9654ada93e7f312faed244efdc65bbf542
Browse code

Merge pull request #253 from brj1/master

Added ggdensitree method

Guangchuang Yu authored on 11/09/2019 00:34:33 • GitHub committed on 11/09/2019 00:34:33
Showing3 changed files
NAMESPACE
History View file @3002ff96
... ... 
@@ -88,6 +88,7 @@ export(get.path)
88 88 
 export(get_clade_position)
89 89 
 export(get_heatmap_column_position)
90 90 
 export(get_taxa_name)
91 
+export(ggdensitree)
91 92 
 export(ggplot)
92 93 
 export(ggsave)
93 94 
 export(ggtree)
... ... 
@@ -223,6 +224,7 @@ importFrom(grid,unit)
223 224 
 importFrom(grid,viewport)
224 225 
 importFrom(magrittr,"%<>%")
225 226 
 importFrom(magrittr,"%>%")
227 
+importFrom(magrittr,add)
226 228 
 importFrom(magrittr,equals)
227 229 
 importFrom(methods,is)
228 230 
 importFrom(methods,missingArg)
R/ggdensitree.R
History View file @3002ff96
229 231 
new file mode 100644
... ... 
@@ -0,0 +1,122 @@
1 
+##' drawing phylogenetic trees from list of phylo objects
2 
+##'
3 
+##' @title ggdensitree
4 
+##' @param data a list of phylo objects or any object with an as.phylo and fortify method
5 
+##' @param mapping aesthetic mapping
6 
+##' @param layout one of 'slanted', 'rectangluar', 'fan', 'circular' or 'radial' (default: 'slanted')
7 
+##' @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')
8 
+##' @param dangle TRUE to align trees by their tips and FALSE to align treesby their root (default: TRUE)
9 
+##' @param jitter deviation to jitter tips
10 
+##' @param ... additional parameters passed to fortify, ggtree and geom_tree
11 
+##' @return tree layer
12 
+##' @importFrom magrittr %<>%
13 
+##' @importFrom magrittr add
14 
+##' @export
15 
+##' @author Yu Guangchuang, Bradley R. Jones
16 
+##' @examples
17 
+##' require(ape)
18 
+##' require(dplyr)
19 
+##' library(ape)
20 
+##' library(tidyverse)
21 
+##'
22 
+##' trees <- list(read.tree(text="((a,b),c);"), read.tree(text="((a,c),b);"));
23 
+##' ggdensitree(trees) + geom_tiplab()
24 
+##'
25 
+##' trees.fort <- list(trees[[1]] %>% fortify %>% mutate(tree="a"), trees[[2]] %>% fortify %>% mutate(tree="b"));
26 
+##' ggdensitree(trees.fort, aes(colour=tree)) + geom_tiplab(colour='black')
27 
+ggdensitree <- function(data=NULL, mapping=NULL, layout="slanted", tip.order='mds', dangle=TRUE, jitter=0, ...) {
28 
+	# factorize to simplify code
29 
+	trees <- lapply(data, as.phylo)
30 
+	trees.f <- lapply(data, fortify, layout=layout, ...)
31 
+	n.tips <- sum(trees.f[[1]]$isTip)
32 
+
33 
+	# determine tip order
34 
+	if (length(tip.order) == 1) {
35 
+		if (tip.order == 'mds') {
36 
+			first.label <- subset(trees.f[[1]], isTip)$label
37 
+
38 
+			tip.order <- lapply(trees, . %$% tip.label %>% match(first.label))
39 
+
40 
+			tip.2.tip <- lapply(trees, cophenetic.phylo.check.length)
41 
+			tip.2.tip <- lapply(1:length(trees), function(i) tip.2.tip[[i]][tip.order[[i]], tip.order[[i]]])
42 
+
43 
+			all.tab <- do.call(rbind, tip.2.tip)
44 
+			rownames(all.tab) <- NULL
45 
+
46 
+			distances <- dist(t(all.tab))
47 
+
48 
+			res <- cmdscale(distances, k=1)
49 
+
50 
+			tip.order <- first.label[order(res[,1])]
51 
+		} else if (as.numeric(tip.order) && tip.order <= length(trees)) {
52 
+			labels <- subset(trees.f[[tip.order]], isTip)$label
53 
+
54 
+			tip.order <- labels[as.integer(trees.f[[tip.order]]$y)]
55 
+		}
56 
+	}
57 
+
58 
+	# reorder tips (and shift x id dangling)
59 
+    trees.f <- lapply(1:length(trees), function(i) {
60 
+    	trees.f[[i]]$y <- getYcoord_order(trees[[i]], tip.order)
61 
+    	if (i > 1) {
62 
+    		trees.f[[i]]$y[1:n.tips] %<>% add(rnorm(n.tips, mean=0, sd=jitter))
63 
+    		if (dangle)
64 
+   	    		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
65 
+    	}
66 
+    	trees.f[[i]]
67 
+    })
68 
+
69 
+    # plot all trees together
70 
+	p <- ggtree(tr=trees.f[[1]], mapping=mapping, layout=layout, ...)
71 
+	for (x in trees.f[-1])
72 
+		p <- p + geom_tree(mapping=mapping, data=x, layout=layout, ...)
73 
+	p
74 
+}
75 
+
76 
+## wrapper for cohpenetic to ensure that branch lengths exist
77 
+cophenetic.phylo.check.length <- function(tree) {
78 
+	if (is.null(tree$edge.length))
79 
+		tree$edge.length <- rep(1, nrow(tree$edge))
80 
+
81 
+	cophenetic(tree)
82 
+}
83 
+
84 
+## this is an adaptation of old code in ggtree
85 
+##
86 
+##' @importFrom magrittr %>%
87 
+##' @importFrom magrittr equals
88 
+getYcoord_order <- function(tr, tip.order) {
89 
+    Ntip <- length(tr[["tip.label"]])
90 
+    N <- getNodeNum(tr)
91 
+
92 
+    edge <- tr[["edge"]]
93 
+    parent <- edge[,1]
94 
+    child <- edge[,2]
95 
+
96 
+    cl <- split(child, parent)
97 
+    child_list <- list()
98 
+    child_list[as.numeric(names(cl))] <- cl
99 
+
100 
+    y <- numeric(N)
101 
+    y[1:Ntip] <- match(tr$tip.label, tip.order)
102 
+    y[-(1:Ntip)] <- NA
103 
+
104 
+    pvec <- integer(max(tr$edge))
105 
+    pvec[child] = parent
106 
+
107 
+    currentNode <- 1:Ntip
108 
+    while(anyNA(y)) {
109 
+        pNode <- unique(pvec[currentNode])
110 
+
111 
+        idx <- sapply(pNode, function(i) all(child_list[[i]] %in% currentNode))
112 
+        newNode <- pNode[idx]
113 
+
114 
+        y[newNode] <- sapply(newNode, function(i) {
115 
+            mean(y[child_list[[i]]], na.rm=TRUE)
116 
+        })
117 
+
118 
+        currentNode <- c(currentNode[!currentNode %in% unlist(child_list[newNode])], newNode)
119 
+    }
120 
+
121 
+    return(y)
122 
+}
man/ggdensitree.Rd
History View file @3002ff96
0 123 
new file mode 100644
... ... 
@@ -0,0 +1,45 @@
1 
+% Generated by roxygen2: do not edit by hand
2 
+% Please edit documentation in R/ggdensitree.R
3 
+\name{ggdensitree}
4 
+\alias{ggdensitree}
5 
+\title{ggdensitree}
6 
+\usage{
7 
+ggdensitree(data = NULL, mapping = NULL, layout = "slanted",
8 
+  tip.order = "mds", dangle = TRUE, jitter = 0, ...)
9 
+}
10 
+\arguments{
11 
+\item{data}{a list of phylo objects or any object with an as.phylo and fortify method}
12 
+
13 
+\item{mapping}{aesthetic mapping}
14 
+
15 
+\item{layout}{one of 'slanted', 'rectangluar', 'fan', 'circular' or 'radial' (default: 'slanted')}
16 
+
17 
+\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')}
18 
+
19 
+\item{dangle}{TRUE to align trees by their tips and FALSE to align treesby their root (default: TRUE)}
20 
+
21 
+\item{jitter}{deviation to jitter tips}
22 
+
23 
+\item{...}{additional parameters passed to fortify, ggtree and geom_tree}
24 
+}
25 
+\value{
26 
+tree layer
27 
+}
28 
+\description{
29 
+drawing phylogenetic trees from list of phylo objects
30 
+}
31 
+\examples{
32 
+require(ape)
33 
+require(dplyr)
34 
+library(ape)
35 
+library(tidyverse)
36 
+
37 
+trees <- list(read.tree(text="((a,b),c);"), read.tree(text="((a,c),b);"));
38 
+ggdensitree(trees) + geom_tiplab()
39 
+
40 
+trees.fort <- list(trees[[1]] \%>\% fortify \%>\% mutate(tree="a"), trees[[2]] \%>\% fortify \%>\% mutate(tree="b"));
41 
+ggdensitree(trees.fort, aes(colour=tree)) + geom_tiplab(colour='black')
42 
+}
43 
+\author{
44 
+Yu Guangchuang, Bradley R. Jones
45 
+}