Browse code

upgrade to 0.99.6

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

Guangchuang Yu authored on 16/01/2015 02:39:28
Showing 32 changed files

... ...
@@ -1,20 +1,35 @@
1 1
 Package: ggtree
2 2
 Type: Package
3
-Title: a phylogenetic tree viewer for different types of tree
4
-        annotations
5
-Version: 0.99.5
3
+Title: a phylogenetic tree viewer for different types of tree annotations
4
+Version: 0.99.6
6 5
 Author: Guangchuang Yu
7 6
 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>
8
-Description: ggtree extends the ggplot2 plotting system which
9
-        implemented the grammar of graphics. ggtree is designed for
10
-        visualizing phylogenetic tree and different types of associated
11
-        annotation data.
12
-Depends: R (>= 3.1.0), ape, ggplot2
13
-Imports: Biostrings, grid, gridExtra, jsonlite, magrittr, methods,
14
-        reshape2, stats4
15
-Suggests: phylobase, BiocStyle, knitr, testthat, rmarkdown
7
+Description: ggtree extends the ggplot2 plotting system which implemented the
8
+    grammar of graphics. ggtree is designed for visualizing phylogenetic tree
9
+    and different types of associated annotation data.
10
+Depends:
11
+    R (>= 3.1.0)
12
+Imports:
13
+    ape,
14
+    Biostrings,
15
+    ggplot2,
16
+    grid,
17
+    gridExtra,
18
+    jsonlite,
19
+    magrittr,
20
+    methods,
21
+    reshape2,
22
+    stats4
23
+Suggests:
24
+    phylobase,
25
+    BiocStyle,
26
+    colorspace,
27
+    knitr,
28
+    testthat,
29
+    rmarkdown
16 30
 VignetteBuilder: knitr
17 31
 License: Artistic-2.0
18 32
 URL: https://github.com/GuangchuangYu/ggtree
19 33
 BugReports: https://github.com/GuangchuangYu/ggtree/issues
34
+Packaged: 2014-12-03 08:16:14 UTC; root
20 35
 biocViews: Visualization
... ...
@@ -13,19 +13,26 @@ S3method(fortify,phylo4)
13 13
 export("%<%")
14 14
 export("%<+%")
15 15
 export(.)
16
+export(aes)
16 17
 export(as.binary)
17 18
 export(geom_aline)
19
+export(geom_text)
18 20
 export(geom_tiplab)
19 21
 export(geom_tippoint)
20 22
 export(geom_tree)
21 23
 export(get.fields)
24
+export(get.offspring.tip)
22 25
 export(get.placements)
23 26
 export(get.subs)
27
+export(get.tipseq)
24 28
 export(get.tree)
25 29
 export(get.treeinfo)
26 30
 export(get.treetext)
31
+export(ggplotGrob)
27 32
 export(ggtree)
28 33
 export(gplot)
34
+export(groupOTU)
35
+export(gzoom)
29 36
 export(plot)
30 37
 export(read.baseml)
31 38
 export(read.beast)
... ...
@@ -34,6 +41,8 @@ export(read.codeml_mlc)
34 41
 export(read.hyphy)
35 42
 export(read.jplace)
36 43
 export(read.paml_rst)
44
+export(read.tree)
45
+export(rtree)
37 46
 export(theme_tree)
38 47
 export(theme_tree2)
39 48
 export(write.jplace)
... ...
@@ -46,15 +55,18 @@ exportClasses(paml_rst)
46 55
 exportMethods(get.fields)
47 56
 exportMethods(get.placements)
48 57
 exportMethods(get.subs)
58
+exportMethods(get.tipseq)
49 59
 exportMethods(get.tree)
50 60
 exportMethods(get.treeinfo)
51 61
 exportMethods(get.treetext)
62
+exportMethods(groupOTU)
52 63
 exportMethods(plot)
53 64
 exportMethods(show)
54 65
 importFrom(Biostrings,GENETIC_CODE)
55 66
 importFrom(Biostrings,readBStringSet)
56 67
 importFrom(Biostrings,toString)
57 68
 importFrom(ape,Ntip)
69
+importFrom(ape,drop.tip)
58 70
 importFrom(ape,extract.clade)
59 71
 importFrom(ape,is.binary.tree)
60 72
 importFrom(ape,ladderize)
... ...
@@ -62,6 +74,7 @@ importFrom(ape,print.phylo)
62 74
 importFrom(ape,read.nexus)
63 75
 importFrom(ape,read.tree)
64 76
 importFrom(ape,reorder.phylo)
77
+importFrom(ape,which.edge)
65 78
 importFrom(ape,write.tree)
66 79
 importFrom(ggplot2,"%+replace%")
67 80
 importFrom(ggplot2,aes)
... ...
@@ -79,11 +92,13 @@ importFrom(ggplot2,geom_segment)
79 92
 importFrom(ggplot2,geom_text)
80 93
 importFrom(ggplot2,geom_tile)
81 94
 importFrom(ggplot2,ggplot)
95
+importFrom(ggplot2,scale_color_manual)
82 96
 importFrom(ggplot2,scale_fill_gradient)
83 97
 importFrom(ggplot2,scale_x_reverse)
84 98
 importFrom(ggplot2,theme)
85 99
 importFrom(ggplot2,theme_bw)
86 100
 importFrom(ggplot2,xlab)
101
+importFrom(ggplot2,xlim)
87 102
 importFrom(ggplot2,ylab)
88 103
 importFrom(grid,unit)
89 104
 importFrom(gridExtra,grid.arrange)
... ...
@@ -1,5 +1,14 @@
1
+CHANGES IN VERSION 0.99.6
2
+------------------------
3
+ o add example of gzoom and groupOTU in vignette <2015-01-14, Wed> 
4
+ o implement groupOTU methods <2015-01-14, Wed>
5
+ o export get.offspring.tip <2015-01-14, Wed>
6
+
1 7
 CHANGES IN VERSION 0.99.5
2 8
 ------------------------
9
+ o move ape and ggplot2 from Depends to Imports <2015-01-12, Mon>
10
+ o get.tipseq method for paml_rst and codeml object <2015-01-08, Thu>
11
+ o add gzoom function, similar to zoom function in ape <2015-01-07, Wed>
3 12
  o add examples in man pages of %<% and %<+% operators <2015-01-06, Tue>
4 13
  o remove <<- and update vignette <2015-01-06, Tue>
5 14
  o update vignette and use BibTex and CSL for references <2015-01-05, Mon>  
... ...
@@ -146,6 +146,7 @@ setClass("codeml",
146 146
 ##' @docType class
147 147
 ##' @slot fields colnames of first variable of placements
148 148
 ##' @slot treetext tree text
149
+##' @slot phylo tree phylo object
149 150
 ##' @slot placements placement information
150 151
 ##' @slot version version
151 152
 ##' @slot metadata metadata
... ...
@@ -159,6 +160,7 @@ setClass("jplace",
159 160
          representation = representation(
160 161
              fields     = "character",
161 162
              treetext   = "character",
163
+             phylo      = "phylo",
162 164
              placements = "data.frame",
163 165
              version    = "numeric",
164 166
              metadata   = "list",
... ...
@@ -93,3 +93,24 @@ setGeneric("get.placements", function(object, by, ...) standardGeneric("get.plac
93 93
 setGeneric("get.subs", function(object, type, ...) standardGeneric("get.subs"))
94 94
 
95 95
 
96
+##' @docType methods
97
+##' @name get.tipseq
98
+##' @rdname get.tipseq-methods
99
+##' @title get.tipseq method
100
+##' @param object one of paml_rst or codeml object
101
+##' @param ... additional parameter
102
+##' @return character
103
+##' @export
104
+setGeneric("get.tipseq", function(object, ...) standardGeneric("get.tipseq"))
105
+
106
+##' @docType methods
107
+##' @name groupOTU
108
+##' @rdname groupOTU-methods
109
+##' @title groupOTU method
110
+##' @param object supported objects, including phylo, paml_rst,
111
+##'               codeml_mlc, codeml, jplace, beast, hyphy
112
+##' @param focus a vector of tip (label or number) or a list of tips.
113
+##' @return group index
114
+##' @export
115
+setGeneric("groupOTU", function(object, focus) standardGeneric("groupOTU"))
116
+
96 117
new file mode 100644
... ...
@@ -0,0 +1,45 @@
1
+##' read newick tree
2
+##' @export
3
+##' @rdname read.tree
4
+##' @param file file name
5
+##' @param text alternatively, using newick text
6
+##' @param tree.names if read several trees, specify their names
7
+##' @param skip number of lines of the input file to skip
8
+##' @param comment.char a single character,
9
+##'                     the remaining of the line after this character is ignored.
10
+##' @param keep.multi if 'TRUE' and 'tree.names = NULL'
11
+##'                   then single trees are returned in 'multiPhylo' format
12
+##'                   with any name that is present. Default is 'FALSE'
13
+##' @param ... further arguments to be passed to 'scan()'.
14
+##' @source
15
+##' This is just the imported function
16
+##' from the ape package. The documentation you should
17
+##' read for the read.tree function can be found here: \link[ape]{read.tree}
18
+##'
19
+##' @seealso
20
+##' \link[ape]{read.tree}
21
+read.tree <- ape::read.tree
22
+
23
+
24
+##' generate random tree
25
+##' @export
26
+##' @rdname rtree
27
+##' @param n number of tips in the tree
28
+##' @param rooted logcial
29
+##' @param tip.label tip label
30
+##' @param br one of the following: (i) an R function used to generate the
31
+##'           branch lengths ('rtree'; use 'NULL' to simulate only a
32
+##'           topology), or the coalescence times ('rcoal'); (ii) a
33
+##'           character to simulate a genuine coalescent tree for 'rcoal'
34
+##'           (the default); or (iii) a numeric vector for the branch
35
+##'           lengths or the coalescence times.
36
+##' @param ... additional parameters to be passed to 'br'
37
+##' @source
38
+##' This is just the imported function
39
+##' from the ape package. The documentation you should
40
+##' read for the rtree function can be found here: \link[ape]{rtree}
41
+##'
42
+##' @seealso
43
+##' \link[ape]{rtree}
44
+rtree <- ape::rtree
45
+
... ...
@@ -81,6 +81,13 @@ setMethod("show", signature(object = "beast"),
81 81
               print_fields(object)              
82 82
           })
83 83
 
84
+##' @rdname groupOTU-methods
85
+##' @exportMethod groupOTU
86
+setMethod("groupOTU", signature(object="beast"),
87
+          function(object, focus) {
88
+              groupOTU_(object, focus)
89
+          }
90
+          )
84 91
 
85 92
 ##' get.tree method
86 93
 ##'
... ...
@@ -22,6 +22,14 @@ read.codeml <- function(rstfile, mlcfile) {
22 22
 }
23 23
 
24 24
 
25
+##' @rdname groupOTU-methods
26
+##' @exportMethod groupOTU
27
+setMethod("groupOTU", signature(object="codeml"),
28
+          function(object, focus) {
29
+              groupOTU_(object, focus)
30
+          }
31
+          )
32
+
25 33
 ##' @rdname show-methods
26 34
 ##' @exportMethod show
27 35
 setMethod("show", signature(object = "codeml"),
... ...
@@ -36,6 +44,12 @@ setMethod("show", signature(object = "codeml"),
36 44
               print_fields(object, len=4)
37 45
           })
38 46
 
47
+##' @rdname get.tipseq-methods
48
+##' @exportMethod get.tipseq
49
+setMethod("get.tipseq", signature(object = "codeml"),
50
+          function(object, ...) {
51
+              return(object@rst@tip_seq)
52
+          })
39 53
 
40 54
 ##' @rdname get.tree-methods
41 55
 ##' @exportMethod get.tree
... ...
@@ -78,7 +92,7 @@ setMethod("plot", signature(x = "codeml"),
78 92
                    tip.label.size   = 4,
79 93
                    tip.label.hjust  = -0.1,
80 94
                    position         = "branch",
81
-                   annotation       = "dN.dS",
95
+                   annotation       = "dN_vs_dS",
82 96
                    annotation.size  = 3,
83 97
                    annotation.color = "black",
84 98
                    ndigits          = 2,
... ...
@@ -23,6 +23,14 @@ read.codeml_mlc <- function(mlcfile) {
23 23
         mlcfile  = mlcfile)
24 24
 }
25 25
 
26
+##' @rdname groupOTU-methods
27
+##' @exportMethod groupOTU
28
+setMethod("groupOTU", signature(object="codeml_mlc"),
29
+          function(object, focus) {
30
+              groupOTU_(object, focus)
31
+          }
32
+          )
33
+
26 34
 ##' @rdname show-methods
27 35
 ##' @exportMethod show
28 36
 setMethod("show", signature(object = "codeml_mlc"),
29 37
new file mode 100644
... ...
@@ -0,0 +1,47 @@
1
+##' creates a lists of unevaluated expressions
2
+##' @export
3
+##' @rdname aes
4
+##' @param x name values
5
+##' @param y name values
6
+##' @param ... additional name values
7
+##' @source
8
+##' This is just the imported function
9
+##' from the ggplot2 package. The documentation you should
10
+##' read for the aes function can be found here: \link[ggplot2]{aes}
11
+##'
12
+##' @seealso
13
+##' \link[ggplot2]{aes}
14
+aes <- ggplot2::aes
15
+
16
+
17
+##' generate a ggplot2 plot grob
18
+##' @export
19
+##' @rdname ggplotGrob
20
+##' @param x ggplot2 object
21
+##' @source
22
+##' This is just the imported function
23
+##' from the ggplot2 package. The documentation you should
24
+##' read for the ggplotGrob function can be found here: \link[ggplot2]{ggplotGrob}
25
+##' 
26
+##' @seealso
27
+##' \link[ggplot2]{ggplotGrob}
28
+ggplotGrob <- ggplot2::ggplotGrob
29
+
30
+##' text annotations
31
+##' @export
32
+##' @rdname geom_text
33
+##' @param mapping the aesthetic mapping
34
+##' @param data A layer specific dataset -
35
+##'             only needed if you want to override he plot defaults.
36
+##' @param stat The statistical transformation to use on the data for this layer
37
+##' @param position The position adjustment to use for overlapping points on this layer
38
+##' @param parse if TRUE, the labels will be passd into expressions
39
+##' @param ... other arguments passed on to 'layer'
40
+##' @source
41
+##' This is just the imported function
42
+##' from the ggplot2 package. The documentation you should
43
+##' read for the geom_text function can be found here: \link[ggplot2]{geom_text}
44
+##'
45
+##' @seealso
46
+##' \link[ggplot2]{geom_text}
47
+geom_text <- ggplot2::geom_text
... ...
@@ -89,6 +89,14 @@ setMethod("plot", signature(x = "hyphy"),
89 89
                         annotation.size,...)
90 90
           })
91 91
 
92
+##' @rdname groupOTU-methods
93
+##' @exportMethod groupOTU
94
+setMethod("groupOTU", signature(object="hyphy"),
95
+          function(object, focus) {
96
+              groupOTU_(object, focus)
97
+          }
98
+          )
99
+
92 100
 ##' @rdname show-methods
93 101
 ##' @exportMethod show
94 102
 setMethod("show", signature(object = "hyphy"),
... ...
@@ -17,6 +17,7 @@ read.jplace <- function(file) {
17 17
          new("jplace",
18 18
              fields     = fields,
19 19
              treetext   = tree,
20
+             phylo      = jplace_treetext_to_phylo(tree),
20 21
              placements = placements,
21 22
              version    = version,
22 23
              metadata   = metadata,
... ...
@@ -25,12 +26,19 @@ read.jplace <- function(file) {
25 26
          )
26 27
 }
27 28
 
29
+##' @rdname groupOTU-methods
30
+##' @exportMethod groupOTU
31
+setMethod("groupOTU", signature(object="jplace"),
32
+          function(object, focus) {
33
+              groupOTU_(object, focus)
34
+          }
35
+          )
28 36
 
29 37
 ##' @rdname get.tree-methods
30 38
 ##' @exportMethod get.tree
31 39
 setMethod("get.tree", signature(object="jplace"),
32 40
           function(object) {
33
-              jplace_treetext_to_phylo(object@treetext)
41
+              object@phylo
34 42
           })
35 43
 
36 44
 
... ...
@@ -138,7 +146,6 @@ setMethod("get.fields", signature(object = "jplace"),
138 146
           }
139 147
           )
140 148
 
141
-
142 149
 ##' get.placement method
143 150
 ##'
144 151
 ##'
... ...
@@ -200,8 +207,7 @@ get.fields.jplace <- function(object, ...) {
200 207
 
201 208
 get.treeinfo.jplace <- function(object, layout,
202 209
                                 ladderize, right, ...) {
203
-    tree.text <- get.treetext(object)
204
-    extract.treeinfo.jplace(tree.text, layout,
210
+    extract.treeinfo.jplace(object, layout,
205 211
                             ladderize, right)
206 212
 }
207 213
 
... ...
@@ -17,9 +17,7 @@ read.tip_seq_mlc <- function(mlcfile) {
17 17
     return(res)
18 18
 }
19 19
 
20
-read.tip_seq_mlb <- function(mlbfile) {
21
-    read.tip_seq_mlc(mlbfile)
22
-}
20
+read.tip_seq_mlb <- read.tip_seq_mlc
23 21
 
24 22
 read.dnds_mlc <- function(mlcfile) {
25 23
     mlc <- readLines(mlcfile)
... ...
@@ -114,7 +112,7 @@ read.phylo_paml_mlc <- function(mlcfile) {
114 112
                     jj <- which(treeinfo.tr3[, "node"] == jp)
115 113
                     treeinfo[ii, "label"] <- as.character(ip)
116 114
                     treeinfo.tr3[jj, "label"] <- as.character(ip)
117
-                    treeinfo[ii, "length"] <- treeinfo.tr3[jj, "length"]
115
+                    treeinfo[ii, "length"] <- treeinfo.tr3[jj, "branch.length"]
118 116
                     pNode <- c(pNode, ip)
119 117
                 }
120 118
                 treeinfo[ii, "visited"] <- TRUE
... ...
@@ -60,6 +60,25 @@ read.paml_rst <- function(rstfile, tip.fasfile = NULL) {
60 60
     set.paml_rst_(res)
61 61
 }
62 62
 
63
+##' @rdname groupOTU-methods
64
+##' @exportMethod groupOTU
65
+setMethod("groupOTU", signature(object="paml_rst"),
66
+          function(object, focus) {
67
+              groupOTU_(object, focus)
68
+          }
69
+          )
70
+
71
+
72
+##' @rdname get.tipseq-methods
73
+##' @exportMethod get.tipseq
74
+setMethod("get.tipseq", signature(object="paml_rst"),
75
+          function(object, ...) {
76
+              if (length(object@tip_seq) == 0) {
77
+                  warning("tip sequence not available...\n")
78
+              } else {
79
+                  object@tip_seq
80
+              }
81
+          })
63 82
 
64 83
 ##' @rdname show-methods
65 84
 ##' @exportMethod show
... ...
@@ -1,3 +1,100 @@
1
+##' @rdname groupOTU-methods
2
+##' @exportMethod groupOTU
3
+setMethod("groupOTU", signature(object="phylo"),
4
+          function(object, focus) {
5
+              groupOTU.phylo(object, focus)
6
+          })
7
+
8
+
9
+groupOTU_ <- function(object, focus) {
10
+    groupOTU.phylo(get.tree(object), focus)
11
+}
12
+
13
+##' group OTU
14
+##'
15
+##' 
16
+##' @title groupOTU.phylo
17
+##' @param phy tree object
18
+##' @param focus tip list
19
+##' @return cluster index
20
+##' @author ygc
21
+groupOTU.phylo <- function(phy, focus) {
22
+    if ( is(focus, "list") ) {
23
+        for (i in 1:length(focus)) {
24
+            phy <- gfocus(phy, focus[[i]])
25
+        } 
26
+    } else {
27
+        phy <- gfocus(phy, focus)
28
+    }
29
+    attr(phy, "focus")
30
+}
31
+
32
+##' @importFrom ape which.edge
33
+gfocus <- function(phy, focus) {
34
+    if (is.character(focus)) {
35
+        focus <- which(phy$tip.label %in% focus)
36
+    }
37
+    
38
+    n <- getNodeNum(phy)
39
+    if (is.null(attr(phy, "focus"))) {
40
+        foc <- rep(1, 2*n)
41
+    } else {
42
+        foc <- attr(phy, "focus")
43
+    }
44
+    i <- max(foc) + 1
45
+    sn <- phy$edge[which.edge(phy, focus),] %>% as.vector %>% unique
46
+    foc[sn] <- i
47
+    foc[sn+n] <- i
48
+    attr(phy, "focus") <- foc
49
+
50
+    ## sn <- which(df$focus != 1)
51
+    ## df$focus[df$parent] -> f2
52
+    ## f2[-sn] <- 1
53
+
54
+    phy
55
+}
56
+
57
+##' plots simultaneously a whole phylogenetic tree and a portion of it. 
58
+##'
59
+##' 
60
+##' @title gzoom
61
+##' @param phy phylo object
62
+##' @param focus selected tips
63
+##' @param subtree logical
64
+##' @param widths widths
65
+##' @return a list of ggplot object
66
+##' @importFrom ggplot2 xlim
67
+##' @importFrom ggplot2 scale_color_manual
68
+##' @importFrom ape drop.tip
69
+##' @export
70
+##' @author ygc
71
+##' @examples
72
+##' require(ape)
73
+##' data(chiroptera)
74
+##' gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label))
75
+gzoom <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {
76
+    if (is.character(focus)) {
77
+        focus <- which(phy$tip.label %in% focus)
78
+    }
79
+
80
+    phy <- gfocus(phy, focus)
81
+
82
+    foc <- attr(phy, "focus")
83
+    cols <- c("black", "red")[foc]
84
+    
85
+    p1 <- ggplot(phy) + geom_tree(colour=cols) +
86
+        xlab("") + ylab("") + theme_tree()
87
+    
88
+    subtr <- drop.tip(phy, phy$tip.label[-focus],
89
+                      subtree=subtree, rooted=TRUE)
90
+    
91
+    p2 <- ggtree(subtr, color="red") + geom_tiplab(hjust=-0.05)
92
+    p2 <- p2 + xlim(0, max(p2$data$x)*1.2)
93
+    grid.arrange(p1, p2, ncol=2, widths=widths)
94
+    
95
+    invisible(list(p1=p1, p2=p2))
96
+}
97
+
1 98
 
2 99
 ##' update tree 
3 100
 ##'
... ...
@@ -10,6 +107,7 @@
10 107
 ##' @export
11 108
 ##' @author Yu Guangchuang
12 109
 ##' @examples
110
+##' library("ggplot2")
13 111
 ##' nwk <- system.file("extdata", "sample.nwk", package="ggtree")
14 112
 ##' tree <- read.tree(nwk)
15 113
 ##' p <- ggtree(tree) + geom_point(subset=.(!isTip), 
... ...
@@ -103,7 +201,16 @@ layout.unrooted <- function(tree) {
103 201
 }
104 202
 
105 203
 
204
+##' extract offspring tips
205
+##'
206
+##' 
207
+##' @title get.offspring.tip
208
+##' @param tr tree
209
+##' @param node node
210
+##' @return tip label
211
+##' @author ygc
106 212
 ##' @importFrom ape extract.clade
213
+##' @export
107 214
 get.offspring.tip <- function(tr, node) {
108 215
     if ( ! node %in% tr$edge[,1]) {
109 216
         ## return itself
... ...
@@ -337,7 +337,9 @@ fortify.phylo <- function(model, data, layout="phylogram",
337 337
     idx <- is.na(df$parent)
338 338
     df$parent[idx] <- df$node[idx]
339 339
     rownames(df) <- df$node
340
-    
340
+    cn <- colnames(df)
341
+    colnames(df)[grep("length", cn)] <- "branch.length"
342
+
341 343
     return(df)
342 344
 }
343 345
 
... ...
@@ -399,7 +401,9 @@ as.data.frame.phylo_ <- function(x, layout="phylogram",
399 401
     isTip[1:Ntip] <- TRUE
400 402
     res$isTip <- isTip
401 403
     res$branch <- (res$x[res$parent] + res$x)/2
402
-    res$length[is.na(res$length)] <- 0
404
+    if (!is.null(res$length)) {
405
+        res$length[is.na(res$length)] <- 0
406
+    }
403 407
     res$branch[is.na(res$branch)] <- 0
404 408
     return(res)
405 409
 }
... ...
@@ -149,26 +149,38 @@ reverse.treeview.data <- function(df) {
149 149
 jplace_treetext_to_phylo <- function(tree.text) {
150 150
     ## move edge label to node label separate by @
151 151
     tr <- gsub('(:[0-9.e-]+)\\{(\\d+)\\}', '\\@\\2\\1', tree.text)
152
-    read.tree(text=tr)
152
+    phylo <- read.tree(text=tr)
153
+    if (length(grep('@', phylo$tip.label)) > 0) {
154
+        phylo$node.label[1] %<>% gsub("(.*)\\{(\\d+)\\}", "\\1@\\2", .)
155
+        tip.edgeNum <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",phylo$tip.label))
156
+        node.edgeNum <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",phylo$node.label))
157
+        phylo$tip.label %<>% gsub("@\\d+", "", .)
158
+        phylo$node.label %<>% gsub("@\\d+", "", .)
159
+        if (all(phylo$node.label == "")) {
160
+            phylo$node.label <- NULL
161
+        }
162
+
163
+        N <- getNodeNum(phylo)
164
+        edgeNum.df <- data.frame(node=1:N, edgeNum=c(tip.edgeNum, node.edgeNum))
165
+        edgeNum.df <- edgeNum.df[!is.na(edgeNum.df[,2]),]
166
+        edgeNum <- edgeNum.df[match( phylo$edge[,2], edgeNum.df$node), 2]
167
+        attr(phylo, "edgeNum") <- edgeNum
168
+    }
169
+    return(phylo)
153 170
 }
154 171
 
155
-extract.treeinfo.jplace <- function(tree.text, layout="phylogram", ladderize=TRUE, right=FALSE) {
172
+extract.treeinfo.jplace <- function(object, layout="phylogram", ladderize=TRUE, right=FALSE) {
156 173
 
157
-    tree <- jplace_treetext_to_phylo(tree.text)
174
+    tree <- get.tree(object)
158 175
     
159 176
     df <- fortify.phylo(tree, layout=layout, ladderize=ladderize, right=right)
160 177
 
161
-    root.idx <- which(df$parent == df$node)
162
-    root.lab <- df[,"label"]
163
-    df$label[root.idx] <- gsub("(.*)\\{(\\d+)\\}", "\\1@\\2", df$label[root.idx])
164
-
165
-    if ( length(grep('@', df$label)) > 0) {
166
-        df$edge <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",df$label))
178
+    edgeNum <- attr(tree, "edgeNum")
179
+    if (!is.null(edgeNum)) {
180
+        edgeNum.df <- data.frame(node=tree$edge[,2], edge=edgeNum)
181
+        df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE) 
182
+        df <- df2[match(df[, "node"], df2[, "node"]),]
167 183
     }
168
-    
169
-    ## remove edge label from node label
170
-    df$label <- gsub("@\\d*", "", df$label)
171
-    df$label[df$label == ""] <- NA
172 184
     attr(df, "ladderize") <- ladderize
173 185
     attr(df, "right") <- right
174 186
     return(df)
175 187
new file mode 100644
... ...
@@ -0,0 +1,21 @@
1
+citHeader("To cite ggtree in publications use:")
2
+
3
+citEntry(
4
+    entry  = "article",
5
+    title  = "ggtree: a phylogenetic tree viewer for different types of tree annotations",
6
+    author = personList(
7
+        as.person("Guangchuang Yu")
8
+    ),
9
+    year    = "2015",
10
+    journal = "submitted",
11
+    volume  = "",
12
+    issue   = "",
13
+    number  = "",
14
+    pages   = "",
15
+    doi     = "",
16
+    PMID    = "",
17
+    url     = "", 
18
+    textVersion =
19
+        "Guangchuang Yu. (2015) ggtree: a phylogenetic tree viewer for different types of tree annotations. submitted"
20
+)
21
+
0 22
new file mode 100644
... ...
@@ -0,0 +1,27 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/ggplot2.R
3
+\name{aes}
4
+\alias{aes}
5
+\title{creates a lists of unevaluated expressions}
6
+\source{
7
+This is just the imported function
8
+from the ggplot2 package. The documentation you should
9
+read for the aes function can be found here: \link[ggplot2]{aes}
10
+}
11
+\usage{
12
+aes(x, y, ...)
13
+}
14
+\arguments{
15
+\item{x}{name values}
16
+
17
+\item{y}{name values}
18
+
19
+\item{...}{additional name values}
20
+}
21
+\description{
22
+creates a lists of unevaluated expressions
23
+}
24
+\seealso{
25
+\link[ggplot2]{aes}
26
+}
27
+
0 28
new file mode 100644
... ...
@@ -0,0 +1,35 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/ggplot2.R
3
+\name{geom_text}
4
+\alias{geom_text}
5
+\title{text annotations}
6
+\source{
7
+This is just the imported function
8
+from the ggplot2 package. The documentation you should
9
+read for the geom_text function can be found here: \link[ggplot2]{geom_text}
10
+}
11
+\usage{
12
+geom_text(mapping = NULL, data = NULL, stat = "identity",
13
+  position = "identity", parse = FALSE, ...)
14
+}
15
+\arguments{
16
+\item{mapping}{the aesthetic mapping}
17
+
18
+\item{data}{A layer specific dataset -
19
+only needed if you want to override he plot defaults.}
20
+
21
+\item{stat}{The statistical transformation to use on the data for this layer}
22
+
23
+\item{position}{The position adjustment to use for overlapping points on this layer}
24
+
25
+\item{parse}{if TRUE, the labels will be passd into expressions}
26
+
27
+\item{...}{other arguments passed on to 'layer'}
28
+}
29
+\description{
30
+text annotations
31
+}
32
+\seealso{
33
+\link[ggplot2]{geom_text}
34
+}
35
+
0 36
new file mode 100644
... ...
@@ -0,0 +1,23 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/tree.R
3
+\name{get.offspring.tip}
4
+\alias{get.offspring.tip}
5
+\title{get.offspring.tip}
6
+\usage{
7
+get.offspring.tip(tr, node)
8
+}
9
+\arguments{
10
+\item{tr}{tree}
11
+
12
+\item{node}{node}
13
+}
14
+\value{
15
+tip label
16
+}
17
+\description{
18
+extract offspring tips
19
+}
20
+\author{
21
+ygc
22
+}
23
+
0 24
new file mode 100644
... ...
@@ -0,0 +1,27 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/AllGenerics.R, R/codeml.R, R/paml_rst.R
3
+\docType{methods}
4
+\name{get.tipseq}
5
+\alias{get.tipseq}
6
+\alias{get.tipseq,codeml-method}
7
+\alias{get.tipseq,paml_rst-method}
8
+\title{get.tipseq method}
9
+\usage{
10
+get.tipseq(object, ...)
11
+
12
+\S4method{get.tipseq}{codeml}(object, ...)
13
+
14
+\S4method{get.tipseq}{paml_rst}(object, ...)
15
+}
16
+\arguments{
17
+\item{object}{one of paml_rst or codeml object}
18
+
19
+\item{...}{additional parameter}
20
+}
21
+\value{
22
+character
23
+}
24
+\description{
25
+get.tipseq method
26
+}
27
+
0 28
new file mode 100644
... ...
@@ -0,0 +1,23 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/ggplot2.R
3
+\name{ggplotGrob}
4
+\alias{ggplotGrob}
5
+\title{generate a ggplot2 plot grob}
6
+\source{
7
+This is just the imported function
8
+from the ggplot2 package. The documentation you should
9
+read for the ggplotGrob function can be found here: \link[ggplot2]{ggplotGrob}
10
+}
11
+\usage{
12
+ggplotGrob(x)
13
+}
14
+\arguments{
15
+\item{x}{ggplot2 object}
16
+}
17
+\description{
18
+generate a ggplot2 plot grob
19
+}
20
+\seealso{
21
+\link[ggplot2]{ggplotGrob}
22
+}
23
+
0 24
new file mode 100644
... ...
@@ -0,0 +1,43 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R, R/tree.R
3
+\docType{methods}
4
+\name{groupOTU}
5
+\alias{groupOTU}
6
+\alias{groupOTU,beast-method}
7
+\alias{groupOTU,codeml-method}
8
+\alias{groupOTU,codeml_mlc-method}
9
+\alias{groupOTU,hyphy-method}
10
+\alias{groupOTU,jplace-method}
11
+\alias{groupOTU,paml_rst-method}
12
+\alias{groupOTU,phylo-method}
13
+\title{groupOTU method}
14
+\usage{
15
+groupOTU(object, focus)
16
+
17
+\S4method{groupOTU}{beast}(object, focus)
18
+
19
+\S4method{groupOTU}{codeml}(object, focus)
20
+
21
+\S4method{groupOTU}{codeml_mlc}(object, focus)
22
+
23
+\S4method{groupOTU}{hyphy}(object, focus)
24
+
25
+\S4method{groupOTU}{jplace}(object, focus)
26
+
27
+\S4method{groupOTU}{paml_rst}(object, focus)
28
+
29
+\S4method{groupOTU}{phylo}(object, focus)
30
+}
31
+\arguments{
32
+\item{object}{supported objects, including phylo, paml_rst,
33
+codeml_mlc, codeml, jplace, beast, hyphy}
34
+
35
+\item{focus}{a vector of tip (label or number) or a list of tips.}
36
+}
37
+\value{
38
+group index
39
+}
40
+\description{
41
+groupOTU method
42
+}
43
+
0 44
new file mode 100644
... ...
@@ -0,0 +1,23 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/tree.R
3
+\name{groupOTU.phylo}
4
+\alias{groupOTU.phylo}
5
+\title{groupOTU.phylo}
6
+\usage{
7
+groupOTU.phylo(phy, focus)
8
+}
9
+\arguments{
10
+\item{phy}{tree object}
11
+
12
+\item{focus}{tip list}
13
+}
14
+\value{
15
+cluster index
16
+}
17
+\description{
18
+group OTU
19
+}
20
+\author{
21
+ygc
22
+}
23
+
0 24
new file mode 100644
... ...
@@ -0,0 +1,32 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/tree.R
3
+\name{gzoom}
4
+\alias{gzoom}
5
+\title{gzoom}
6
+\usage{
7
+gzoom(phy, focus, subtree = FALSE, widths = c(0.3, 0.7))
8
+}
9
+\arguments{
10
+\item{phy}{phylo object}
11
+
12
+\item{focus}{selected tips}
13
+
14
+\item{subtree}{logical}
15
+
16
+\item{widths}{widths}
17
+}
18
+\value{
19
+a list of ggplot object
20
+}
21
+\description{
22
+plots simultaneously a whole phylogenetic tree and a portion of it.
23
+}
24
+\examples{
25
+require(ape)
26
+data(chiroptera)
27
+gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label))
28
+}
29
+\author{
30
+ygc
31
+}
32
+
... ...
@@ -21,6 +21,8 @@ This class stores information of jplace file.
21 21
 
22 22
 \item{\code{treetext}}{tree text}
23 23
 
24
+\item{\code{phylo}}{tree phylo object}
25
+
24 26
 \item{\code{placements}}{placement information}
25 27
 
26 28
 \item{\code{version}}{version}
... ...
@@ -19,8 +19,8 @@
19 19
 \S4method{plot}{codeml,ANY}(x, layout = "phylogram",
20 20
   branch.length = "mlc.branch.length", show.tip.label = TRUE,
21 21
   tip.label.size = 4, tip.label.hjust = -0.1, position = "branch",
22
-  annotation = "dN.dS", annotation.size = 3, annotation.color = "black",
23
-  ndigits = 2, ...)
22
+  annotation = "dN_vs_dS", annotation.size = 3,
23
+  annotation.color = "black", ndigits = 2, ...)
24 24
 
25 25
 \S4method{plot}{codeml_mlc,ANY}(x, layout = "phylogram",
26 26
   branch.length = "branch.length", show.tip.label = TRUE,
27 27
new file mode 100644
... ...
@@ -0,0 +1,39 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/ape.R
3
+\name{read.tree}
4
+\alias{read.tree}
5
+\title{read newick tree}
6
+\source{
7
+This is just the imported function
8
+from the ape package. The documentation you should
9
+read for the read.tree function can be found here: \link[ape]{read.tree}
10
+}
11
+\usage{
12
+read.tree(file = "", text = NULL, tree.names = NULL, skip = 0,
13
+  comment.char = "#", keep.multi = FALSE, ...)
14
+}
15
+\arguments{
16
+\item{file}{file name}
17
+
18
+\item{text}{alternatively, using newick text}
19
+
20
+\item{tree.names}{if read several trees, specify their names}
21
+
22
+\item{skip}{number of lines of the input file to skip}
23
+
24
+\item{comment.char}{a single character,
25
+the remaining of the line after this character is ignored.}
26
+
27
+\item{keep.multi}{if 'TRUE' and 'tree.names = NULL'
28
+then single trees are returned in 'multiPhylo' format
29
+with any name that is present. Default is 'FALSE'}
30
+
31
+\item{...}{further arguments to be passed to 'scan()'.}
32
+}
33
+\description{
34
+read newick tree
35
+}
36
+\seealso{
37
+\link[ape]{read.tree}
38
+}
39
+
0 40
new file mode 100644
... ...
@@ -0,0 +1,36 @@
1
+% Generated by roxygen2 (4.1.0): do not edit by hand
2
+% Please edit documentation in R/ape.R
3
+\name{rtree}
4
+\alias{rtree}
5
+\title{generate random tree}
6
+\source{
7
+This is just the imported function
8
+from the ape package. The documentation you should
9
+read for the rtree function can be found here: \link[ape]{rtree}
10
+}
11
+\usage{
12
+rtree(n, rooted = TRUE, tip.label = NULL, br = runif, ...)
13
+}
14
+\arguments{
15
+\item{n}{number of tips in the tree}
16
+
17
+\item{rooted}{logcial}
18
+
19
+\item{tip.label}{tip label}
20
+
21
+\item{br}{one of the following: (i) an R function used to generate the
22
+branch lengths ('rtree'; use 'NULL' to simulate only a
23
+topology), or the coalescence times ('rcoal'); (ii) a
24
+character to simulate a genuine coalescent tree for 'rcoal'
25
+(the default); or (iii) a numeric vector for the branch
26
+lengths or the coalescence times.}
27
+
28
+\item{...}{additional parameters to be passed to 'br'}
29
+}
30
+\description{
31
+generate random tree
32
+}
33
+\seealso{
34
+\link[ape]{rtree}
35
+}
36
+
... ...
@@ -18,6 +18,7 @@ updated ggplot object
18 18
 update tree
19 19
 }
20 20
 \examples{
21
+library("ggplot2")
21 22
 nwk <- system.file("extdata", "sample.nwk", package="ggtree")
22 23
 tree <- read.tree(nwk)
23 24
 p <- ggtree(tree) + geom_point(subset=.(!isTip),
... ...
@@ -21,12 +21,14 @@ vignette: >
21 21
   %\usepackage[utf8]{inputenc}
22 22
 ---
23 23
 
24
-```{r style, echo=FALSE, results="asis"}
24
+```{r style, echo=FALSE, results="hide", message=FALSE}
25 25
 BiocStyle::markdown()
26 26
 ```
27 27
 
28 28
 
29
-```{r echo=FALSE}
29
+```{r echo=FALSE, results="hide", message=FALSE}
30
+library("ape")
31
+library("ggplot2")
30 32
 library("ggtree")
31 33
 library("Biostrings")
32 34
 library("gridExtra")
... ...
@@ -53,6 +55,7 @@ nwk <- system.file("extdata", "sample.nwk", package="ggtree")
53 55
 x <- readLines(nwk)
54 56
 cat(substring(x, 1, 56), "\n", substring(x, 57), "\n")
55 57
 
58
+library("ggplot2")
56 59
 library("ggtree")
57 60
 
58 61
 tree <- read.tree(nwk)
... ...
@@ -128,7 +131,7 @@ ggtree(tree) + theme_tree2()
128 131
 Another way is to show the edge length of the tree. Besides, the scale of branch length can be specify via _`scale_x_continuous()`_. 
129 132
 ```{r fig.width=3, fig.height=3, warning=FALSE, fig.align="center"}
130 133
 ggtree(tree, showDistance=TRUE) +
131
-      geom_text(aes(label=length, x=branch), size = 3, 
134
+      geom_text(aes(label=branch.length, x=branch), size = 3, 
132 135
       		vjust=-0.5, color="#F06C45") +
133 136
       scale_x_continuous(breaks=seq(0, 60, 5))
134 137
 ```
... ...
@@ -468,7 +471,7 @@ ggtree(jp, showDistance=TRUE) +
468 471
 
469 472
 ## visualize tree and associated matrix
470 473
 ```{r}
471
-seqs <- ml@rst@tip_seq
474
+seqs <- get.tipseq(ml)
472 475
 library(Biostrings)
473 476
 x <- DNAStringSet(seqs)
474 477
 
... ...
@@ -485,19 +488,123 @@ head(dd)
485 488
 knitr::kable(head(dd))
486 489
 ```
487 490
 
488
-```{r fig.width=12, fig.heigh=6, fig.align="center"}
491
+```{r fig.width=12, fig.height=6, fig.align="center"}
489 492
 p <- ggtree(ml)
490 493
 gplot(p, dd, low="green", high="red", widths=c(.7, .3))
491 494
 ```
492 495
 
493 496
 Of course, we can use an annotated tree.
494 497
 
495
-```{r fig.width=12, fig.heigh=6, fig.align="center", warning=FALSE}
498
+```{r fig.width=12, fig.height=6, fig.align="center", warning=FALSE}
496 499
 p2 <- ggtree(ml, branch.length="none") + 
497
-          geom_text(aes(x=branch, label=dN_vs_dS), vjust=-.5, color="steelblue", size=4)	  
500
+          geom_text(aes(x=branch, label=dN_vs_dS, color=dN_vs_dS), 
501
+                    vjust=-.5, size=4) +
502
+             scale_color_gradient(low="darkgreen", high="red")	  
498 503
 gplot(p2, dd, low="green", high="red", widths=c(.7, .3))
499 504
 ```
500 505
 
506
+## zoom on a portion of tree
507
+
508
+`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.
509
+
510
+```{r fig.width=18, fig.height=10, fig.align="center"}
511
+library("ape")
512
+data(chiroptera)
513
+require(ggtree)
514
+gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label))
515
+```
516
+
517
+
518
+## group OTUs
519
+
520
+`r Githubpkg("GuangchuangYu/ggtree")` provides _`groupOTU`_ function to group tips and all their related ancestors. It return a cluster index of each line segment in the tree view.
521
+
522
+```{r}
523
+nwk <- system.file("extdata", "sample.nwk", package="ggtree")
524
+tree <- read.tree(nwk)
525
+
526
+
527
+cluster_index <- groupOTU(tree, focus=c("A", "B", "C", "D", "E"))
528
+cluster_index
529
+```
530
+In the _`cluster_index`_, _`1`_ represent the cluster that not selected, while other number represent the corresponding selected group(s).
531
+
532
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}
533
+ggtree(tree, color=c("black", "red")[cluster_index])
534
+```
535
+
536
+_`groupOTU`_ can also input a list of tip groups.
537
+
538
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}
539
+cls <- list(c1=c("A", "B", "C", "D", "E"),
540
+            c2=c("F", "G", "H"),
541
+            c3=c("L", "K", "I", "J"),
542
+            c4="M")
543
+
544
+cls_ind <- groupOTU(tree, cls)
545
+library("colorspace")
546
+cols <- rainbow_hcl(4)
547
+cols <- c("black", cols)
548
+ggtree(tree, color=cols[cls_ind]) + geom_tiplab()
549
+```
550
+
551
+We can change the linetype either:
552
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}
553
+linetype <- c("solid", "dotted", "dashed", "dotdash", "longdash")
554
+ggtree(tree, color=cols[cls_ind], linetype=linetype[cls_ind]) + geom_tiplab()
555
+```
556
+
557
+And also size:
558
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}
559
+size <- 1:5
560
+ggtree(tree, color=cols[cls_ind], linetype=linetype[cls_ind], size=size[cls_ind]) + geom_tiplab()
561
+```
562
+
563
+All the tree classes defined in `r Githubpkg("GuangchuangYu/ggtree")`, including _`beast`_, _`paml_rst`_, _`codeml_mlc`_, _`codeml`_, _`hyphy`_ and _`jplace`_ are all supported.
564
+
565
+For example:
566
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}
567
+ind <- groupOTU(ml, c("A", "B", "F", "M"))
568
+cols <- c("black", "blue")
569
+ggtree(ml, color=cols[ind])
570
+```
571
+
572
+### iris example
573
+
574
+In this example, we first build a tree based on the iris data.
575
+```{r fig.width=20, fig.height=20, fig.align="center", warning=FALSE}
576
+data(iris)
577
+rownames(iris) <- paste0(iris[,5], "_", 1:150)
578
+d_iris <- dist(iris[,-5], method="man")
579
+
580
+tree_iris <- bionj(d_iris)
581
+ggtree(tree_iris) + geom_text(aes(label=node))
582
+```
583
+
584
+By adding a layer of internal node number, we can easily extract tip labels of a particular clade by the _`get.offspring.tip`_ function.
585
+```{r}
586
+cl1 <- get.offspring.tip(tree_iris, 242)
587
+cl2 <- get.offspring.tip(tree_iris, 152) 
588
+cl2 <- cl2[!cl2 %in% cl1]
589
+cl3 <- get.offspring.tip(tree_iris, 158)
590
+cl4 <- get.offspring.tip(tree_iris, 157)
591
+
592
+cls_ind <- groupOTU(tree_iris, list(cl1, cl2, cl3, cl4))
593
+```
594
+
595
+```{r fig.width=20, fig.height=24, fig.align="center", warning=FALSE}
596
+cols <- rainbow_hcl(3)
597
+cols <- c("black", cols, cols[2])
598
+species <- data.frame(otu=row.names(iris), species=iris[,5])
599
+
600
+ggtree(tree_iris, color=cols[cls_ind]) %<+% species + 
601
+     geom_text(aes(label=label, color=species), hjust=-0.1) +
602
+         scale_color_manual(values=cols[2:4])
603
+```
604
+
605
+This example demonstrates how the separation of the _`bionj`_ is very good with the _`setosa`_ species, but misses in labeling several _`versicolor`_ and _`virginica`_ species.
606
+
607
+
501 608
 
502 609
 # Session info
503 610
 Here is the output of `sessionInfo()` on the system on which this document was compiled: