git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@112112 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -1,7 +1,7 @@ |
1 | 1 |
Package: ggtree |
2 | 2 |
Type: Package |
3 | 3 |
Title: a phylogenetic tree viewer for different types of tree annotations |
4 |
-Version: 1.3.7 |
|
4 |
+Version: 1.3.8 |
|
5 | 5 |
Author: Guangchuang Yu and Tommy Tsan-Yuk Lam |
6 | 6 |
Maintainer: Guangchuang Yu <guangchuangyu@gmail.com> |
7 | 7 |
Description: ggtree extends the ggplot2 plotting system which implemented the |
... | ... |
@@ -19,10 +19,9 @@ Imports: |
19 | 19 |
jsonlite, |
20 | 20 |
magrittr, |
21 | 21 |
methods, |
22 |
- reshape2, |
|
23 |
- stats4 |
|
22 |
+ stats4, |
|
23 |
+ tidyr |
|
24 | 24 |
Suggests: |
25 |
- BiocStyle, |
|
26 | 25 |
EBImage, |
27 | 26 |
knitr, |
28 | 27 |
phylobase, |
... | ... |
@@ -62,13 +62,15 @@ export(get_heatmap_column_position) |
62 | 62 |
export(get_taxa_name) |
63 | 63 |
export(ggtree) |
64 | 64 |
export(gheatmap) |
65 |
-export(gplot) |
|
66 | 65 |
export(groupClade) |
67 | 66 |
export(groupOTU) |
68 | 67 |
export(gzoom) |
68 |
+export(inset) |
|
69 | 69 |
export(mask) |
70 | 70 |
export(merge_tree) |
71 | 71 |
export(msaplot) |
72 |
+export(nodebar) |
|
73 |
+export(nodepie) |
|
72 | 74 |
export(phyPML) |
73 | 75 |
export(phylopic) |
74 | 76 |
export(plot) |
... | ... |
@@ -92,6 +94,7 @@ export(scale_color) |
92 | 94 |
export(scale_x_ggtree) |
93 | 95 |
export(stat_hilight) |
94 | 96 |
export(subview) |
97 |
+export(theme_inset) |
|
95 | 98 |
export(theme_transparent) |
96 | 99 |
export(theme_tree) |
97 | 100 |
export(theme_tree2) |
... | ... |
@@ -158,8 +161,8 @@ importFrom(ggplot2,draw_key_text) |
158 | 161 |
importFrom(ggplot2,element_blank) |
159 | 162 |
importFrom(ggplot2,element_line) |
160 | 163 |
importFrom(ggplot2,element_rect) |
161 |
-importFrom(ggplot2,element_text) |
|
162 | 164 |
importFrom(ggplot2,fortify) |
165 |
+importFrom(ggplot2,geom_bar) |
|
163 | 166 |
importFrom(ggplot2,geom_rect) |
164 | 167 |
importFrom(ggplot2,geom_segment) |
165 | 168 |
importFrom(ggplot2,geom_text) |
... | ... |
@@ -169,7 +172,6 @@ importFrom(ggplot2,ggplotGrob) |
169 | 172 |
importFrom(ggplot2,ggproto) |
170 | 173 |
importFrom(ggplot2,guide_legend) |
171 | 174 |
importFrom(ggplot2,guides) |
172 |
-importFrom(ggplot2,labs) |
|
173 | 175 |
importFrom(ggplot2,layer) |
174 | 176 |
importFrom(ggplot2,position_nudge) |
175 | 177 |
importFrom(ggplot2,scale_color_manual) |
... | ... |
@@ -188,7 +190,6 @@ importFrom(ggplot2,ylab) |
188 | 190 |
importFrom(grDevices,col2rgb) |
189 | 191 |
importFrom(grDevices,rgb) |
190 | 192 |
importFrom(grid,rasterGrob) |
191 |
-importFrom(grid,unit) |
|
192 | 193 |
importFrom(gridExtra,grid.arrange) |
193 | 194 |
importFrom(jsonlite,fromJSON) |
194 | 195 |
importFrom(magrittr,"%<>%") |
... | ... |
@@ -196,6 +197,6 @@ importFrom(magrittr,"%>%") |
196 | 197 |
importFrom(magrittr,add) |
197 | 198 |
importFrom(magrittr,equals) |
198 | 199 |
importFrom(methods,show) |
199 |
-importFrom(reshape2,melt) |
|
200 | 200 |
importFrom(stats4,plot) |
201 |
+importFrom(tidyr,gather) |
|
201 | 202 |
importMethodsFrom(Biostrings,width) |
... | ... |
@@ -1,3 +1,9 @@ |
1 |
+CHANGES IN VERSION 1.3.8 |
|
2 |
+------------------------ |
|
3 |
+ o 05 advance tree annotation vignette <2016-01-04, Mon> |
|
4 |
+ o export theme_inset <2016-01-04, Mon> |
|
5 |
+ o inset, nodebar, nodepie functions <2015-12-31, Thu> |
|
6 |
+ |
|
1 | 7 |
CHANGES IN VERSION 1.3.7 |
2 | 8 |
------------------------ |
3 | 9 |
o split the long vignette to several vignettes |
... | ... |
@@ -92,12 +92,6 @@ setMethod("scale_color", signature(object="apeBootstrap"), |
92 | 92 |
}) |
93 | 93 |
|
94 | 94 |
|
95 |
-##' @rdname gzoom-methods |
|
96 |
-##' @exportMethod gzoom |
|
97 |
-setMethod("gzoom", signature(object="apeBootstrap"), |
|
98 |
- function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
99 |
- gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
100 |
- }) |
|
101 | 95 |
|
102 | 96 |
|
103 | 97 |
##' @rdname get.tree-methods |
... | ... |
@@ -39,12 +39,6 @@ setMethod("scale_color", signature(object="codeml"), |
39 | 39 |
}) |
40 | 40 |
|
41 | 41 |
|
42 |
-##' @rdname gzoom-methods |
|
43 |
-##' @exportMethod gzoom |
|
44 |
-setMethod("gzoom", signature(object="codeml"), |
|
45 |
- function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
46 |
- gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
47 |
- }) |
|
48 | 42 |
|
49 | 43 |
##' @rdname show-methods |
50 | 44 |
##' @exportMethod show |
... | ... |
@@ -114,7 +114,12 @@ get_clade_position_ <- function(data, node) { |
114 | 114 |
sp.df <- data[c(sp, node),] |
115 | 115 |
x <- sp.df$x |
116 | 116 |
y <- sp.df$y |
117 |
- data.frame(xmin=min(x)-data[node, "branch.length"]/2, |
|
117 |
+ if ("branch.length" %in% colnames(data)) { |
|
118 |
+ xmin <- min(x)-data[node, "branch.length"]/2 |
|
119 |
+ } else { |
|
120 |
+ xmin <- min(sp.df$branch) |
|
121 |
+ } |
|
122 |
+ data.frame(xmin=xmin, |
|
118 | 123 |
xmax=max(x), |
119 | 124 |
ymin=min(y)-0.5, |
120 | 125 |
ymax=max(y)+0.5) |
... | ... |
@@ -13,19 +13,21 @@ |
13 | 13 |
##' @param colnames_position one of 'bottom' or 'top' |
14 | 14 |
##' @param font.size font size of matrix colnames |
15 | 15 |
##' @return tree view |
16 |
-##' @importFrom reshape2 melt |
|
17 | 16 |
##' @importFrom ggplot2 geom_tile |
18 | 17 |
##' @importFrom ggplot2 geom_text |
19 | 18 |
##' @importFrom ggplot2 theme |
20 | 19 |
##' @importFrom ggplot2 element_blank |
21 | 20 |
##' @importFrom ggplot2 guides |
22 | 21 |
##' @importFrom ggplot2 guide_legend |
22 |
+##' @importFrom ggplot2 scale_fill_gradient |
|
23 |
+##' @importFrom ggplot2 scale_fill_discrete |
|
23 | 24 |
##' @export |
24 | 25 |
##' @author Guangchuang Yu |
25 | 26 |
gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", |
26 | 27 |
color="white", colnames=TRUE, colnames_position="bottom", font.size=4) { |
27 | 28 |
|
28 | 29 |
colnames_position %<>% match.arg(c("bottom", "top")) |
30 |
+ variable <- value <- lab <- y <- NULL |
|
29 | 31 |
|
30 | 32 |
## if (is.null(width)) { |
31 | 33 |
## width <- (p$data$x %>% range %>% diff)/30 |
... | ... |
@@ -44,7 +46,8 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", |
44 | 46 |
dd$y <- sort(df$y) |
45 | 47 |
|
46 | 48 |
dd$lab <- rownames(dd) |
47 |
- dd <- melt(dd, id=c("lab", "y")) |
|
49 |
+ ## dd <- melt(dd, id=c("lab", "y")) |
|
50 |
+ dd <- gather(dd, variable, value, -c(lab, y)) |
|
48 | 51 |
|
49 | 52 |
if (any(dd$value == "")) { |
50 | 53 |
dd$value[dd$value == ""] <- NA |
... | ... |
@@ -259,91 +262,91 @@ scale_x_ggtree <- function(p, breaks=NULL, labels=NULL) { |
259 | 262 |
|
260 | 263 |
|
261 | 264 |
|
262 |
-##' view tree and associated matrix |
|
263 |
-##' |
|
264 |
-##' @title gplot |
|
265 |
-##' @param p tree view |
|
266 |
-##' @param data matrix |
|
267 |
-##' @param low low color |
|
268 |
-##' @param high high color |
|
269 |
-##' @param widths widths of sub plot |
|
270 |
-##' @param color color |
|
271 |
-##' @param font.size font size |
|
272 |
-##' @return list of figure |
|
273 |
-##' @importFrom gridExtra grid.arrange |
|
274 |
-##' @importFrom ggplot2 scale_x_continuous |
|
275 |
-##' @importFrom ggplot2 scale_y_continuous |
|
276 |
-##' @export |
|
277 |
-##' @author Guangchuang Yu \url{http://ygc.name} |
|
278 |
-##' @examples |
|
279 |
-##' nwk <- system.file("extdata", "sample.nwk", package="ggtree") |
|
280 |
-##' tree <- read.tree(nwk) |
|
281 |
-##' p <- ggtree(tree) |
|
282 |
-##' d <- matrix(abs(rnorm(52)), ncol=4) |
|
283 |
-##' rownames(d) <- tree$tip.label |
|
284 |
-##' colnames(d) <- paste0("G", 1:4) |
|
285 |
-##' gplot(p, d, low="green", high="red") |
|
286 |
-gplot <- function(p, data, low="green", high="red", widths=c(0.5, 0.5), color="white", font.size=14) { |
|
287 |
- ## p <- p + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0.6)) |
|
288 |
- p1 <- p + scale_y_continuous(expand = c(0, 0.6)) |
|
289 |
- ## p1 <- p + theme(panel.margin=unit(0, "null")) |
|
290 |
- ## p1 <- p1 + theme(plot.margin = unit(c(1, -1, 1.5, 1), "lines")) |
|
291 |
- p2 <- gplot.heatmap(p, data, low, high, color, font.size) |
|
292 |
- grid.arrange(p1, p2, ncol=2, widths=widths) |
|
293 |
- invisible(list(p1=p1, p2=p2)) |
|
294 |
-} |
|
295 |
- |
|
296 |
- |
|
297 |
-##' @importFrom grid unit |
|
298 |
-##' @importFrom ggplot2 scale_fill_gradient |
|
299 |
-##' @importFrom ggplot2 scale_fill_discrete |
|
300 |
-##' @importFrom ggplot2 element_text |
|
301 |
-##' @importFrom ggplot2 geom_tile |
|
302 |
-##' @importFrom ggplot2 labs |
|
303 |
-##' @importFrom ggplot2 guides |
|
304 |
-##' @importFrom ggplot2 guide_legend |
|
305 |
-##' @importFrom reshape2 melt |
|
306 |
-gplot.heatmap <- function(p, data, low, high, color="white", font.size) { |
|
307 |
- isTip <- x <- Var1 <- Var2 <- value <- NULL |
|
308 |
- dd=melt(as.matrix(data)) |
|
309 |
- ## p <- ggtree(tree) ## + theme_tree2() |
|
310 |
- ## p <- p + geom_text(aes(x = max(x)*1.1, label=label), subset=.(isTip), hjust=0) |
|
311 |
- ## p <- p+geom_segment(aes(x=x*1.02, xend=max(x)*1.08, yend=y), subset=.(isTip), linetype="dashed", size=0.4) |
|
312 |
- df=p$data |
|
313 |
- df=df[df$isTip,] |
|
265 |
+## ##' view tree and associated matrix |
|
266 |
+## ##' |
|
267 |
+## ##' @title gplot |
|
268 |
+## ##' @param p tree view |
|
269 |
+## ##' @param data matrix |
|
270 |
+## ##' @param low low color |
|
271 |
+## ##' @param high high color |
|
272 |
+## ##' @param widths widths of sub plot |
|
273 |
+## ##' @param color color |
|
274 |
+## ##' @param font.size font size |
|
275 |
+## ##' @return list of figure |
|
276 |
+## ##' @importFrom gridExtra grid.arrange |
|
277 |
+## ##' @importFrom ggplot2 scale_x_continuous |
|
278 |
+## ##' @importFrom ggplot2 scale_y_continuous |
|
279 |
+## ##' @export |
|
280 |
+## ##' @author Guangchuang Yu \url{http://ygc.name} |
|
281 |
+## ##' @examples |
|
282 |
+## ##' nwk <- system.file("extdata", "sample.nwk", package="ggtree") |
|
283 |
+## ##' tree <- read.tree(nwk) |
|
284 |
+## ##' p <- ggtree(tree) |
|
285 |
+## ##' d <- matrix(abs(rnorm(52)), ncol=4) |
|
286 |
+## ##' rownames(d) <- tree$tip.label |
|
287 |
+## ##' colnames(d) <- paste0("G", 1:4) |
|
288 |
+## ##' gplot(p, d, low="green", high="red") |
|
289 |
+## gplot <- function(p, data, low="green", high="red", widths=c(0.5, 0.5), color="white", font.size=14) { |
|
290 |
+## ## p <- p + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0.6)) |
|
291 |
+## p1 <- p + scale_y_continuous(expand = c(0, 0.6)) |
|
292 |
+## ## p1 <- p + theme(panel.margin=unit(0, "null")) |
|
293 |
+## ## p1 <- p1 + theme(plot.margin = unit(c(1, -1, 1.5, 1), "lines")) |
|
294 |
+## p2 <- gplot.heatmap(p, data, low, high, color, font.size) |
|
295 |
+## grid.arrange(p1, p2, ncol=2, widths=widths) |
|
296 |
+## invisible(list(p1=p1, p2=p2)) |
|
297 |
+## } |
|
298 |
+ |
|
299 |
+ |
|
300 |
+## ##' @importFrom grid unit |
|
301 |
+## ##' @importFrom ggplot2 scale_fill_gradient |
|
302 |
+## ##' @importFrom ggplot2 scale_fill_discrete |
|
303 |
+## ##' @importFrom ggplot2 element_text |
|
304 |
+## ##' @importFrom ggplot2 geom_tile |
|
305 |
+## ##' @importFrom ggplot2 labs |
|
306 |
+## ##' @importFrom ggplot2 guides |
|
307 |
+## ##' @importFrom ggplot2 guide_legend |
|
308 |
+## ##' @importFrom reshape2 melt |
|
309 |
+## gplot.heatmap <- function(p, data, low, high, color="white", font.size) { |
|
310 |
+## isTip <- x <- Var1 <- Var2 <- value <- NULL |
|
311 |
+## dd=melt(as.matrix(data)) |
|
312 |
+## ## p <- ggtree(tree) ## + theme_tree2() |
|
313 |
+## ## p <- p + geom_text(aes(x = max(x)*1.1, label=label), subset=.(isTip), hjust=0) |
|
314 |
+## ## p <- p+geom_segment(aes(x=x*1.02, xend=max(x)*1.08, yend=y), subset=.(isTip), linetype="dashed", size=0.4) |
|
315 |
+## df=p$data |
|
316 |
+## df=df[df$isTip,] |
|
314 | 317 |
|
315 |
- dd$Var1 <- factor(dd$Var1, levels = df$label[order(df$y)]) |
|
316 |
- if (any(dd$value == "")) { |
|
317 |
- dd$value[dd$value == ""] <- NA |
|
318 |
- } |
|
318 |
+## dd$Var1 <- factor(dd$Var1, levels = df$label[order(df$y)]) |
|
319 |
+## if (any(dd$value == "")) { |
|
320 |
+## dd$value[dd$value == ""] <- NA |
|
321 |
+## } |
|
319 | 322 |
|
320 |
- p2 <- ggplot(dd, aes(Var2, Var1, fill=value))+geom_tile(color=color) |
|
321 |
- if (is(dd$value,"numeric")) { |
|
322 |
- p2 <- p2 + scale_fill_gradient(low=low, high=high, na.value="white") |
|
323 |
- } else { |
|
324 |
- p2 <- p2 + scale_fill_discrete(na.value="white") |
|
325 |
- } |
|
323 |
+## p2 <- ggplot(dd, aes(Var2, Var1, fill=value))+geom_tile(color=color) |
|
324 |
+## if (is(dd$value,"numeric")) { |
|
325 |
+## p2 <- p2 + scale_fill_gradient(low=low, high=high, na.value="white") |
|
326 |
+## } else { |
|
327 |
+## p2 <- p2 + scale_fill_discrete(na.value="white") |
|
328 |
+## } |
|
326 | 329 |
|
327 |
- p2 <- p2+xlab("")+ylab("") |
|
328 |
- p2 <- p2+theme_tree2() + theme(axis.ticks.x = element_blank(), |
|
329 |
- axis.line.x=element_blank()) |
|
330 |
- ## p1 <- p1 + theme(axis.text.x = element_text(size = font.size)) |
|
331 |
- p2 <- p2 + theme(axis.ticks.margin = unit(0, "lines")) |
|
332 |
- p2 <- p2 + theme(axis.text.x = element_text(size = font.size)) |
|
333 |
- ## p2 <- p2 + theme(axis.text.y = element_text(size=font.size)) |
|
330 |
+## p2 <- p2+xlab("")+ylab("") |
|
331 |
+## p2 <- p2+theme_tree2() + theme(axis.ticks.x = element_blank(), |
|
332 |
+## axis.line.x=element_blank()) |
|
333 |
+## ## p1 <- p1 + theme(axis.text.x = element_text(size = font.size)) |
|
334 |
+## p2 <- p2 + theme(axis.ticks.margin = unit(0, "lines")) |
|
335 |
+## p2 <- p2 + theme(axis.text.x = element_text(size = font.size)) |
|
336 |
+## ## p2 <- p2 + theme(axis.text.y = element_text(size=font.size)) |
|
334 | 337 |
|
335 |
- ## plot.margin margin around entire plot (unit with the sizes of the top, right, bottom, and left margins) |
|
336 |
- ## units can be given in "lines" or something more specific like "cm"... |
|
338 |
+## ## plot.margin margin around entire plot (unit with the sizes of the top, right, bottom, and left margins) |
|
339 |
+## ## units can be given in "lines" or something more specific like "cm"... |
|
337 | 340 |
|
338 | 341 |
|
339 |
- p2 <- p2 + theme(panel.margin=unit(0, "null")) |
|
340 |
- p2 <- p2 + theme(plot.margin = unit(c(1, 1, .5, -0.5), "lines")) |
|
341 |
- p2 <- p2 + theme(legend.position = "right") |
|
342 |
- p2 <- p2 + guides(fill = guide_legend(override.aes = list(colour = NULL))) |
|
343 |
- ## p2 <- p2 + labs(fill="") |
|
342 |
+## p2 <- p2 + theme(panel.margin=unit(0, "null")) |
|
343 |
+## p2 <- p2 + theme(plot.margin = unit(c(1, 1, .5, -0.5), "lines")) |
|
344 |
+## p2 <- p2 + theme(legend.position = "right") |
|
345 |
+## p2 <- p2 + guides(fill = guide_legend(override.aes = list(colour = NULL))) |
|
346 |
+## ## p2 <- p2 + labs(fill="") |
|
344 | 347 |
|
345 |
- return(p2) |
|
346 |
-} |
|
348 |
+## return(p2) |
|
349 |
+## } |
|
347 | 350 |
|
348 | 351 |
|
349 | 352 |
coplot <- function(tree1, tree2, hjust=0) { |
350 | 353 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,110 @@ |
1 |
+##' add insets in a tree |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title inset |
|
5 |
+##' @param tree_view tree view |
|
6 |
+##' @param insets a list of ggplot objects, named by node number |
|
7 |
+##' @param width width of inset |
|
8 |
+##' @param height height of inset |
|
9 |
+##' @param hjust horizontal adjustment |
|
10 |
+##' @param vjust vertical adjustment |
|
11 |
+##' @param x x position, one of 'node' and 'branch' |
|
12 |
+##' @return tree view with insets |
|
13 |
+##' @export |
|
14 |
+##' @author Guangchuang Yu |
|
15 |
+inset <- function(tree_view, insets, width=0.05, height=0.05, hjust=0, vjust=0, x="node") { |
|
16 |
+ df <- tree_view$data[names(insets),] |
|
17 |
+ x <- match.arg(x, c("node", "branch", "edge")) |
|
18 |
+ |
|
19 |
+ if (x == 'node') { |
|
20 |
+ xx <- df$x |
|
21 |
+ } else { |
|
22 |
+ xx <- df$branch |
|
23 |
+ } |
|
24 |
+ yy <- df$y |
|
25 |
+ |
|
26 |
+ xx <- xx - hjust |
|
27 |
+ yy <- yy - vjust |
|
28 |
+ |
|
29 |
+ for (i in seq_along(insets)) { |
|
30 |
+ tree_view %<>% subview(insets[[i]], |
|
31 |
+ x = xx[i], |
|
32 |
+ y = yy[i], |
|
33 |
+ width = width, |
|
34 |
+ height = height) |
|
35 |
+ } |
|
36 |
+ return(tree_view) |
|
37 |
+} |
|
38 |
+ |
|
39 |
+##' generate a list of bar charts for results of ancestral state reconstruction |
|
40 |
+##' |
|
41 |
+##' |
|
42 |
+##' @title nodebar |
|
43 |
+##' @param position position of bar, one of 'stack' and 'dodge' |
|
44 |
+##' @inheritParams nodepie |
|
45 |
+##' @return list of ggplot objects |
|
46 |
+##' @export |
|
47 |
+##' @importFrom ggplot2 geom_bar |
|
48 |
+##' @importFrom tidyr gather |
|
49 |
+##' @author Guangchuang Yu |
|
50 |
+nodebar <- function(data, cols, color, alpha=1, position="stack") { |
|
51 |
+ if (! "node" %in% colnames(data)) { |
|
52 |
+ stop("data should have a column 'node'...") |
|
53 |
+ } |
|
54 |
+ type <- value <- NULL |
|
55 |
+ |
|
56 |
+ ldf <- gather(data, type, value, cols) %>% split(., .$node) |
|
57 |
+ bars <- lapply(ldf, function(df) ggplot(df, aes_(x=1, y=~value, fill=~type)) + |
|
58 |
+ geom_bar(stat='identity', alpha=alpha, position=position) + |
|
59 |
+ theme_inset() |
|
60 |
+ ) |
|
61 |
+ |
|
62 |
+ if (missingArg(color) || is.null(color) || is.na(color)) { |
|
63 |
+ ## do nothing |
|
64 |
+ } else { |
|
65 |
+ bars <- lapply(bars, function(p) p+scale_fill_manual(values=color)) |
|
66 |
+ } |
|
67 |
+ return(bars) |
|
68 |
+} |
|
69 |
+ |
|
70 |
+##' generate a list of pie charts for results of ancestral stat reconstruction |
|
71 |
+##' |
|
72 |
+##' |
|
73 |
+##' @title nodepie |
|
74 |
+##' @param data a data.frame of stats with an additional column of node number |
|
75 |
+##' @param cols column of stats |
|
76 |
+##' @param color color of bar |
|
77 |
+##' @param alpha alpha |
|
78 |
+##' @return list of ggplot objects |
|
79 |
+##' @export |
|
80 |
+##' @author Guangchuang Yu |
|
81 |
+nodepie <- function(data, cols, color, alpha=1) { |
|
82 |
+ if (! "node" %in% colnames(data)) { |
|
83 |
+ stop("data should have a column 'node'...") |
|
84 |
+ } |
|
85 |
+ type <- value <- NULL |
|
86 |
+ if (missingArg(color)) { |
|
87 |
+ color <- NA |
|
88 |
+ } |
|
89 |
+ ldf <- gather(data, type, value, cols) %>% split(., .$node) |
|
90 |
+ lapply(ldf, function(df) ggpie(df, y=~value, fill=~type, color, alpha)) |
|
91 |
+} |
|
92 |
+ |
|
93 |
+ |
|
94 |
+ggpie <- function(data, y, fill, color, alpha=1) { |
|
95 |
+ p <- ggplot(data, aes_(x=1, y=y, fill=fill)) + |
|
96 |
+ geom_bar(stat='identity', alpha=alpha) + |
|
97 |
+ coord_polar(theta='y') + theme_inset() |
|
98 |
+ |
|
99 |
+ if (missingArg(color) || is.null(color) || is.na(color)) { |
|
100 |
+ ## do nothing |
|
101 |
+ } else { |
|
102 |
+ p <- p+scale_fill_manual(values=color) |
|
103 |
+ } |
|
104 |
+ return(p) |
|
105 |
+} |
|
106 |
+ |
|
107 |
+ |
|
108 |
+ |
|
109 |
+ |
|
110 |
+ |
... | ... |
@@ -1,3 +1,72 @@ |
1 |
+##' plots simultaneously a whole phylogenetic tree and a portion of it. |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title gzoom |
|
5 |
+##' @param phy phylo object |
|
6 |
+##' @param focus selected tips |
|
7 |
+##' @param subtree logical |
|
8 |
+##' @param widths widths |
|
9 |
+##' @return a list of ggplot object |
|
10 |
+##' @importFrom ggplot2 xlim |
|
11 |
+##' @importFrom ggplot2 scale_color_manual |
|
12 |
+##' @importFrom ape drop.tip |
|
13 |
+##' @importFrom gridExtra grid.arrange |
|
14 |
+##' @author ygc |
|
15 |
+##' @examples |
|
16 |
+##' require(ape) |
|
17 |
+##' data(chiroptera) |
|
18 |
+##' gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label)) |
|
19 |
+gzoom.phylo <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
20 |
+ if (is.character(focus)) { |
|
21 |
+ focus <- which(phy$tip.label %in% focus) |
|
22 |
+ } |
|
23 |
+ |
|
24 |
+ group_name <- "focus" |
|
25 |
+ phy <- gfocus(phy, focus, group_name) |
|
26 |
+ |
|
27 |
+ foc <- attr(phy, group_name) |
|
28 |
+ ## foc should +1 since the group index start from 0 |
|
29 |
+ cols <- c("black", "red")[foc+1] |
|
30 |
+ |
|
31 |
+ p1 <- ggtree(phy, color=cols) |
|
32 |
+ |
|
33 |
+ subtr <- drop.tip(phy, phy$tip.label[-focus], |
|
34 |
+ subtree=subtree, rooted=TRUE) |
|
35 |
+ |
|
36 |
+ p2 <- ggtree(subtr, color="red") + geom_tiplab(hjust=-0.05) |
|
37 |
+ p2 <- p2 + xlim(0, max(p2$data$x)*1.2) |
|
38 |
+ grid.arrange(p1, p2, ncol=2, widths=widths) |
|
39 |
+ |
|
40 |
+ invisible(list(p1=p1, p2=p2)) |
|
41 |
+} |
|
42 |
+ |
|
43 |
+gzoom.ggplot <- function(tree_view, focus, widths=c(.3, .7), xmax_adjust=0) { |
|
44 |
+ node <- MRCA(tree_view, focus) |
|
45 |
+ cpos <- get_clade_position(tree_view, node) |
|
46 |
+ p2 <- with(cpos, tree_view+ |
|
47 |
+ xlim(xmin, xmax+xmax_adjust)+ |
|
48 |
+ ylim(ymin, ymax)) |
|
49 |
+ grid.arrange(tree_view, p2, ncol=2, widths=widths) |
|
50 |
+ invisible(list(p1=tree_view, p2=p2)) |
|
51 |
+} |
|
52 |
+ |
|
53 |
+##' @rdname gzoom-methods |
|
54 |
+##' @exportMethod gzoom |
|
55 |
+##' @param xmax_adjust adjust xmax (xlim[2]) |
|
56 |
+setMethod("gzoom", signature(object="gg"), |
|
57 |
+ function(object, focus, widths=c(.3, .7), xmax_adjust=0) { |
|
58 |
+ gzoom.ggplot(object, focus, widths, xmax_adjust) |
|
59 |
+ }) |
|
60 |
+ |
|
61 |
+ |
|
62 |
+##' @rdname gzoom-methods |
|
63 |
+##' @exportMethod gzoom |
|
64 |
+setMethod("gzoom", signature(object="apeBootstrap"), |
|
65 |
+ function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
66 |
+ gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
67 |
+ }) |
|
68 |
+ |
|
69 |
+ |
|
1 | 70 |
##' zoom selected subtree |
2 | 71 |
##' |
3 | 72 |
##' |
... | ... |
@@ -8,6 +77,13 @@ setMethod("gzoom", signature(object="beast"), |
8 | 77 |
gzoom.phylo(get.tree(object), focus, subtree, widths) |
9 | 78 |
}) |
10 | 79 |
|
80 |
+##' @rdname gzoom-methods |
|
81 |
+##' @exportMethod gzoom |
|
82 |
+setMethod("gzoom", signature(object="codeml"), |
|
83 |
+ function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
84 |
+ gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
85 |
+ }) |
|
86 |
+ |
|
11 | 87 |
|
12 | 88 |
##' @rdname gzoom-methods |
13 | 89 |
##' @exportMethod gzoom |
... | ... |
@@ -77,3 +77,19 @@ theme_transparent <- function(...) { |
77 | 77 |
fill = "transparent", |
78 | 78 |
colour = NA), ...) |
79 | 79 |
} |
80 |
+ |
|
81 |
+##' inset theme |
|
82 |
+##' |
|
83 |
+##' theme for inset function |
|
84 |
+##' @title theme_inset |
|
85 |
+##' @param ... additional parameter |
|
86 |
+##' @return ggplot object |
|
87 |
+##' @export |
|
88 |
+##' @author Guangchuang Yu |
|
89 |
+theme_inset <- function(...) { |
|
90 |
+ list(xlab(NULL), |
|
91 |
+ ylab(NULL), |
|
92 |
+ theme_tree(...), |
|
93 |
+ theme_transparent() |
|
94 |
+ ) |
|
95 |
+} |
... | ... |
@@ -124,46 +124,6 @@ gfocus <- function(phy, focus, group_name) { |
124 | 124 |
phy |
125 | 125 |
} |
126 | 126 |
|
127 |
-##' plots simultaneously a whole phylogenetic tree and a portion of it. |
|
128 |
-##' |
|
129 |
-##' |
|
130 |
-##' @title gzoom |
|
131 |
-##' @param phy phylo object |
|
132 |
-##' @param focus selected tips |
|
133 |
-##' @param subtree logical |
|
134 |
-##' @param widths widths |
|
135 |
-##' @return a list of ggplot object |
|
136 |
-##' @importFrom ggplot2 xlim |
|
137 |
-##' @importFrom ggplot2 scale_color_manual |
|
138 |
-##' @importFrom ape drop.tip |
|
139 |
-##' @author ygc |
|
140 |
-##' @examples |
|
141 |
-##' require(ape) |
|
142 |
-##' data(chiroptera) |
|
143 |
-##' gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label)) |
|
144 |
-gzoom.phylo <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
145 |
- if (is.character(focus)) { |
|
146 |
- focus <- which(phy$tip.label %in% focus) |
|
147 |
- } |
|
148 |
- |
|
149 |
- group_name <- "focus" |
|
150 |
- phy <- gfocus(phy, focus, group_name) |
|
151 |
- |
|
152 |
- foc <- attr(phy, group_name) |
|
153 |
- ## foc should +1 since the group index start from 0 |
|
154 |
- cols <- c("black", "red")[foc+1] |
|
155 |
- |
|
156 |
- p1 <- ggtree(phy, color=cols) |
|
157 |
- |
|
158 |
- subtr <- drop.tip(phy, phy$tip.label[-focus], |
|
159 |
- subtree=subtree, rooted=TRUE) |
|
160 |
- |
|
161 |
- p2 <- ggtree(subtr, color="red") + geom_tiplab(hjust=-0.05) |
|
162 |
- p2 <- p2 + xlim(0, max(p2$data$x)*1.2) |
|
163 |
- grid.arrange(p1, p2, ncol=2, widths=widths) |
|
164 |
- |
|
165 |
- invisible(list(p1=p1, p2=p2)) |
|
166 |
-} |
|
167 | 127 |
|
168 | 128 |
|
169 | 129 |
##' update tree |
170 | 130 |
deleted file mode 100644 |
... | ... |
@@ -1,43 +0,0 @@ |
1 |
-% Generated by roxygen2: do not edit by hand |
|
2 |
-% Please edit documentation in R/gplot.R |
|
3 |
-\name{gplot} |
|
4 |
-\alias{gplot} |
|
5 |
-\title{gplot} |
|
6 |
-\usage{ |
|
7 |
-gplot(p, data, low = "green", high = "red", widths = c(0.5, 0.5), |
|
8 |
- color = "white", font.size = 14) |
|
9 |
-} |
|
10 |
-\arguments{ |
|
11 |
-\item{p}{tree view} |
|
12 |
- |
|
13 |
-\item{data}{matrix} |
|
14 |
- |
|
15 |
-\item{low}{low color} |
|
16 |
- |
|
17 |
-\item{high}{high color} |
|
18 |
- |
|
19 |
-\item{widths}{widths of sub plot} |
|
20 |
- |
|
21 |
-\item{color}{color} |
|
22 |
- |
|
23 |
-\item{font.size}{font size} |
|
24 |
-} |
|
25 |
-\value{ |
|
26 |
-list of figure |
|
27 |
-} |
|
28 |
-\description{ |
|
29 |
-view tree and associated matrix |
|
30 |
-} |
|
31 |
-\examples{ |
|
32 |
-nwk <- system.file("extdata", "sample.nwk", package="ggtree") |
|
33 |
-tree <- read.tree(nwk) |
|
34 |
-p <- ggtree(tree) |
|
35 |
-d <- matrix(abs(rnorm(52)), ncol=4) |
|
36 |
-rownames(d) <- tree$tip.label |
|
37 |
-colnames(d) <- paste0("G", 1:4) |
|
38 |
-gplot(p, d, low="green", high="red") |
|
39 |
-} |
|
40 |
-\author{ |
|
41 |
-Guangchuang Yu \url{http://ygc.name} |
|
42 |
-} |
|
43 |
- |
... | ... |
@@ -1,5 +1,5 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/AllGenerics.R, R/RAxML.R, R/ape.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/method-gzoom.R, R/phangorn.R, R/r8s.R |
|
2 |
+% Please edit documentation in R/AllGenerics.R, R/RAxML.R, R/codeml_mlc.R, R/hyphy.R, R/method-gzoom.R, R/phangorn.R, R/r8s.R |
|
3 | 3 |
\docType{methods} |
4 | 4 |
\name{gzoom} |
5 | 5 |
\alias{gzoom} |
... | ... |
@@ -7,6 +7,7 @@ |
7 | 7 |
\alias{gzoom,beast-method} |
8 | 8 |
\alias{gzoom,codeml-method} |
9 | 9 |
\alias{gzoom,codeml_mlc-method} |
10 |
+\alias{gzoom,gg-method} |
|
10 | 11 |
\alias{gzoom,hyphy-method} |
11 | 12 |
\alias{gzoom,nhx-method} |
12 | 13 |
\alias{gzoom,paml_rst-method} |
... | ... |
@@ -21,21 +22,23 @@ gzoom(object, focus, subtree = FALSE, widths = c(0.3, 0.7), ...) |
21 | 22 |
\S4method{gzoom}{raxml}(object, focus, subtree = FALSE, widths = c(0.3, |
22 | 23 |
0.7)) |
23 | 24 |
|
24 |
-\S4method{gzoom}{apeBootstrap}(object, focus, subtree = FALSE, |
|
25 |
- widths = c(0.3, 0.7)) |
|
26 |
- |
|
27 |
-\S4method{gzoom}{codeml}(object, focus, subtree = FALSE, widths = c(0.3, |
|
28 |
- 0.7)) |
|
29 |
- |
|
30 | 25 |
\S4method{gzoom}{codeml_mlc}(object, focus, subtree = FALSE, widths = c(0.3, |
31 | 26 |
0.7)) |
32 | 27 |
|
33 | 28 |
\S4method{gzoom}{hyphy}(object, focus, subtree = FALSE, widths = c(0.3, |
34 | 29 |
0.7)) |
35 | 30 |
|
31 |
+\S4method{gzoom}{gg}(object, focus, widths = c(0.3, 0.7), xmax_adjust = 0) |
|
32 |
+ |
|
33 |
+\S4method{gzoom}{apeBootstrap}(object, focus, subtree = FALSE, |
|
34 |
+ widths = c(0.3, 0.7)) |
|
35 |
+ |
|
36 | 36 |
\S4method{gzoom}{beast}(object, focus, subtree = FALSE, widths = c(0.3, |
37 | 37 |
0.7)) |
38 | 38 |
|
39 |
+\S4method{gzoom}{codeml}(object, focus, subtree = FALSE, widths = c(0.3, |
|
40 |
+ 0.7)) |
|
41 |
+ |
|
39 | 42 |
\S4method{gzoom}{nhx}(object, focus, subtree = FALSE, widths = c(0.3, 0.7)) |
40 | 43 |
|
41 | 44 |
\S4method{gzoom}{paml_rst}(object, focus, subtree = FALSE, widths = c(0.3, |
... | ... |
@@ -61,6 +64,8 @@ gzoom(object, focus, subtree = FALSE, widths = c(0.3, 0.7), ...) |
61 | 64 |
|
62 | 65 |
\item{...}{additional parameter} |
63 | 66 |
|
67 |
+\item{xmax_adjust}{adjust xmax (xlim[2])} |
|
68 |
+ |
|
64 | 69 |
\item{tree}{which tree selected} |
65 | 70 |
} |
66 | 71 |
\value{ |
6 | 6 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,34 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/inset.R |
|
3 |
+\name{inset} |
|
4 |
+\alias{inset} |
|
5 |
+\title{inset} |
|
6 |
+\usage{ |
|
7 |
+inset(tree_view, insets, width = 0.05, height = 0.05, hjust = 0, |
|
8 |
+ vjust = 0, x = "node") |
|
9 |
+} |
|
10 |
+\arguments{ |
|
11 |
+\item{tree_view}{tree view} |
|
12 |
+ |
|
13 |
+\item{insets}{a list of ggplot objects, named by node number} |
|
14 |
+ |
|
15 |
+\item{width}{width of inset} |
|
16 |
+ |
|
17 |
+\item{height}{height of inset} |
|
18 |
+ |
|
19 |
+\item{hjust}{horizontal adjustment} |
|
20 |
+ |
|
21 |
+\item{vjust}{vertical adjustment} |
|
22 |
+ |
|
23 |
+\item{x}{x position, one of 'node' and 'branch'} |
|
24 |
+} |
|
25 |
+\value{ |
|
26 |
+tree view with insets |
|
27 |
+} |
|
28 |
+\description{ |
|
29 |
+add insets in a tree |
|
30 |
+} |
|
31 |
+\author{ |
|
32 |
+Guangchuang Yu |
|
33 |
+} |
|
34 |
+ |
0 | 35 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,29 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/inset.R |
|
3 |
+\name{nodebar} |
|
4 |
+\alias{nodebar} |
|
5 |
+\title{nodebar} |
|
6 |
+\usage{ |
|
7 |
+nodebar(data, cols, color, alpha = 1, position = "stack") |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{data}{a data.frame of stats with an additional column of node number} |
|
11 |
+ |
|
12 |
+\item{cols}{column of stats} |
|
13 |
+ |
|
14 |
+\item{color}{color of bar} |
|
15 |
+ |
|
16 |
+\item{alpha}{alpha} |
|
17 |
+ |
|
18 |
+\item{position}{position of bar, one of 'stack' and 'dodge'} |
|
19 |
+} |
|
20 |
+\value{ |
|
21 |
+list of ggplot objects |
|
22 |
+} |
|
23 |
+\description{ |
|
24 |
+generate a list of bar charts for results of ancestral state reconstruction |
|
25 |
+} |
|
26 |
+\author{ |
|
27 |
+Guangchuang Yu |
|
28 |
+} |
|
29 |
+ |
0 | 30 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,27 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/inset.R |
|
3 |
+\name{nodepie} |
|
4 |
+\alias{nodepie} |
|
5 |
+\title{nodepie} |
|
6 |
+\usage{ |
|
7 |
+nodepie(data, cols, color, alpha = 1) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{data}{a data.frame of stats with an additional column of node number} |
|
11 |
+ |
|
12 |
+\item{cols}{column of stats} |
|
13 |
+ |
|
14 |
+\item{color}{color of bar} |
|
15 |
+ |
|
16 |
+\item{alpha}{alpha} |
|
17 |
+} |
|
18 |
+\value{ |
|
19 |
+list of ggplot objects |
|
20 |
+} |
|
21 |
+\description{ |
|
22 |
+generate a list of pie charts for results of ancestral stat reconstruction |
|
23 |
+} |
|
24 |
+\author{ |
|
25 |
+Guangchuang Yu |
|
26 |
+} |
|
27 |
+ |
0 | 28 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,24 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/theme.R |
|
3 |
+\name{theme_inset} |
|
4 |
+\alias{theme_inset} |
|
5 |
+\title{theme_inset} |
|
6 |
+\usage{ |
|
7 |
+theme_inset(...) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{...}{additional parameter} |
|
11 |
+} |
|
12 |
+\value{ |
|
13 |
+ggplot object |
|
14 |
+} |
|
15 |
+\description{ |
|
16 |
+inset theme |
|
17 |
+} |
|
18 |
+\details{ |
|
19 |
+theme for inset function |
|
20 |
+} |
|
21 |
+\author{ |
|
22 |
+Guangchuang Yu |
|
23 |
+} |
|
24 |
+ |
0 | 25 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,221 @@ |
1 |
+--- |
|
2 |
+title: "Advance Tree Annotation" |
|
3 |
+author: "\\ |
|
4 |
+ |
|
5 |
+ Guangchuang Yu (<guangchuangyu@gmail.com>) and Tommy Tsan-Yuk Lam (<ttylam@hku.hk>)\\ |
|
6 |
+ |
|
7 |
+ School of Public Health, The University of Hong Kong" |
|
8 |
+date: "`r Sys.Date()`" |
|
9 |
+bibliography: ggtree.bib |
|
10 |
+csl: nature.csl |
|
11 |
+output: |
|
12 |
+ html_document: |
|
13 |
+ toc: true |
|
14 |
+ pdf_document: |
|
15 |
+ toc: true |
|
16 |
+vignette: > |
|
17 |
+ %\VignetteIndexEntry{05 Advance Tree Annotation} |
|
18 |
+ %\VignetteEngine{knitr::rmarkdown} |
|
19 |
+ %\usepackage[utf8]{inputenc} |
|
20 |
+--- |
|
21 |
+ |
|
22 |
+```{r style, echo=FALSE, results="asis", message=FALSE} |
|
23 |
+knitr::opts_chunk$set(tidy = FALSE, |
|
24 |
+ message = FALSE) |
|
25 |
+``` |
|
26 |
+ |
|
27 |
+ |
|
28 |
+```{r echo=FALSE, results="hide", message=FALSE} |
|
29 |
+library("ape") |
|
30 |
+library("ggplot2") |
|
31 |
+library("gridExtra") |
|
32 |
+library("ggtree") |
|
33 |
+``` |
|
34 |
+ |
|
35 |
+ |
|
36 |
+# Visualize tree with associated matrix |
|
37 |
+ |
|
38 |
+At first we implemented `gplot` function to visualize tree with heatmap but it has [an issue](https://github.com/GuangchuangYu/ggtree/issues/3) that it can't always guarantee the heatmap aligning to the tree properly, since the line up is between two figures and it's currently not supported internally by ggplot2. I have implemented another function `gheatmap` that can do the line up properly by creating a new layer above the tree. |
|
39 |
+ |
|
40 |
+ |
|
41 |
+In the following example, we visualized a tree of H3 influenza viruses with their associated genotype. |
|
42 |
+ |
|
43 |
+```{r fig.width=20, fig.height=16, fig.align="center"} |
|
44 |
+beast_file <- system.file("examples/MCC_FluA_H3.tree", package="ggtree") |
|
45 |
+beast_tree <- read.beast(beast_file) |
|
46 |
+ |
|
47 |
+genotype_file <- system.file("examples/Genotype.txt", package="ggtree") |
|
48 |
+genotype <- read.table(genotype_file, sep="\t", stringsAsFactor=F) |
|
49 |
+p <- ggtree(beast_tree, mrsd="2013-01-01") + geom_treescale(x=2008, y=1) |
|
50 |
+p <- p + geom_tiplab(size=3) |
|
51 |
+gheatmap(p, genotype, offset = 2, width=0.5) |
|
52 |
+``` |
|
53 |
+ |
|
54 |
+The _width_ parameter is to control the width of the heatmap. It supports another parameter _offset_ for controling the distance between the tree and the heatmap, for instance left space for tip labels. |
|
55 |
+ |
|
56 |
+ |
|
57 |
+For time scaled tree, as in this example, it's more often to use x axis by using `theme_tree2`. But with this solution, the heatmap is just another layer and will change the `x` axis. To overcome this issue, we implemented `scale_x_ggtree` to set the x axis more reasonable. User can also use `gplot` and tweak the positions of two plot to align properly. |
|
58 |
+ |
|
59 |
+```{r fig.width=20, fig.height=16, fig.align="center"} |
|
60 |
+p <- ggtree(beast_tree, mrsd="2013-01-01") + geom_tiplab(size=3, align=TRUE) + theme_tree2() |
|
61 |
+pp <- (p + scale_y_continuous(expand=c(0, 0.3))) %>% |
|
62 |
+ gheatmap(genotype, offset=4, width=0.5, colnames=FALSE) %>% |
|
63 |
+ scale_x_ggtree() |
|
64 |
+pp + theme(legend.position="right") |
|
65 |
+``` |
|
66 |
+ |
|
67 |
+# Visualize tree with multiple sequence alignment |
|
68 |
+ |
|
69 |
+With `msaplot` function, user can visualizes multiple sequence alignment with phylogenetic tree, as demonstrated below: |
|
70 |
+```{r fig.width=8, fig.height=12, fig.align='center'} |
|
71 |
+fasta <- system.file("examples/FluA_H3_AA.fas", package="ggtree") |
|
72 |
+msaplot(ggtree(beast_tree), fasta) |
|
73 |
+``` |
|
74 |
+ |
|
75 |
+A specific slice of the alignment can also be displayed by specific _window_ parameter. |
|
76 |
+ |
|
77 |
+ |
|
78 |
+# Annotate a phylogenetic with insets |
|
79 |
+ |
|
80 |
+`ggtree` implemented a function, `subview`, that can add subplots into a ggplot2 object. It had successful applied to [plot pie graphs on map](http://stackoverflow.com/questions/10368180/plotting-pie-graphs-on-map-in-ggplot/32380396#32380396). |
|
81 |
+ |
|
82 |
+```{r fig.width=8, fig.height=8, warning=F} |
|
83 |
+set.seed(2016-01-04) |
|
84 |
+tr <- rtree(30) |
|
85 |
+tr <- groupClade(tr, node=45) |
|
86 |
+p <- ggtree(tr, aes(color=group)) + geom_tippoint() |
|
87 |
+cpos <- get_clade_position(p, node=45) |
|
88 |
+p1 <- p + geom_hilight(node=45) |
|
89 |
+p2 <- with(cpos, p+xlim(xmin, xmax*1.01)+ylim(ymin, ymax)) |
|
90 |
+with(cpos, subview(p2+geom_tiplab(), p1+theme_transparent(), x=xmin+(xmax-xmin)*.15, y=ymin+(ymax-ymin)*.85)) |
|
91 |
+``` |
|
92 |
+ |
|
93 |
+To make it more easy to use subview function for annotating taxa with subplots, *ggtree* provides a function, `inset`, for adding subplots to a phylogenetic tree. The input is a tree graphic object and a named list of ggplot graphic objects (can be any kind of charts), these objects should named by node numbers. To facilitate adding bar and pie charts (e.g. summarized stats of results from ancestral reconstruction) to phylogenetic tree, *ggtree* provides `nodepie` and `nodebar` functions to create a list of pie or bar charts. |
|
94 |
+ |
|
95 |
+## Annotate with bar charts |
|
96 |
+ |
|
97 |
+```{r} |
|
98 |
+set.seed(2015-12-31) |
|
99 |
+tr <- rtree(15) |
|
100 |
+p <- ggtree(tr) |
|
101 |
+ |
|
102 |
+a <- runif(14, 0, 0.33) |
|
103 |
+b <- runif(14, 0, 0.33) |
|
104 |
+c <- runif(14, 0, 0.33) |
|
105 |
+d <- 1 - a - b - c |
|
106 |
+dat <- data.frame(a=a, b=b, c=c, d=d) |
|
107 |
+## input data should have a column of `node` that store the node number |
|
108 |
+dat$node <- 15+1:14 |
|
109 |
+ |
|
110 |
+## cols parameter indicate which columns store stats (a, b, c and d in this example) |
|
111 |
+bars <- nodebar(dat, cols=1:4) |
|
112 |
+ |
|
113 |
+inset(p, bars) |
|
114 |
+``` |
|
115 |
+ |
|
116 |
+The size of the inset can be ajusted by the paramter *width* and *height*. |
|
117 |
+ |
|
118 |
+```{r} |
|
119 |
+inset(p, bars, width=.03, height=.06) |
|
120 |
+``` |
|
121 |
+ |
|
122 |
+Users can set the color via the parameter *color*. The *x* position can be one of 'node' or 'branch' and can be adjusted by the parameter *hjust* and *vjust* for horizontal and vertical adjustment respecitvely. |
|
123 |
+ |
|
124 |
+ |
|
125 |
+```{r} |
|
126 |
+bars2 <- nodebar(dat, cols=1:4, position='dodge', |
|
127 |
+ color=c(a='blue', b='red', c='green', d='cyan')) |
|
128 |
+p2 <- inset(p, bars2, x='branch', width=.03, vjust=-.3) |
|
129 |
+print(p2) |
|
130 |
+``` |
|
131 |
+ |
|
132 |
+## Annotate with pie charts |
|
133 |
+ |
|
134 |
+Similarly, users can use `nodepie` function to generate a list of pie charts and place these charts to annotate corresponding nodes. Both `nodebar` and `nodepie` accepts parameter *alpha* to allow transparency. |
|
135 |
+ |
|
136 |
+```{r} |
|
137 |
+pies <- nodepie(dat, cols=1:4, alpha=.6) |
|
138 |
+inset(p, pies) |
|
139 |
+``` |
|
140 |
+ |
|
141 |
+ |
|
142 |
+```{r} |
|
143 |
+inset(p, pies, hjust=-.06) |
|
144 |
+``` |
|
145 |
+ |
|
146 |
+## Annotate with other types of charts |
|
147 |
+ |
|
148 |
+The `inset` function accepts a list of ggplot graphic objects and these input objects are not restricted to pie or bar charts. They can be any kinds of charts and hybrid of these charts. |
|
149 |
+ |
|
150 |
+```{r} |
|
151 |
+pies_and_bars <- bars2 |
|
152 |
+pies_and_bars[9:14] <- pies[9:14] |
|
153 |
+inset(p, pies_and_bars) |
|
154 |
+``` |
|
155 |
+ |
|
156 |
+```{r} |
|
157 |
+d <- lapply(1:15, rnorm, n=100) |
|
158 |
+ylim <- range(unlist(d)) |
|
159 |
+bx <- lapply(d, function(y) { |
|
160 |
+ dd <- data.frame(y=y) |
|
161 |
+ ggplot(dd, aes(x=1, y=y))+geom_boxplot() + ylim(ylim) + theme_inset() |
|
162 |
+}) |
|
163 |
+names(bx) <- 1:15 |
|
164 |
+inset(p, bx, width=.03, height=.1, hjust=-.05) |
|
165 |
+``` |
|
166 |
+ |
|
167 |
+ |
|
168 |
+After annotating with insets, users can further annotate the tree with another layer of insets. |
|
169 |
+ |
|
170 |
+```{r fig.width=10, fig.height=7} |
|
171 |
+p2 <- inset(p, bars2, x='branch', width=.03, vjust=-.4) |
|
172 |
+p2 <- inset(p2, pies, x='branch', vjust=.4) |
|
173 |
+bx2 <- lapply(bx, function(g) g+coord_flip()) |
|
174 |
+inset(p2, bx2, width=.2, height=.03, vjust=.04, hjust=p2$data$x[1:15]-4) + xlim(NA, 4.5) |
|
175 |
+``` |
|
176 |
+ |
|
177 |
+# Align tree with other plots on a page |
|
178 |
+ |
|
179 |
+This is currently difficult to achieve in `ggplot2`. However, it is possible to obtain good results by creating a dummy faceting of data. |
|
180 |
+ |
|
181 |
+```{r warning=F, fig.width=10, fig.height=6} |
|
182 |
+tr <- rtree(30) |
|
183 |
+df <- fortify(tr) |
|
184 |
+df$tipstats <- NA |
|
185 |
+d1 <- df |
|
186 |
+d2 <- df |
|
187 |
+d2$tipstats[d2$isTip] <- abs(rnorm(30)) |
|
188 |
+d1$panel <- 'Tree' |
|
189 |
+d2$panel <- 'Stats' |
|
190 |
+d1$panel <- factor(d1$panel, levels=c("Tree", "Stats")) |
|
191 |
+d2$panel <- factor(d2$panel, levels=c("Tree", "Stats")) |
|
192 |
+ |
|
193 |
+p <- ggplot(mapping=aes(x=x, y=y)) + facet_grid(.~panel, scale="free_x") + |
|
194 |
+ xlab(NULL)+ylab(NULL)+theme_tree2() |
|
195 |
+p+geom_tree(data=d1) + geom_point(data=d2, aes(x=tipstats)) |
|
196 |
+``` |
|
197 |
+ |
|
198 |
+# Tree annotation with Phylopic |
|
199 |
+ |
|
200 |
+ |
|
201 |
+[PhyloPic](http://phylopic.org/) is a database that stores reusable silhouette images of organisms. `ggtree` supports downloading images from [PhyloPic](http://phylopic.org/) and annotating phylogenetic tree with the downloaded images. |
|
202 |
+ |
|
203 |
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE, eval=FALSE} |
|
204 |
+pp <- ggtree(tree) %>% phylopic("79ad5f09-cf21-4c89-8e7d-0c82a00ce728", color="steelblue", alpha = .3) |
|
205 |
+print(pp) |
|
206 |
+``` |
|
207 |
+ |
|
208 |
+ |
|
209 |
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE, eval=FALSE} |
|
210 |
+pp %>% phylopic("67382184-5135-4faa-8e98-eadff02c3e8a", color="#86B875", alpha=.8, node=4) %>% |
|
211 |
+ phylopic("d3563b54-780f-4711-a49a-7ea051e9dacc", color="darkcyan", alpha=.8, node=17, width=.2) |
|
212 |
+``` |
|
213 |
+ |
|
214 |
+ |
|
215 |
+ |
|
216 |
+Annotate phylogenetic tree with local images is also supported, please refer to the [blog post](http://guangchuangyu.github.io/2015/08/ggtree-annotate-phylogenetic-tree-with-local-images/). |
|
217 |
+ |
|
218 |
+ |
|
219 |
+ |
|
220 |
+ |
|
221 |
+ |
... | ... |
@@ -9,9 +9,9 @@ date: "`r Sys.Date()`" |
9 | 9 |
bibliography: ggtree.bib |
10 | 10 |
csl: nature.csl |
11 | 11 |
output: |
12 |
- BiocStyle::html_document: |
|
12 |
+ html_document: |
|
13 | 13 |
toc: true |
14 |
- BiocStyle::pdf_document: |
|
14 |
+ pdf_document: |
|
15 | 15 |
toc: true |
16 | 16 |
vignette: > |
17 | 17 |
%\VignetteIndexEntry{00 ggtree introduction} |
... | ... |
@@ -20,7 +20,6 @@ vignette: > |
20 | 20 |
--- |
21 | 21 |
|
22 | 22 |
```{r style, echo=FALSE, results="asis", message=FALSE} |
23 |
-BiocStyle::markdown() |
|
24 | 23 |
knitr::opts_chunk$set(tidy = FALSE, |
25 | 24 |
message = FALSE) |
26 | 25 |
``` |
... | ... |
@@ -43,7 +42,7 @@ library("phangorn") |
43 | 42 |
|
44 | 43 |
|
45 | 44 |
# Citation |
46 |
-If you use `r Biocpkg("ggtree")` in published research, please cite: |
|
45 |
+If you use `ggtree` in published research, please cite: |
|
47 | 46 |
|
48 | 47 |
``` |
49 | 48 |
G Yu, D Smith, H Zhu, Y Guan, TTY Lam, |
... | ... |
@@ -55,15 +54,15 @@ revised. |
55 | 54 |
|
56 | 55 |
This project arose from our needs to annotate nucleotide substitutions in the phylogenetic tree, and we found that there is no tree visualization software can do this easily. Existing tree viewers are designed for displaying phylogenetic tree, but not annotating it. Although some tree viewers can displaying bootstrap values in the tree, it is hard/impossible to display other information in the tree. Our first solution for displaying nucleotide substituitions in the tree is to add this information in the node/tip names and use traditional tree viewer to show it. We displayed the information in the tree successfully, but we believe this indirect approach is inefficient. |
57 | 56 |
|
58 |
-In the old day, phylogenetic tree is often small. At that time, as we almost didn't have a need to annotate a tree; displaying the evolution relationships is mostly enough. Nowadays, we can obtain a lot of data from different experiments, and we want to associate our data, for instance antigenic change, with the evolution relationship. Visualizing these associations in the phylogenetic tree can help us to identify evolution patterns. We believe we need a next generation tree viewer that should be programmable and extensible. It can view a phylogenetic tree easily as we did with classical software and support adding annotation data in a layer above the tree. This is the objective of developing the `r Githubpkg("GuangchuangYu/ggtree")`. Common tasks of annotating a phylogenetic tree should be easy and complicated tasks can be possible to achieve by adding multiple layers of annotation. |
|
57 |
+In the old day, phylogenetic tree is often small. At that time, as we almost didn't have a need to annotate a tree; displaying the evolution relationships is mostly enough. Nowadays, we can obtain a lot of data from different experiments, and we want to associate our data, for instance antigenic change, with the evolution relationship. Visualizing these associations in the phylogenetic tree can help us to identify evolution patterns. We believe we need a next generation tree viewer that should be programmable and extensible. It can view a phylogenetic tree easily as we did with classical software and support adding annotation data in a layer above the tree. This is the objective of developing the `ggtree`. Common tasks of annotating a phylogenetic tree should be easy and complicated tasks can be possible to achieve by adding multiple layers of annotation. |
|
59 | 58 |
|
60 |
-The `r Githubpkg("GuangchuangYu/ggtree")` is designed by extending the `r CRANpkg("ggplot2")`[@wickham_ggplot2_2009] package. It is based on the grammar of graphics and takes all the good parts of `r CRANpkg("ggplot2")`. There are other R packages that implement tree viewer using `r CRANpkg("ggplot2")`, including `r CRANpkg("OutbreakTools")`, `r Biocpkg("phyloseq")`[@mcmurdie_phyloseq_2013] and `r Githubpkg("gjuggler/ggphylo")`; they mostly create complex tree view functions for their specific needs. Internally, these packages interpret a phylogenetic as a collection of `lines`, which makes it hard to annotate diverse user input that are related to node (taxa). The `r Githubpkg("GuangchuangYu/ggtree")` is different to them by interpreting a tree as a collection of `taxa` and allowing general flexibilities of annotating phylogenetic tree with diverse types of user inputs. |
|
59 |
+The `ggtree` is designed by extending the `ggplot2`[@wickham_ggplot2_2009] package. It is based on the grammar of graphics and takes all the good parts of `ggplot2`. There are other R packages that implement tree viewer using `ggplot2`, including `OutbreakTools`, `phyloseq`[@mcmurdie_phyloseq_2013] and [ggphylo](https://github.com/gjuggler/ggphylo); they mostly create complex tree view functions for their specific needs. Internally, these packages interpret a phylogenetic as a collection of `lines`, which makes it hard to annotate diverse user input that are related to node (taxa). The `ggtree` is different to them by interpreting a tree as a collection of `taxa` and allowing general flexibilities of annotating phylogenetic tree with diverse types of user inputs. |
|
61 | 60 |
|
62 | 61 |
|
63 | 62 |
# Getting data into `R` |
64 | 63 |
|
65 | 64 |
Most of the tree viewer software (including `R` packages) focus on `Newick` and `Nexus` file format, while there are file formats from different evolution analysis software that contain supporting evidences within the file that are ready for annotating a phylogenetic tree. |
66 |
-The `r Githubpkg("GuangchuangYu/ggtree")` package define several parser functions and `S4` classes to store statistical evidences inferred by commonly used software packages. It supports several file format, including: |
|
65 |
+The `ggtree` package define several parser functions and `S4` classes to store statistical evidences inferred by commonly used software packages. It supports several file format, including: |
|
67 | 66 |
|
68 | 67 |
+ Newick (via `ape`) |
69 | 68 |
+ Nexus (via `ape`) |
... | ... |
@@ -121,7 +120,7 @@ Visualizing an annotated phylogenetic tree with numerical matrix (e.g. genotype |
121 | 120 |
+ [Tree Visualization](treeVisualization.html) |
122 | 121 |
+ [Tree Manipulation](treeManipulation.html) |
123 | 122 |
+ [Tree Annotation](treeAnnotation.html) |
124 |
- |
|
123 |
++ [Advance Tree Annotation](advanceTreeAnnotation.html) |
|
125 | 124 |
|
126 | 125 |
# Bugs/Feature requests |
127 | 126 |
|
... | ... |
@@ -9,9 +9,9 @@ date: "`r Sys.Date()`" |
9 | 9 |
bibliography: ggtree.bib |
10 | 10 |
csl: nature.csl |
11 | 11 |
output: |
12 |
- BiocStyle::html_document: |
|
12 |
+ html_document: |
|
13 | 13 |
toc: true |
14 |
- BiocStyle::pdf_document: |
|
14 |
+ pdf_document: |
|
15 | 15 |
toc: true |
16 | 16 |
vignette: > |
17 | 17 |
%\VignetteIndexEntry{04 Tree Annotation} |
... | ... |
@@ -22,7 +22,6 @@ vignette: > |
22 | 22 |
--- |
23 | 23 |
|
24 | 24 |
```{r style, echo=FALSE, results="asis", message=FALSE} |
25 |
-BiocStyle::markdown() |
|
26 | 25 |
knitr::opts_chunk$set(tidy = FALSE, |
27 | 26 |
message = FALSE) |
28 | 27 |
``` |
... | ... |
@@ -65,7 +64,7 @@ grid.arrange(p1, p2, ncol=2) |
65 | 64 |
|
66 | 65 |
# Zoom on a portion of tree |
67 | 66 |
|
68 |
-`r Githubpkg("GuangchuangYu/ggtree")` provides _`gzoom`_ function that similar to _`zoom`_ function provided in `r CRANpkg("ape")`. This function plots simultaneously a whole phylogenetic tree and a portion of it. It aims at exploring very large trees. |
|
67 |
+`ggtree` provides _`gzoom`_ function that similar to _`zoom`_ function provided in `ape`. This function plots simultaneously a whole phylogenetic tree and a portion of it. It aims at exploring very large trees. |
|
69 | 68 |
|
70 | 69 |
```{r fig.width=18, fig.height=10, fig.align="center"} |
71 | 70 |
library("ape") |
... | ... |
@@ -74,9 +73,19 @@ library("ggtree") |
74 | 73 |
gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label)) |
75 | 74 |
``` |
76 | 75 |
|
76 |
+Zoom in selected clade of a tree that was already annotated with `ggtree` is also supported. |
|
77 |
+ |
|
78 |
+```{r fig.width=18, fig.height=10, warning=FALSE} |
|
79 |
+groupInfo <- split(chiroptera$tip.label, gsub("_\\w+", "", chiroptera$tip.label)) |
|
80 |
+chiroptera <- groupOTU(chiroptera, groupInfo) |
|
81 |
+p <- ggtree(chiroptera, aes(color=group)) + geom_tiplab() + xlim(NA, 23) |
|
82 |
+gzoom(p, grep("Plecotus", chiroptera$tip.label), xmax_adjust=2) |
|
83 |
+``` |
|
84 |
+ |
|
85 |
+ |
|
77 | 86 |
# Color tree |
78 | 87 |
|
79 |
-In `r Githubpkg("GuangchuangYu/ggtree")`, coloring phylogenetic tree is easy, by using `aes(color=VAR)` to map the color of tree based on a specific variable (numeric and category are both supported). |
|
88 |
+In `ggtree`, coloring phylogenetic tree is easy, by using `aes(color=VAR)` to map the color of tree based on a specific variable (numeric and category are both supported). |
|
80 | 89 |
|
81 | 90 |
```{r fig.width=5, fig.height=5} |
82 | 91 |
ggtree(beast_tree, aes(color=rate)) + |
... | ... |
@@ -87,7 +96,7 @@ ggtree(beast_tree, aes(color=rate)) + |
87 | 96 |
User can use any feature (if available), including clade posterior and *dN/dS* _etc._, to scale the color of the tree. |
88 | 97 |
|
89 | 98 |
## Annotate clades |
90 |
-`r Githubpkg("GuangchuangYu/ggtree")` implements _`geom_cladelabel`_ layer to annotate a selected clade with a bar indicating that clade with a corresponding label. |
|
99 |
+`ggtree` implements _`geom_cladelabel`_ layer to annotate a selected clade with a bar indicating that clade with a corresponding label. |
|
91 | 100 |
|
92 | 101 |
The _`geom_cladelabel`_ layer accepts a selected internal node number. To get the internal node number, please refer to [Tree Manipulation](treeManipulation.html#internal-node-number) vignette. |
93 | 102 |
|
... | ... |
@@ -137,7 +146,7 @@ p+ geom_cladelabel(node=34, label="another clade", align=T, geom='label', fill=' |
137 | 146 |
|
138 | 147 |
# Highlight clades |
139 | 148 |
|
140 |
-`r Githubpkg("GuangchuangYu/ggtree")` implements _`geom_hilight`_ layer, that an internal node number and add a layer of rectangle to highlight the selected clade. |
|
149 |
+`ggtree` implements _`geom_hilight`_ layer, that an internal node number and add a layer of rectangle to highlight the selected clade. |
|
141 | 150 |
|
142 | 151 |
```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE} |
143 | 152 |
nwk <- system.file("extdata", "sample.nwk", package="ggtree") |
... | ... |
@@ -263,69 +272,16 @@ p <- p + geom_text(aes(color=place, label=value), hjust=1, vjust=1.4, size=3) |
263 | 272 |
print(p) |
264 | 273 |
``` |
265 | 274 |
|
266 |
-## `jplace` file format |
|
275 |
+## jplace file format |
|
267 | 276 |
|
268 | 277 |
In `ggtree`, we provide `write.jplace` function to store user's own data and associated newick tree to a single `jplace` file, which can be parsed directly in `ggtree` and user's data can be used to annotate the tree directly. For more detail, please refer to the [Tree Data Import](treeImport.html#jplace-file-format) vignette. |
269 | 278 |
|
270 | 279 |
|
271 |
-# Tree annotation with Phylopic |
|
272 |
- |
|
273 |
- |
|
274 |
-[PhyloPic](http://phylopic.org/) is a database that stores reusable silhouette images of organisms. `r Githubpkg("GuangchuangYu/ggtree")` supports downloading images from [PhyloPic](http://phylopic.org/) and annotating phylogenetic tree with the downloaded images. |
|
275 |
- |
|
276 |
-```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE, eval=FALSE} |
|
277 |
-pp <- ggtree(tree) %>% phylopic("79ad5f09-cf21-4c89-8e7d-0c82a00ce728", color="steelblue", alpha = .3) |
|
278 |
-print(pp) |
|
279 |
-``` |
|
280 |
- |
|
281 |
- |
|
282 |
-```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE, eval=FALSE} |
|
283 |
-pp %>% phylopic("67382184-5135-4faa-8e98-eadff02c3e8a", color="#86B875", alpha=.8, node=4) %>% |
|
284 |
- phylopic("d3563b54-780f-4711-a49a-7ea051e9dacc", color="darkcyan", alpha=.8, node=17, width=.2) |
|
285 |
-``` |
|
286 |
- |
|
287 |
- |
|
288 |
- |
|
289 |
-Annotate phylogenetic tree with local images is also supported, please refer to the [blog post](http://guangchuangyu.github.io/2015/08/ggtree-annotate-phylogenetic-tree-with-local-images/). |
|
290 |
- |
|
280 |
+# Advance tree annotation |
|
291 | 281 |
|
292 |
-# Visualize tree with associated matrix |
|
282 |
+Advance tree annotation including visualizing tree with associated matrix, multiple sequence alignment, subplots and images (especially PhyloPic). For details and examples, please refer to the [Advance Tree Annotation](advanceTreeAnnotation.html) vignette. |
|
293 | 283 |
|
294 |
-At first we implemented `gplot` function to visualize tree with heatmap but it has [an issue](https://github.com/GuangchuangYu/ggtree/issues/3) that it can't always guarantee the heatmap aligning to the tree properly, since the line up is between two figures and it's currently not supported internally by ggplot2. I have implemented another function `gheatmap` that can do the line up properly by creating a new layer above the tree. |
|
295 | 284 |
|
285 |
+# References |
|
296 | 286 |
|
297 |
-In the following example, we visualized a tree of H3 influenza viruses with their associated genotype. |
|
298 |
- |
|
299 |
-```{r fig.width=20, fig.height=16, fig.align="center"} |
|
300 |
-beast_file <- system.file("examples/MCC_FluA_H3.tree", package="ggtree") |
|
301 |
-beast_tree <- read.beast(beast_file) |
|
302 |
- |
|
303 |
-genotype_file <- system.file("examples/Genotype.txt", package="ggtree") |
|
304 |
-genotype <- read.table(genotype_file, sep="\t", stringsAsFactor=F) |
|
305 |
-p <- ggtree(beast_tree, mrsd="2013-01-01") + geom_treescale(x=2008, y=1) |
|
306 |
-p <- p + geom_tiplab(size=3) |
|
307 |
-gheatmap(p, genotype, offset = 2, width=0.5) |
|
308 |
-``` |
|
309 |
- |
|
310 |
-The _width_ parameter is to control the width of the heatmap. It supports another parameter _offset_ for controling the distance between the tree and the heatmap, for instance left space for tip labels. |
|
311 |
- |
|
312 |
- |
|
313 |
-For time scaled tree, as in this example, it's more often to use x axis by using `theme_tree2`. But with this solution, the heatmap is just another layer and will change the `x` axis. To overcome this issue, we implemented `scale_x_ggtree` to set the x axis more reasonable. User can also use `gplot` and tweak the positions of two plot to align properly. |
|
314 |
- |
|
315 |
-```{r fig.width=20, fig.height=16, fig.align="center"} |
|
316 |
-p <- ggtree(beast_tree, mrsd="2013-01-01") + geom_tiplab(size=3, align=TRUE) + theme_tree2() |
|
317 |
-pp <- (p + scale_y_continuous(expand=c(0, 0.3))) %>% |
|
318 |
- gheatmap(genotype, offset=4, width=0.5, colnames=FALSE) %>% |
|
319 |
- scale_x_ggtree() |
|
320 |
-pp + theme(legend.position="right") |
|
321 |
-``` |
|
322 |
- |
|
323 |
-# visualize tree with multiple sequence alignment |
|
324 |
- |
|
325 |
-With `msaplot` function, user can visualizes multiple sequence alignment with phylogenetic tree, as demonstrated below: |
|
326 |
-```{r fig.width=8, fig.height=12, fig.align='center'} |
|
327 |
-fasta <- system.file("examples/FluA_H3_AA.fas", package="ggtree") |
|
328 |
-msaplot(ggtree(beast_tree), fasta) |
|
329 |
-``` |
|
330 | 287 |
|
331 |
-A specific slice of the alignment can also be displayed by specific _window_ parameter. |
... | ... |
@@ -9,9 +9,9 @@ date: "`r Sys.Date()`" |
9 | 9 |
bibliography: ggtree.bib |
10 | 10 |
csl: nature.csl |
11 | 11 |
output: |
12 |
- BiocStyle::html_document: |
|
12 |
+ html_document: |
|
13 | 13 |
toc: true |
14 |
- BiocStyle::pdf_document: |
|
14 |
+ pdf_document: |
|
15 | 15 |
toc: true |
16 | 16 |
vignette: > |
17 | 17 |
%\VignetteIndexEntry{01 Tree Data Import} |
... | ... |
@@ -21,7 +21,6 @@ vignette: > |
21 | 21 |
--- |
22 | 22 |
|
23 | 23 |
```{r style, echo=FALSE, results="asis", message=FALSE} |
24 |
-BiocStyle::markdown() |
|
25 | 24 |
knitr::opts_chunk$set(tidy = FALSE, |
26 | 25 |
message = FALSE) |
27 | 26 |
``` |
... | ... |
@@ -34,12 +33,12 @@ library("ggtree") |
34 | 33 |
``` |
35 | 34 |
|
36 | 35 |
|
37 |
-The `r Githubpkg("GuangchuangYu/ggtree")` package should not be viewed solely as a standalone software. While it is useful for viewing, annotating and manipulating phylogenetic trees, it is also an infrastructure that enables evolutionary evidences that inferred by commonly used software packages in the field to be used in `R`. For instance, *dN/dS* values or ancestral sequences inferred by [CODEML](http://abacus.gene.ucl.ac.uk/software/paml.html)[@yang_paml_2007], *clade support values (posterior)* inferred by [BEAST](http://beast2.org/)[@bouckaert_beast_2014] and short read placement by [EPA](http://sco.h-its.org/exelixis/web/software/epa/index.html)[@berger_EPA_2011] and [pplacer](http://matsen.fhcrc.org/pplacer/)[@matsen_pplacer_2010]. These evolutionary evidences are not only used in annotating phylogenetic tree in `r Githubpkg("GuangchuangYu/ggtree")` but can also be further analyzed in `R`. |
|
36 |
+The `ggtree` package should not be viewed solely as a standalone software. While it is useful for viewing, annotating and manipulating phylogenetic trees, it is also an infrastructure that enables evolutionary evidences that inferred by commonly used software packages in the field to be used in `R`. For instance, *dN/dS* values or ancestral sequences inferred by [CODEML](http://abacus.gene.ucl.ac.uk/software/paml.html)[@yang_paml_2007], *clade support values (posterior)* inferred by [BEAST](http://beast2.org/)[@bouckaert_beast_2014] and short read placement by [EPA](http://sco.h-its.org/exelixis/web/software/epa/index.html)[@berger_EPA_2011] and [pplacer](http://matsen.fhcrc.org/pplacer/)[@matsen_pplacer_2010]. These evolutionary evidences are not only used in annotating phylogenetic tree in `ggtree` but can also be further analyzed in `R`. |
|
38 | 37 |
|
39 | 38 |
# Supported File Formats |
40 | 39 |
|
41 | 40 |
Most of the tree viewer software (including `R` packages) focus on `Newick` and `Nexus` file format, while there are file formats from different evolution analysis software that contain supporting evidences within the file that are ready for annotating a phylogenetic tree. |
42 |
-The `r Githubpkg("GuangchuangYu/ggtree")` package define several parser functions and `S4` classes to store statistical evidences inferred by commonly used software packages. It supports several file format, including: |
|
41 |
+The `ggtree` package define several parser functions and `S4` classes to store statistical evidences inferred by commonly used software packages. It supports several file format, including: |
|
43 | 42 |
|
44 | 43 |
+ Newick (via `ape`) |
45 | 44 |
+ Nexus (via `ape`) |
... | ... |
@@ -60,7 +59,7 @@ and software output from: |
60 | 59 |
|
61 | 60 |
# Parser functions |
62 | 61 |
|
63 |
-The `r Githubpkg("GuangchuangYu/ggtree")` package implement several parser functions, including: |
|
62 |
+The `ggtree` package implement several parser functions, including: |
|
64 | 63 |
|
65 | 64 |
+ `read.beast` for parsing output of [BEASE](http://beast2.org/) |
66 | 65 |
+ `read.codeml` for parsing output of [CODEML](http://abacus.gene.ucl.ac.uk/software/paml.html) (`rst` and `mlc` files) |
... | ... |
@@ -74,7 +73,7 @@ The `r Githubpkg("GuangchuangYu/ggtree")` package implement several parser funct |
74 | 73 |
|
75 | 74 |
# S4 classes |
76 | 75 |
|
77 |
-Correspondingly, `r Githubpkg("GuangchuangYu/ggtree")` define several `S4` classes to store evolutionary evidences inferred by these software packages, including: |
|
76 |
+Correspondingly, `ggtree` define several `S4` classes to store evolutionary evidences inferred by these software packages, including: |
|
78 | 77 |
|
79 | 78 |
+ _`apeBootstrap`_ for bootstrap analysis of `ape::boot.phylo()`[@paradis_ape_2004], output of `apeBoot()` defined in `ggtree` |
80 | 79 |
+ _`beast`_ for storing output of `read.beast()` |
... | ... |
@@ -89,14 +88,14 @@ Correspondingly, `r Githubpkg("GuangchuangYu/ggtree")` define several `S4` class |
89 | 88 |
+ _`raxml`_ for storing output of `read.raxml()` |
90 | 89 |
|
91 | 90 |
|
92 |
-The _`jplace`_ class is also designed to store user specific annotation data, and serves as a standard format for tree annotation within the `r Githubpkg("GuangchuangYu/ggtree")` package. |
|
91 |
+The _`jplace`_ class is also designed to store user specific annotation data, and serves as a standard format for tree annotation within the `ggtree` package. |
|
93 | 92 |
|
94 | 93 |
|
95 | 94 |
Here is an overview of these `S4` classes: |
96 | 95 |
|
97 | 96 |
 |
98 | 97 |
|
99 |
-In addition, `ggtree` also supports _`phylo`_ (defined by `r CRANpkg("ape")`[@paradis_ape_2004]) and _`phylo4`_ (defined by `r CRANpkg("phylobase")`). |
|
98 |
+In addition, `ggtree` also supports _`phylo`_ (defined by `ape`[@paradis_ape_2004]) and _`phylo4`_ (defined by `phylobase`). |
|
100 | 99 |
|
101 | 100 |
|
102 | 101 |
In `ggtree`, tree objects can be merged and evidences inferred from different phylogenetic analyses can be combined or compared and visualized. |
... | ... |
@@ -298,7 +297,7 @@ jp <- read.jplace(jpf) |
298 | 297 |
print(jp) |
299 | 298 |
``` |
300 | 299 |
|
301 |
-In `r Githubpkg("GuangchuangYu/ggtree")`, we provide _`get.placements`_ method to access the placement. |
|
300 |
+In `ggtree`, we provide _`get.placements`_ method to access the placement. |
|
302 | 301 |
|
303 | 302 |
```{r} |
304 | 303 |
## get only best hit |
... | ... |
@@ -365,7 +364,7 @@ head(data) |
365 | 364 |
The _`data`_ contains amino acid substitutions from parent node to child node and GC contents of each node. We can annotate the tree as demonstrated in [User specific annotation](treeAnnotation.html#user-specific-annotation) session of [Tree Annotation](treeAnnotation.html) vignette. |
366 | 365 |
|
367 | 366 |
|
368 |
-`r Githubpkg("GuangchuangYu/ggtree")` provides a function, _`write.jplace`_, to combine a tree and an associated data and store them to a single _`jplace`_ file. |
|
367 |
+`ggtree` provides a function, _`write.jplace`_, to combine a tree and an associated data and store them to a single _`jplace`_ file. |
|
369 | 368 |
```{r} |
370 | 369 |
outfile <- tempfile() |
371 | 370 |
write.jplace(tree, data, outfile) |
... | ... |
@@ -9,9 +9,9 @@ date: "`r Sys.Date()`" |
9 | 9 |
bibliography: ggtree.bib |
10 | 10 |
csl: nature.csl |
11 | 11 |
output: |
12 |
- BiocStyle::html_document: |
|
12 |
+ html_document: |
|
13 | 13 |
toc: true |
14 |
- BiocStyle::pdf_document: |
|
14 |
+ pdf_document: |
|
15 | 15 |
toc: true |
16 | 16 |
vignette: > |
17 | 17 |
%\VignetteIndexEntry{03 Tree Manipulation} |
... | ... |
@@ -21,7 +21,6 @@ vignette: > |
21 | 21 |
--- |
22 | 22 |
|
23 | 23 |
```{r style, echo=FALSE, results="asis", message=FALSE} |
24 |
-BiocStyle::markdown() |
|
25 | 24 |
knitr::opts_chunk$set(tidy = FALSE, |
26 | 25 |
message = FALSE) |
27 | 26 |
``` |
... | ... |
@@ -30,8 +29,10 @@ knitr::opts_chunk$set(tidy = FALSE, |
30 | 29 |
```{r echo=FALSE, results="hide", message=FALSE} |
31 | 30 |
library("ape") |
32 | 31 |
library("ggplot2") |
33 |
-library("ggtree") |
|
34 | 32 |
library("gridExtra") |
33 |
+library("ggtree") |
|
34 |
+collapse <- ggtree::collapse |
|
35 |
+expand <- ggtree::expand |
|
35 | 36 |
``` |
36 | 37 |
|
37 | 38 |
# Internal node number |
... | ... |
@@ -57,7 +58,7 @@ MRCA(p, tip=c('A', 'E')) |
57 | 58 |
|
58 | 59 |
# groupClade |
59 | 60 |
|
60 |
-The `r Githubpkg("GuangchuangYu/ggtree")` package defined several functions to manipulate tree view. _`groupClade`_ and _`groupOTU`_ methods for clustering clades or related OTUs. _`groupClade`_ accepts an internal node or a vector of internal nodes to cluster clade/clades. |
|
61 |
+The `ggtree` package defined several functions to manipulate tree view. _`groupClade`_ and _`groupOTU`_ methods for clustering clades or related OTUs. _`groupClade`_ accepts an internal node or a vector of internal nodes to cluster clade/clades. |
|
61 | 62 |
|
62 | 63 |
Both _`groupClade`_ and _`groupOTU`_ work fine with tree object or tree view. |
63 | 64 |
|
... | ... |
@@ -113,6 +114,15 @@ p <- ggtree(tree) |
113 | 114 |
groupOTU(p, LETTERS[1:5]) + aes(color=group) + geom_tiplab() + scale_color_manual(values=c("black", "firebrick")) |
114 | 115 |
``` |
115 | 116 |
|
117 |
+```{r fig.width=14, fig.height=14} |
|
118 |
+library("ape") |
|
119 |
+data(chiroptera) |
|
120 |
+groupInfo <- split(chiroptera$tip.label, gsub("_\\w+", "", chiroptera$tip.label)) |
|
121 |
+chiroptera <- groupOTU(chiroptera, groupInfo) |
|
122 |
+ggtree(chiroptera, aes(color=group), layout='circular') + geom_tiplab(size=1, aes(angle=angle)) |
|
123 |
+``` |
|
124 |
+ |
|
125 |
+<!-- |
|
116 | 126 |
## iris example |
117 | 127 |
|
118 | 128 |
In this example, we first build a tree based on the iris data, then grouping the tree based on different spacies. |
... | ... |
@@ -134,7 +144,7 @@ ggtree(tree_iris, aes(color=group)) + |
134 | 144 |
labels=c("Setosa", "Versicolor", "Virginica")) + |
135 |