Browse code

inset function and update vignette

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@112112 bc3139a8-67e5-0310-9ffc-ced21a209358

Guangchuang Yu authored on 04/01/2016 09:56:10
Showing 24 changed files

... ...
@@ -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{
... ...
@@ -1,5 +1,5 @@
1 1
 % Generated by roxygen2: do not edit by hand
2
-% Please edit documentation in R/tree-utilities.R
2
+% Please edit documentation in R/method-gzoom.R
3 3
 \name{gzoom.phylo}
4 4
 \alias{gzoom.phylo}
5 5
 \title{gzoom}
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
+![](../inst/extdata/phylopic1.png)
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
+![](../inst/extdata/phylopic2.png)
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
-![](../inst/extdata/phylopic1.png)
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
-![](../inst/extdata/phylopic2.png)
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
 ![](figures/ggtree_objects.png)
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