Browse code

support phylip format

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

g.yu authored on 15/01/2016 04:55:05
Showing 46 changed files

... ...
@@ -2,5 +2,5 @@
2 2
 R/.DS_Store
3 3
 vignettes/.DS_Store
4 4
 *~
5
-*.Rhistrory
5
+*.Rhistory
6 6
 .svn
... ...
@@ -1 +1,4 @@
1 1
 .git
2
+.Rhistory
3
+R/.Rhistory
4
+
... ...
@@ -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.8
4
+Version: 1.3.10
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
... ...
@@ -13,6 +13,7 @@ S3method(fortify,nhx)
13 13
 S3method(fortify,obkData)
14 14
 S3method(fortify,paml_rst)
15 15
 S3method(fortify,phangorn)
16
+S3method(fortify,phylip)
16 17
 S3method(fortify,phylo)
17 18
 S3method(fortify,phylo4)
18 19
 S3method(fortify,r8s)
... ...
@@ -84,6 +85,7 @@ export(read.hyphy)
84 85
 export(read.jplace)
85 86
 export(read.nhx)
86 87
 export(read.paml_rst)
88
+export(read.phylip)
87 89
 export(read.r8s)
88 90
 export(read.raxml)
89 91
 export(read.tree)
... ...
@@ -110,6 +112,7 @@ exportClasses(jplace)
110 112
 exportClasses(nhx)
111 113
 exportClasses(paml_rst)
112 114
 exportClasses(phangorn)
115
+exportClasses(phylip)
113 116
 exportClasses(r8s)
114 117
 exportClasses(raxml)
115 118
 exportMethods(get.fields)
... ...
@@ -126,6 +129,7 @@ exportMethods(plot)
126 129
 exportMethods(reroot)
127 130
 exportMethods(scale_color)
128 131
 exportMethods(show)
132
+importFrom(Biostrings,BStringSet)
129 133
 importFrom(Biostrings,DNAStringSet)
130 134
 importFrom(Biostrings,GENETIC_CODE)
131 135
 importFrom(Biostrings,readBStringSet)
... ...
@@ -174,6 +178,7 @@ importFrom(ggplot2,ggplotGrob)
174 178
 importFrom(ggplot2,ggproto)
175 179
 importFrom(ggplot2,guide_legend)
176 180
 importFrom(ggplot2,guides)
181
+importFrom(ggplot2,last_plot)
177 182
 importFrom(ggplot2,layer)
178 183
 importFrom(ggplot2,position_nudge)
179 184
 importFrom(ggplot2,scale_color_manual)
... ...
@@ -1,5 +1,10 @@
1
+CHANGES IN VERSION 1.3.10
2
+------------------------
3
+ o support phylip tree format and update vignette of phylip example <2016-01-15, Fri>
4
+
1 5
 CHANGES IN VERSION 1.3.9
2 6
 ------------------------
7
+ o optimize getYcoord <2016-01-14, Thu>
3 8
  o add 'multiPhylo' example in 'Tree Visualization' vignette <2016-01-13, Wed>
4 9
  o viewClade, scaleClade, collapse, expand, rotate, flip, get_taxa_name and scale_x_ggtree accepts input tree_view=NULL.
5 10
    these function will access the last plot if tree_view=NULL. <2016-01-13, Wed>
... ...
@@ -3,98 +3,23 @@ setOldClass("multiPhylo")
3 3
 setOldClass("gg")
4 4
 setOldClass("ggplot")
5 5
 
6
-supported_tree_object <- function() {
7
-    c("hyphy", "r8s", "nhx", "apeBootstrap", "raxml",
8
-      "paml_rst", "phangorn", "codeml_mlc", "codeml",
9
-      "jplace", "beast")
10
-}
6
+setClassUnion("phyloOrmultiPhylo", c("phylo", "multiPhylo"))
11 7
 
12
-##' Class "hyphy"
13
-##' This class stores information of HYPHY output
14
-##'
15
-##'
16
-##' @name hyphy-class
17
-##' @docType class
18
-##' @slot fields available features
19
-##' @slot treetext tree text
20
-##' @slot phylo phylo object
21
-##' @slot seq_type one of "NT" and "AA"
22
-##' @slot subs sequence substitutions
23
-##' @slot AA_subs Amino acid sequence substitution
24
-##' @slot ancseq ancestral sequences
25
-##' @slot tip_seq tip sequences
26
-##' @slot tip.fasfile fasta file of tip sequences
27
-##' @slot tree.file tree file
28
-##' @slot ancseq.file ancestral sequence file, nexus format
29
-##' @slot extraInfo extra information
30
-##' @exportClass hyphy
31
-##' @author Guangchuang Yu \url{http://ygc.name}
32
-##' @seealso \linkS4class{paml_rst}
33
-##' @keywords classes
34
-setClass("hyphy",
35
-         representation  = representation(
36
-             fields      = "character",
37
-             treetext    = "character",
38
-             phylo       = "phylo",
39
-             seq_type    = "character",
40
-             subs        = "data.frame",
41
-             AA_subs     = "data.frame",
42
-             ancseq      = "character",
43
-             tip_seq     = "character",
44
-             tip.fasfile = "character",
45
-             tree.file   = "character",
46
-             ancseq.file = "character",
47
-             extraInfo   = "data.frame"
48
-             )
49
-         )
50
-##' Class "r8s"
51
-##' This class stores output info from r8s
52
-##'
53
-##'
54
-##' @name r8s-class
55
-##' @docType class
56
-##' @slot file input file
57
-##' @slot fields available feature
58
-##' @slot treetext tree text
59
-##' @slot phylo multiPhylo, time tree, rate tree and absolute substitution tree
60
-##' @slot extraInfo extra information
61
-##' @exportClass r8s
62
-##' @author Guangchuang Yu \url{http://ygc.name}
63
-##' @keywords classes
64
-setClass("r8s",
65
-         representation = representation(
66
-             file      = "character",
67
-             fields    = "character",
68
-             treetext  = "character",
69
-             phylo     = "multiPhylo",
70
-             extraInfo = "data.frame"
71
-             )
72
-         )
73 8
 
74
-##' Class "nhx"
75
-##' This class stores nhx tree
76
-##'
77
-##'
78
-##' @name nhx-class
79
-##' @rdname nhx-class
80
-##' @docType class
81
-##' @slot file input file
82
-##' @slot fields available feature
83
-##' @slot phylo phylo object
84
-##' @slot nhx_tags tag information in nhx file
85
-##' @slot extraInfo extra information
86
-##' @exportClass nhx
87
-##' @author Guangchuang Yu \url{http://ygc.name}
88
-##' @keywords classes
89
-setClass("nhx",
90
-         representation = representation(
91
-             file = "character",
92
-             fields = "character",
93
-             phylo = "phylo",
94
-             nhx_tags = "data.frame",
95
-             extraInfo = "data.frame"
96
-         )
97
-         )
9
+supported_tree_object <- function() {
10
+    c("apeBootstrap",
11
+      "beast",
12
+      "codeml_mlc",
13
+      "codeml",
14
+      "hyphy",
15
+      "jplace",
16
+      "nhx",
17
+      "paml_rst",
18
+      "phangorn",      
19
+      "phylip",
20
+      "r8s",
21
+      "raxml")
22
+}
98 23
 
99 24
 ##' Class "apeBootstrap"
100 25
 ##' This class stores ape bootstrapping analysis result
... ...
@@ -107,7 +32,7 @@ setClass("nhx",
107 32
 ##' @slot bootstrap bootstrap value
108 33
 ##' @slot extraInfo extra information
109 34
 ##' @exportClass apeBootstrap
110
-##' @author Guangchuang Yu \url{http://ygc.name}
35
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
111 36
 ##' @keywords classes
112 37
 setClass("apeBootstrap",
113 38
          representation = representation(
... ...
@@ -118,31 +43,69 @@ setClass("apeBootstrap",
118 43
          )
119 44
          )
120 45
 
46
+##' Class "beast"
47
+##' This class stores information of beast output
48
+##'
49
+##'
50
+##' @name beast-class
51
+##' @aliases beast-class
52
+##'      get.tree,beast-method
53
+##' 
54
+##' @docType class
55
+##' @slot fields beast statistic variables
56
+##' @slot treetext tree text in beast file
57
+##' @slot phylo tree phylo object
58
+##' @slot translation tip number to name translation in beast file
59
+##' @slot stats beast statistics
60
+##' @slot file beast file, nexus format
61
+##' @slot extraInfo extra information
62
+##' @exportClass beast
63
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
64
+##' @seealso \code{\link{show}} \code{\link{get.fields}}
65
+##'           \code{\link{ggtree}}
66
+##' @keywords classes
67
+setClass("beast",
68
+         representation  = representation(
69
+             fields      = "character",
70
+             treetext    = "character",
71
+             phylo       = "phylo",
72
+             translation = "matrix",
73
+             stats       = "data.frame",
74
+             file        = "character",
75
+             extraInfo   = "data.frame"
76
+             )
77
+         )
78
+
121 79
 
122
-##' Class "raxml"
123
-##' This class stores RAxML bootstrapping analysis result
80
+##' Class "codeml_mlc"
81
+##' This class stores information of mlc file frm codeml output
124 82
 ##'
125 83
 ##'
126
-##' @name raxml-class
84
+##' @name codeml_mlc-class
127 85
 ##' @docType class
128
-##' @slot file input file
129 86
 ##' @slot fields available features
130 87
 ##' @slot treetext tree text
131
-##' @slot phylo phylo object of treetext
132
-##' @slot bootstrap bootstrap value
88
+##' @slot phylo phylo object
89
+##' @slot dNdS dN dS information
90
+##' @slot mlcfile mlc file
133 91
 ##' @slot extraInfo extra information
134
-##' @exportClass raxml
135
-##' @author Guangchuang Yu \url{http://ygc.name}
92
+##' @exportClass codeml_mlc
93
+##' @author Guangchuang Yu
94
+##' @seealso \linkS4class{paml_rst} \linkS4class{codeml}
136 95
 ##' @keywords classes
137
-setClass("raxml",
96
+setClass("codeml_mlc",
138 97
          representation = representation(
139
-             file       = "character",
140
-             treetext   = "character"
141
-         ),
142
-         contains = "apeBootstrap"
98
+             fields     = "character",
99
+             treetext   = "character",
100
+             phylo      = "phylo",
101
+             dNdS       = "matrix",
102
+             ## seq_type   = "character",
103
+             ## tip_seq    = "character",
104
+             mlcfile    = "character",
105
+             extraInfo  = "data.frame"
106
+             )
143 107
          )
144 108
 
145
-
146 109
 ##' Class "paml_rst"
147 110
 ##' This class stores information of rst file from PAML output
148 111
 ##'
... ...
@@ -167,7 +130,7 @@ setClass("raxml",
167 130
 ##' @slot rstfile rst file
168 131
 ##' @slot extraInfo extra information
169 132
 ##' @exportClass paml_rst
170
-##' @author Guangchuang Yu \url{http://ygc.name}
133
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
171 134
 ##' @seealso \linkS4class{codeml} \linkS4class{codeml_mlc}
172 135
 ##' @keywords classes
173 136
 setClass("paml_rst",
... ...
@@ -188,66 +151,6 @@ setClass("paml_rst",
188 151
          )
189 152
          )
190 153
 
191
-##' Class "phangorn"
192
-##' This class stores ancestral sequences inferred from 'phangorn'
193
-##'
194
-##'
195
-##' @name phangorn-class
196
-##' @docType class
197
-##' @slot fields available attributes
198
-##' @slot phylo phylo object
199
-##' @slot seq_type one of "NT" and "AA"
200
-##' @slot tip_seq sequences of tips
201
-##' @slot ancseq ancenstral sequences
202
-##' @slot subs sequence substitution
203
-##' @slot AA_subs Amino acid sequence substitution
204
-##' @slot extraInfo extra information
205
-##' @exportClass phangorn
206
-##' @author Guangchuang Yu \url{http://ygc.name}
207
-##' @seealso \linkS4class{paml_rst}
208
-##' @keywords classes
209
-setClass("phangorn",
210
-         representation = representation(
211
-             fields = "character",
212
-             phylo = "phylo",
213
-             seq_type = "character",
214
-             tip_seq = "character",
215
-             ancseq = "character",
216
-             subs = "data.frame",
217
-             AA_subs = "data.frame",
218
-             extraInfo = "data.frame")
219
-         )
220
-
221
-
222
-##' Class "codeml_mlc"
223
-##' This class stores information of mlc file frm codeml output
224
-##'
225
-##'
226
-##' @name codeml_mlc-class
227
-##' @docType class
228
-##' @slot fields available features
229
-##' @slot treetext tree text
230
-##' @slot phylo phylo object
231
-##' @slot dNdS dN dS information
232
-##' @slot mlcfile mlc file
233
-##' @slot extraInfo extra information
234
-##' @exportClass codeml_mlc
235
-##' @author Guangchuang Yu
236
-##' @seealso \linkS4class{paml_rst} \linkS4class{codeml}
237
-##' @keywords classes
238
-setClass("codeml_mlc",
239
-         representation = representation(
240
-             fields     = "character",
241
-             treetext   = "character",
242
-             phylo      = "phylo",
243
-             dNdS       = "matrix",
244
-             ## seq_type   = "character",
245
-             ## tip_seq    = "character",
246
-             mlcfile    = "character",
247
-             extraInfo  = "data.frame"
248
-             )
249
-         )
250
-
251 154
 ##' Class "codeml"
252 155
 ##' This class stores information of output from codeml
253 156
 ##'
... ...
@@ -268,6 +171,47 @@ setClass("codeml",
268 171
              )
269 172
          )
270 173
 
174
+
175
+
176
+##' Class "hyphy"
177
+##' This class stores information of HYPHY output
178
+##'
179
+##'
180
+##' @name hyphy-class
181
+##' @docType class
182
+##' @slot fields available features
183
+##' @slot treetext tree text
184
+##' @slot phylo phylo object
185
+##' @slot seq_type one of "NT" and "AA"
186
+##' @slot subs sequence substitutions
187
+##' @slot AA_subs Amino acid sequence substitution
188
+##' @slot ancseq ancestral sequences
189
+##' @slot tip_seq tip sequences
190
+##' @slot tip.fasfile fasta file of tip sequences
191
+##' @slot tree.file tree file
192
+##' @slot ancseq.file ancestral sequence file, nexus format
193
+##' @slot extraInfo extra information
194
+##' @exportClass hyphy
195
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
196
+##' @seealso \linkS4class{paml_rst}
197
+##' @keywords classes
198
+setClass("hyphy",
199
+         representation  = representation(
200
+             fields      = "character",
201
+             treetext    = "character",
202
+             phylo       = "phylo",
203
+             seq_type    = "character",
204
+             subs        = "data.frame",
205
+             AA_subs     = "data.frame",
206
+             ancseq      = "character",
207
+             tip_seq     = "character",
208
+             tip.fasfile = "character",
209
+             tree.file   = "character",
210
+             ancseq.file = "character",
211
+             extraInfo   = "data.frame"
212
+             )
213
+         )
214
+
271 215
 ##' Class "jplace"
272 216
 ##' This class stores information of jplace file.
273 217
 ##'
... ...
@@ -290,7 +234,7 @@ setClass("codeml",
290 234
 ##' @slot file jplace file
291 235
 ##' @slot extraInfo extra information
292 236
 ##' @exportClass jplace
293
-##' @author Guangchuang Yu \url{http://ygc.name}
237
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
294 238
 ##' @seealso \code{\link{show}} \code{\link{get.tree}}
295 239
 ##'          \code{\link{ggtree}}
296 240
 ##' @keywords classes
... ...
@@ -307,35 +251,136 @@ setClass("jplace",
307 251
              )
308 252
          )
309 253
 
310
-##' Class "beast"
311
-##' This class stores information of beast output
254
+
255
+##' Class "nhx"
256
+##' This class stores nhx tree
312 257
 ##'
313 258
 ##'
314
-##' @name beast-class
315
-##' @aliases beast-class
316
-##'      get.tree,beast-method
317
-##' 
259
+##' @name nhx-class
260
+##' @rdname nhx-class
318 261
 ##' @docType class
319
-##' @slot fields beast statistic variables
320
-##' @slot treetext tree text in beast file
321
-##' @slot phylo tree phylo object
322
-##' @slot translation tip number to name translation in beast file
323
-##' @slot stats beast statistics
324
-##' @slot file beast file, nexus format
262
+##' @slot file input file
263
+##' @slot fields available feature
264
+##' @slot phylo phylo object
265
+##' @slot nhx_tags tag information in nhx file
325 266
 ##' @slot extraInfo extra information
326
-##' @exportClass beast
327
-##' @author Guangchuang Yu \url{http://ygc.name}
328
-##' @seealso \code{\link{show}} \code{\link{get.fields}}
329
-##'           \code{\link{ggtree}}
267
+##' @exportClass nhx
268
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
330 269
 ##' @keywords classes
331
-setClass("beast",
332
-         representation  = representation(
333
-             fields      = "character",
334
-             treetext    = "character",
335
-             phylo       = "phylo",
336
-             translation = "matrix",
337
-             stats       = "data.frame",
338
-             file        = "character",
339
-             extraInfo   = "data.frame"
270
+setClass("nhx",
271
+         representation = representation(
272
+             file = "character",
273
+             fields = "character",
274
+             phylo = "phylo",
275
+             nhx_tags = "data.frame",
276
+             extraInfo = "data.frame"
277
+         )
278
+         )
279
+
280
+
281
+##' Class "phangorn"
282
+##' This class stores ancestral sequences inferred from 'phangorn'
283
+##'
284
+##'
285
+##' @name phangorn-class
286
+##' @docType class
287
+##' @slot fields available attributes
288
+##' @slot phylo phylo object
289
+##' @slot seq_type one of "NT" and "AA"
290
+##' @slot tip_seq sequences of tips
291
+##' @slot ancseq ancenstral sequences
292
+##' @slot subs sequence substitution
293
+##' @slot AA_subs Amino acid sequence substitution
294
+##' @slot extraInfo extra information
295
+##' @exportClass phangorn
296
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
297
+##' @seealso \linkS4class{paml_rst}
298
+##' @keywords classes
299
+setClass("phangorn",
300
+         representation = representation(
301
+             fields = "character",
302
+             phylo = "phylo",
303
+             seq_type = "character",
304
+             tip_seq = "character",
305
+             ancseq = "character",
306
+             subs = "data.frame",
307
+             AA_subs = "data.frame",
308
+             extraInfo = "data.frame")
309
+         )
310
+
311
+
312
+##' Class "phylip"
313
+##' This class stores phylip tree(s)
314
+##'
315
+##'
316
+##' @name phylip-class
317
+##' @docType class
318
+##' @slot file input file
319
+##' @slot fields available feature
320
+##' @slot phylo phylo or multiPhylo
321
+##' @slot ntree number of trees
322
+##' @slot sequence sequences
323
+##' @slot extraInfo extra information
324
+##' @exportClass phylip
325
+##' @author Guangchuang Yu
326
+##' @keywords classes
327
+setClass("phylip",
328
+         representation = representation(
329
+             file = "character",
330
+             fields = "character",
331
+             phylo = "phyloOrmultiPhylo",
332
+             ntree = "numeric",
333
+             sequence = "BStringSet",
334
+             extraInfo = "data.frame")
335
+         )
336
+
337
+
338
+##' Class "r8s"
339
+##' This class stores output info from r8s
340
+##'
341
+##'
342
+##' @name r8s-class
343
+##' @docType class
344
+##' @slot file input file
345
+##' @slot fields available feature
346
+##' @slot treetext tree text
347
+##' @slot phylo multiPhylo, time tree, rate tree and absolute substitution tree
348
+##' @slot extraInfo extra information
349
+##' @exportClass r8s
350
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
351
+##' @keywords classes
352
+setClass("r8s",
353
+         representation = representation(
354
+             file      = "character",
355
+             fields    = "character",
356
+             treetext  = "character",
357
+             phylo     = "multiPhylo",
358
+             extraInfo = "data.frame"
340 359
              )
341 360
          )
361
+
362
+
363
+##' Class "raxml"
364
+##' This class stores RAxML bootstrapping analysis result
365
+##'
366
+##'
367
+##' @name raxml-class
368
+##' @docType class
369
+##' @slot file input file
370
+##' @slot fields available features
371
+##' @slot treetext tree text
372
+##' @slot phylo phylo object of treetext
373
+##' @slot bootstrap bootstrap value
374
+##' @slot extraInfo extra information
375
+##' @exportClass raxml
376
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
377
+##' @keywords classes
378
+setClass("raxml",
379
+         representation = representation(
380
+             file       = "character",
381
+             treetext   = "character"
382
+         ),
383
+         contains = "apeBootstrap"
384
+         )
385
+
386
+
... ...
@@ -7,7 +7,7 @@
7 7
 ##' @export
8 8
 ##' @author Guangchuang Yu
9 9
 Date2decimal <- function(x) {
10
-    x %<>% as.Date
10
+    x <- as.Date(x)
11 11
     year <- format(x, "%Y")
12 12
     y <- x - as.Date(paste0(year, "-01-01"))
13 13
     as.numeric(year) + as.numeric(y)/365
... ...
@@ -86,14 +86,6 @@ get_nhx_feature_internal <- function(feature, nameSET) {
86 86
 }
87 87
 
88 88
 
89
-##' @rdname get.tree-methods
90
-##' @exportMethod get.tree
91
-setMethod("get.tree", signature(object = "nhx"),
92
-          function(object) {
93
-              object@phylo
94
-          }
95
-          )
96
-
97 89
 
98 90
 
99 91
 
... ...
@@ -12,7 +12,7 @@ read.raxml <- function(file) {
12 12
     phylo <- read.tree(text=tree_text)
13 13
     if(any(grepl('@', phylo$node.label))) {
14 14
         bootstrap <- as.numeric(gsub("[^@]*@(\\d+)", "\\1", phylo$node.label))
15
-        phylo$node.label %<>% gsub("@\\d+", "", .)
15
+        phylo$node.label <- gsub("@\\d+", "", phylo$node.label)
16 16
     }
17 17
 
18 18
     if (all(phylo$node.label == "")) {
... ...
@@ -92,17 +92,6 @@ setMethod("scale_color", signature(object="apeBootstrap"),
92 92
           })
93 93
 
94 94
 
95
-
96
-
97
-##' @rdname get.tree-methods
98
-##' @exportMethod get.tree
99
-setMethod("get.tree", signature(object="apeBootstrap"),
100
-          function(object,...) {
101
-              object@phylo
102
-          }
103
-          )
104
-
105
-
106 95
 ##' @rdname get.fields-methods
107 96
 ##' @exportMethod get.fields
108 97
 setMethod("get.fields", signature(object="apeBootstrap"),
... ...
@@ -38,32 +38,6 @@ read.beast <- function(file) {
38 38
 
39 39
 
40 40
 
41
-##' @rdname groupClade-methods
42
-##' @exportMethod groupClade
43
-setMethod("groupClade", signature(object="beast"),
44
-          function(object, node, group_name="group") {
45
-              groupClade_(object, node, group_name)
46
-          })
47
-
48
-
49
-
50
-##' get.tree method
51
-##'
52
-##'
53
-##' @docType methods
54
-##' @name get.tree
55
-##' @rdname get.tree-methods
56
-##' @aliases get.tree,beast
57
-##' @exportMethod get.tree
58
-##' @author Guangchuang Yu \url{http://ygc.name}
59
-##' @usage get.tree(object, ...)
60
-setMethod("get.tree", signature(object="beast"),
61
-          function(object,...) {
62
-              object@phylo
63
-          }
64
-          )
65
-
66
-
67 41
 ##' @rdname get.fields-methods
68 42
 ##' @exportMethod get.fields
69 43
 setMethod("get.fields", signature(object="beast"),
... ...
@@ -22,13 +22,6 @@ read.codeml <- function(rstfile, mlcfile) {
22 22
 }
23 23
 
24 24
 
25
-##' @rdname groupClade-methods
26
-##' @exportMethod groupClade
27
-setMethod("groupClade", signature(object="codeml"),
28
-          function(object, node, group_name="group") {
29
-              groupClade_(object, node, group_name)
30
-          }
31
-          )
32 25
 
33 26
 
34 27
 ##' @rdname scale_color-methods
... ...
@@ -40,19 +33,6 @@ setMethod("scale_color", signature(object="codeml"),
40 33
 
41 34
 
42 35
 
43
-##' @rdname show-methods
44
-##' @exportMethod show
45
-setMethod("show", signature(object = "codeml"),
46
-          function(object) {
47
-              cat("'codeml' S4 object that stored information of\n\t",
48
-                  paste0("'", object@rst@rstfile, "' and \n\t'",
49
-                         object@mlc@mlcfile, "'."),
50
-                  "\n\n")
51
-              cat("...@ tree:")
52
-              print.phylo(get.tree(object))                  
53
-              cat("\nwith the following features available:\n")
54
-              print_fields(object, len=4)
55
-          })
56 36
 
57 37
 ##' @rdname get.tipseq-methods
58 38
 ##' @exportMethod get.tipseq
... ...
@@ -61,17 +41,6 @@ setMethod("get.tipseq", signature(object = "codeml"),
61 41
               return(object@rst@tip_seq)
62 42
           })
63 43
 
64
-##' @rdname get.tree-methods
65
-##' @exportMethod get.tree
66
-##' @param by one of rst or mlc
67
-setMethod("get.tree", signature(object="codeml"),
68
-          function(object, by="rst", ...) {
69
-              if (by == "rst") {
70
-                  return(object@rst@phylo)
71
-              } else {
72
-                  return(object@mlc@phylo)
73
-              }
74
-          })
75 44
 
76 45
 ##' @rdname get.subs-methods
77 46
 ##' @exportMethod get.subs
... ...
@@ -133,7 +133,25 @@ get_heatmap_column_position <- function(treeview, by="bottom") {
133 133
 ##' @importFrom ggplot2 scale_fill_manual
134 134
 ##' @author Guangchuang Yu
135 135
 msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL){
136
-    aln <- readBStringSet(fasta)
136
+    if (missingArg(fasta)) {
137
+        aln <- NULL
138
+    } else if (is(fasta, "BStringSet")) {
139
+        aln <- fasta
140
+    } else if (is(fasta, "character")) {
141
+        aln <- readBStringSet(fasta)
142
+    } else {
143
+        aln <- NULL
144
+    }
145
+        
146
+    if (is(p, "phylip")) {
147
+        aln <- p@sequence
148
+        p <- ggtree(p) + geom_tiplab()
149
+    }
150
+
151
+    if (is.null(aln)) {
152
+        stop("multiple sequence alignment is not available...\n-> check the parameter 'fasta'...")
153
+    }
154
+    
137 155
     if (is.null(window)) {
138 156
         window <- c(1, width(aln)[1])
139 157
     }
... ...
@@ -26,21 +26,6 @@ read.jplace <- function(file) {
26 26
          )
27 27
 }
28 28
 
29
-##' @rdname groupOTU-methods
30
-##' @exportMethod groupOTU
31
-setMethod("groupOTU", signature(object="jplace"),
32
-          function(object, focus, group_name="group") {
33
-              groupOTU_(object, focus, group_name)
34
-          }
35
-          )
36
-
37
-##' @rdname groupClade-methods
38
-##' @exportMethod groupClade
39
-setMethod("groupClade", signature(object="jplace"),
40
-          function(object, node, group_name="group") {
41
-              groupClade_(object, node, group_name)
42
-          }
43
-          )
44 29
 
45 30
 
46 31
 ##' @rdname scale_color-methods
... ...
@@ -51,53 +36,7 @@ setMethod("scale_color", signature(object="jplace"),
51 36
           })
52 37
 
53 38
 
54
-##' @rdname get.tree-methods
55
-##' @exportMethod get.tree
56
-setMethod("get.tree", signature(object="jplace"),
57
-          function(object) {
58
-              object@phylo
59
-          })
60
-
61
-
62
-##' show method for \code{jplace} instance
63
-##'
64
-##' 
65
-##' @name show
66
-##' @docType methods
67
-##' @rdname show-methods
68
-##'
69
-##' @title show method
70
-##' @param object one of \code{jplace}, \code{beast} object
71
-##' @return print info
72
-##' @importFrom methods show
73
-##' @exportMethod show
74
-##' @usage show(object)
75
-##' @author Guangchuang Yu \url{http://ygc.name}
76
-##' @examples
77
-##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
78
-##' jp <- read.jplace(jp)
79
-##' show(jp)
80
-setMethod("show", signature(object = "jplace"),
81
-          function(object) {
82
-              cat("'jplace' S4 object that stored information of\n\t",
83
-                  paste0("'", object@file, "'."),
84
-                  "\n\n")
85
-
86
-              cat("...@ tree: ")
87
-
88
-              phylo <- get.tree(object)
89
-              phylo$node.label <- NULL
90
-              phylo$tip.label %<>% gsub("\\@\\d+", "", .) 
91
-        
92
-              print.phylo(phylo)
93 39
 
94
-              cat("\nwith the following features availables:\n")
95
-              cat("\t", paste0("'",
96
-                               paste(get.fields(object), collapse="',\t'"),
97
-                               "'."),
98
-                  "\n")
99
-          }
100
-          )
101 40
 
102 41
 ##' get.treeinfo method
103 42
 ##'
... ...
@@ -616,6 +616,15 @@ fortify.multiPhylo <-  function(model, data, layout="rectangular",
616 616
     return(df)
617 617
 }
618 618
 
619
+##' @method fortify phylip
620
+##' @export
621
+fortify.phylip <- function(model, data, layout="rectangular",
622
+                        ladderize=TRUE, right=FALSE,
623
+                        branch.length = "TREE", mrsd=NULL, ...) {
624
+    trees <- get.tree(model)
625
+    fortify(trees, layout=layout, ladderize = ladderize, right=right, mrsd=mrsd, ...)
626
+}
627
+    
619 628
 ##' @method fortify r8s
620 629
 ##' @export
621 630
 fortify.r8s <- function(model, data, layout="rectangular",
622 631
new file mode 100644
... ...
@@ -0,0 +1,61 @@
1
+##' @rdname get.tree-methods
2
+##' @exportMethod get.tree
3
+setMethod("get.tree", signature(object="apeBootstrap"),
4
+          function(object,...) {
5
+              object@phylo
6
+          }
7
+          )
8
+
9
+##' get.tree method
10
+##'
11
+##'
12
+##' @docType methods
13
+##' @name get.tree
14
+##' @rdname get.tree-methods
15
+##' @aliases get.tree,beast
16
+##' @exportMethod get.tree
17
+##' @author Guangchuang Yu \url{http://guangchuangyu.github.io}
18
+##' @usage get.tree(object, ...)
19
+setMethod("get.tree", signature(object="beast"),
20
+          function(object,...) {
21
+              object@phylo
22
+          }
23
+          )
24
+
25
+
26
+##' @rdname get.tree-methods
27
+##' @exportMethod get.tree
28
+##' @param by one of rst or mlc
29
+setMethod("get.tree", signature(object="codeml"),
30
+          function(object, by="rst", ...) {
31
+              if (by == "rst") {
32
+                  return(object@rst@phylo)
33
+              } else {
34
+                  return(object@mlc@phylo)
35
+              }
36
+          })
37
+
38
+
39
+##' @rdname get.tree-methods
40
+##' @exportMethod get.tree
41
+setMethod("get.tree", signature(object="jplace"),
42
+          function(object) {
43
+              object@phylo
44
+          })
45
+
46
+##' @rdname get.tree-methods
47
+##' @exportMethod get.tree
48
+setMethod("get.tree", signature(object = "nhx"),
49
+          function(object) {
50
+              object@phylo
51
+          }
52
+          )
53
+
54
+##' @rdname get.tree-methods
55
+##' @exportMethod get.tree
56
+setMethod("get.tree", signature(object="phylip"),
57
+          function(object,...) {
58
+              object@phylo
59
+          }
60
+          )
61
+
... ...
@@ -1,28 +1,40 @@
1
-
2 1
 ##' @rdname groupClade-methods
3 2
 ##' @exportMethod groupClade
4
-setMethod("groupClade", signature(object="phylo"),
3
+setMethod("groupClade", signature(object="beast"),
5 4
           function(object, node, group_name="group") {
6
-              groupClade.phylo(object, node, group_name)
5
+              groupClade_(object, node, group_name)
7 6
           })
8 7
 
9
-groupClade.phylo <- function(object, node, group_name) {
10
-    if (length(node) == 1) {
11
-        clade <- extract.clade(object, node)
12
-        tips <- clade$tip.label
13
-    } else {
14
-        tips <- lapply(node, function(x) {
15
-            clade <- extract.clade(object, x)
16
-            clade$tip.label
17
-        })
18
-    }
19
-    
20
-    groupOTU.phylo(object, tips, group_name)
21
-}
8
+##' @rdname groupClade-methods
9
+##' @exportMethod groupClade
10
+setMethod("groupClade", signature(object="codeml"),
11
+          function(object, node, group_name="group") {
12
+              groupClade_(object, node, group_name)
13
+          }
14
+          )
22 15
 
16
+##' @rdname groupClade-methods
17
+##' @exportMethod groupClade
18
+setMethod("groupClade", signature(object="gg"),
19
+          function(object, node, group_name) {
20
+              groupClade.ggplot(object, node, group_name)
21
+          })
23 22
 
23
+##' @rdname groupClade-methods
24
+##' @exportMethod groupClade
25
+setMethod("groupClade", signature(object="ggplot"),
26
+          function(object, node, group_name) {
27
+              groupClade.ggplot(object, node, group_name)
28
+          })
24 29
 
25 30
 
31
+##' @rdname groupClade-methods
32
+##' @exportMethod groupClade
33
+setMethod("groupClade", signature(object="jplace"),
34
+          function(object, node, group_name="group") {
35
+              groupClade_(object, node, group_name)
36
+          }
37
+          )
26 38
 
27 39
 ##' group selected clade
28 40
 ##'
... ...
@@ -34,19 +46,62 @@ setMethod("groupClade", signature(object="nhx"),
34 46
               groupClade_(object, node, group_name)
35 47
           })
36 48
 
37
-
38 49
 ##' @rdname groupClade-methods
39 50
 ##' @exportMethod groupClade
40
-setMethod("groupClade", signature(object="ggplot"),
41
-          function(object, node, group_name) {
42
-              groupClade.ggplot(object, node, group_name)
51
+setMethod("groupClade", signature(object="phylip"),
52
+          function(object, node, group_name="group") {
53
+              groupClade_(object, node, group_name)
43 54
           })
44 55
 
45 56
 
46 57
 ##' @rdname groupClade-methods
47 58
 ##' @exportMethod groupClade
48
-setMethod("groupClade", signature(object="gg"),
49
-          function(object, node, group_name) {
50
-              groupClade.ggplot(object, node, group_name)
59
+setMethod("groupClade", signature(object="phylo"),
60
+          function(object, node, group_name="group") {
61
+              groupClade.phylo(object, node, group_name)
51 62
           })
52 63
 
64
+
65
+
66
+groupClade.phylo <- function(object, node, group_name) {
67
+    if (length(node) == 1) {
68
+        clade <- extract.clade(object, node)
69
+        tips <- clade$tip.label
70
+    } else {
71
+        tips <- lapply(node, function(x) {
72
+            clade <- extract.clade(object, x)
73
+            clade$tip.label
74
+        })
75
+    }
76
+    
77
+    groupOTU.phylo(object, tips, group_name)
78
+}
79
+
80
+
81
+groupClade_ <- function(object, node, group_name) {
82
+    if (is(object, "phylo")) {
83
+        object <- groupClade.phylo(object, node, group_name)
84
+    } else {
85
+        object@phylo <- groupClade.phylo(get.tree(object), node, group_name)
86
+    }
87
+    return(object)
88
+}
89
+
90
+
91
+groupClade.ggplot <- function(object, nodes, group_name) {
92
+    df <- object$data
93
+    df[, group_name] <- 0
94
+    for (node in nodes) {
95
+        df <- groupClade.df(df, node, group_name)
96
+    }
97
+    df[, group_name] <- factor(df[, group_name])
98
+    object$data <- df
99
+    return(object)
100
+}
101
+
102
+groupClade.df <- function(df, node, group_name) {
103
+    foc <- c(node, get.offspring.df(df, node))
104
+    idx <- match(foc, df$node)
105
+    df[idx, group_name] <- max(df[, group_name]) + 1
106
+    return(df)
107
+}
... ...
@@ -1,40 +1,15 @@
1
-##' group OTU
2
-##'
3
-##' 
4
-##' @title groupOTU.phylo
5
-##' @param phy tree object
6
-##' @param focus tip list
7
-##' @param group_name name of the group
8
-##' @return phylo object
9
-##' @author ygc
10
-groupOTU.phylo <- function(phy, focus, group_name="group") {
11
-    attr(phy, group_name) <- NULL
12
-    if ( is(focus, "list") ) {
13
-        for (i in 1:length(focus)) {
14
-            phy <- gfocus(phy, focus[[i]], group_name)
15
-        } 
16
-    } else {
17
-        phy <- gfocus(phy, focus, group_name)
18
-    }
19
-    attr(phy, group_name) <- factor(attr(phy, group_name))
20
-    return(phy)
21
-}
22
-
23
-
24
-##' group tree based on selected OTU, will traceback to MRCA
25
-##'
26
-##' 
27 1
 ##' @rdname groupOTU-methods
28 2
 ##' @exportMethod groupOTU
29
-setMethod("groupOTU", signature(object="phylo"),
3
+setMethod("groupOTU", signature(object="apeBootstrap"),
30 4
           function(object, focus, group_name="group") {
31
-              groupOTU.phylo(object, focus, group_name)
32
-          })
5
+              groupOTU_(object, focus, group_name)
6
+          }
7
+          )
33 8
 
34 9
 
35 10
 ##' @rdname groupOTU-methods
36 11
 ##' @exportMethod groupOTU
37
-setMethod("groupOTU", signature(object="apeBootstrap"),
12
+setMethod("groupOTU", signature(object="beast"),
38 13
           function(object, focus, group_name="group") {
39 14
               groupOTU_(object, focus, group_name)
40 15
           }
... ...
@@ -42,24 +17,39 @@ setMethod("groupOTU", signature(object="apeBootstrap"),
42 17
 
43 18
 ##' @rdname groupOTU-methods
44 19
 ##' @exportMethod groupOTU
45
-setMethod("groupOTU", signature(object="beast"),
20
+setMethod("groupOTU", signature(object="codeml"),
46 21
           function(object, focus, group_name="group") {
47 22
               groupOTU_(object, focus, group_name)
48 23
           }
49 24
           )
50 25
 
26
+
51 27
 ##' @rdname groupOTU-methods
52 28
 ##' @exportMethod groupOTU
53
-setMethod("groupOTU", signature(object="codeml"),
29
+setMethod("groupOTU", signature(object="codeml_mlc"),
54 30
           function(object, focus, group_name="group") {
55 31
               groupOTU_(object, focus, group_name)
56 32
           }
57 33
           )
58 34
 
35
+##' @rdname groupOTU-methods
36
+##' @exportMethod groupOTU
37
+setMethod("groupOTU", signature(object="gg"),
38
+          function(object, focus, group_name) {
39
+              groupOTU.ggplot(object, focus, group_name)
40
+          })
59 41
 
60 42
 ##' @rdname groupOTU-methods
61 43
 ##' @exportMethod groupOTU
62
-setMethod("groupOTU", signature(object="codeml_mlc"),
44
+setMethod("groupOTU", signature(object="ggplot"),
45
+          function(object, focus, group_name="group") {
46
+              groupOTU.ggplot(object, focus, group_name)
47
+          })
48
+
49
+
50
+##' @rdname groupOTU-methods
51
+##' @exportMethod groupOTU
52
+setMethod("groupOTU", signature(object="jplace"),
63 53
           function(object, focus, group_name="group") {
64 54
               groupOTU_(object, focus, group_name)
65 55
           }
... ...
@@ -73,27 +63,41 @@ setMethod("groupOTU", signature(object="nhx"),
73 63
           }
74 64
           )
75 65
 
76
-
77 66
 ##' @rdname groupOTU-methods
78 67
 ##' @exportMethod groupOTU
79
-setMethod("groupOTU", signature(object="paml_rst"),
68
+setMethod("groupOTU", signature(object="phangorn"),
80 69
           function(object, focus, group_name="group") {
81 70
               groupOTU_(object, focus, group_name)
82 71
           }
83 72
           )
84 73
 
85
-
86
-
74
+##' @rdname groupOTU-methods
75
+##' @exportMethod groupOTU
76
+setMethod("groupOTU", signature(object="phylip"),
77
+          function(object, focus, group_name="group") {
78
+              groupOTU_(object, focus, group_name)
79
+          }
80
+          )
87 81
 
88 82
 ##' @rdname groupOTU-methods
89 83
 ##' @exportMethod groupOTU
90
-setMethod("groupOTU", signature(object="phangorn"),
84
+setMethod("groupOTU", signature(object="paml_rst"),
91 85
           function(object, focus, group_name="group") {
92 86
               groupOTU_(object, focus, group_name)
93 87
           }
94 88
           )
95 89
 
96 90
 
91
+##' group tree based on selected OTU, will traceback to MRCA
92
+##'
93
+##' 
94
+##' @rdname groupOTU-methods
95
+##' @exportMethod groupOTU
96
+setMethod("groupOTU", signature(object="phylo"),
97
+          function(object, focus, group_name="group") {
98
+              groupOTU.phylo(object, focus, group_name)
99
+          })
100
+
97 101
 ##' @rdname groupOTU-methods
98 102
 ##' @exportMethod groupOTU
99 103
 ##' @param tree which tree selected
... ...
@@ -105,19 +109,98 @@ setMethod("groupOTU", signature(object="r8s"),
105 109
 
106 110
 
107 111
 
108
-##' @rdname groupOTU-methods
109
-##' @exportMethod groupOTU
110
-setMethod("groupOTU", signature(object="ggplot"),
111
-          function(object, focus, group_name="group") {
112
-              groupOTU.ggplot(object, focus, group_name)
113
-          })
114 112
 
113
+##' @importFrom ape which.edge
114
+gfocus <- function(phy, focus, group_name) {
115
+    if (is.character(focus)) {
116
+        focus <- which(phy$tip.label %in% focus)
117
+    }
118
+    
119
+    n <- getNodeNum(phy)
120
+    if (is.null(attr(phy, group_name))) {
121
+        foc <- rep(0, n)
122
+    } else {
123
+        foc <- attr(phy, group_name)
124
+    }
125
+    i <- max(foc) + 1
126
+    ## sn <- phy$edge[which.edge(phy, focus),] %>% as.vector %>% unique
127
+    sn <- unique(as.vector(phy$edge[which.edge(phy, focus),]))
128
+    foc[sn] <- i
129
+    attr(phy, group_name) <- foc
130
+    phy
131
+}
115 132
 
116
-##' @rdname groupOTU-methods
117
-##' @exportMethod groupOTU
118
-setMethod("groupOTU", signature(object="gg"),
119
-          function(object, focus, group_name) {
120
-              groupOTU.ggplot(object, focus, group_name)
121
-          })
122 133
 
134
+##' group OTU
135
+##'
136
+##' 
137
+##' @title groupOTU.phylo
138
+##' @param phy tree object
139
+##' @param focus tip list
140
+##' @param group_name name of the group
141
+##' @return phylo object
142
+##' @author ygc
143
+groupOTU.phylo <- function(phy, focus, group_name="group") {
144
+    attr(phy, group_name) <- NULL
145
+    if ( is(focus, "list") ) {
146
+        for (i in 1:length(focus)) {
147
+            phy <- gfocus(phy, focus[[i]], group_name)
148
+        } 
149
+    } else {
150
+        phy <- gfocus(phy, focus, group_name)
151
+    }
152
+    attr(phy, group_name) <- factor(attr(phy, group_name))
153
+    return(phy)
154
+}
155
+
156
+groupOTU_ <- function(object, focus, group_name) {
157
+    if (is(object, "phylo")) {
158
+        object <- groupOTU.phylo(object, focus, group_name)
159
+    } else {
160
+        object@phylo <- groupOTU.phylo(get.tree(object), focus, group_name)
161
+    }
162
+    return(object)
163
+}
164
+
165
+
166
+groupOTU.ggplot <- function(object, focus, group_name) {
167
+    df <- object$data
168
+    df[, group_name] <- 0
169
+    object$data <- groupOTU.df(df, focus, group_name)
170
+    return(object)     
171
+}
172
+
173
+
174
+groupOTU.df <- function(df, focus, group_name) {    
175
+    if (is(focus, "list")) {
176
+        for (i in 1:length(focus)) {
177
+            df <- gfocus.df(df, focus[[i]], group_name)
178
+        }
179
+    } else {
180
+        df <- gfocus.df(df, focus, group_name)
181
+    }
182
+    df[, group_name] <- factor(df[, group_name])
183
+    return(df)
184
+}
185
+
186
+gfocus.df <- function(df, focus, group_name) {
187
+    focus <- df$node[which(df$label %in% focus)]
188
+    if (length(focus) == 1) {
189
+        df[match(focus, df$node), group_name] <- max(df(df[, group_name])) + 1
190
+        return(df)
191
+    }
192
+    
193
+    anc <- getAncestor.df(df, focus[1])
194
+    foc <- c(focus[1], anc)
195
+    for (j in 2:length(focus)) {
196
+        anc2 <- getAncestor.df(df, focus[j])
197
+        comAnc <- intersect(anc, anc2)
198
+        foc <- c(foc, focus[j], anc2)
199
+        foc <- foc[! foc %in% comAnc]
200
+        foc <- c(foc, comAnc[1])
201
+    }
202
+    idx <- match(foc, df$node)
203
+    df[idx, group_name] <- max(df[, group_name]) + 1
204
+    return(df)
205
+}
123 206
 
... ...
@@ -13,6 +13,60 @@ setMethod("show", signature(object = "beast"),
13 13
               print_fields(object)
14 14
           })
15 15
 
16
+##' @rdname show-methods
17
+##' @exportMethod show
18
+setMethod("show", signature(object = "codeml"),
19
+          function(object) {
20
+              cat("'codeml' S4 object that stored information of\n\t",
21
+                  paste0("'", object@rst@rstfile, "' and \n\t'",
22
+                         object@mlc@mlcfile, "'."),
23
+                  "\n\n")
24
+              cat("...@ tree:")
25
+              print.phylo(get.tree(object))                  
26
+              cat("\nwith the following features available:\n")
27
+              print_fields(object, len=4)
28
+          })
29
+
30
+##' show method for \code{jplace} instance
31
+##'
32
+##' 
33
+##' @name show
34
+##' @docType methods
35
+##' @rdname show-methods
36
+##'
37
+##' @title show method
38
+##' @param object one of \code{jplace}, \code{beast} object
39
+##' @return print info
40
+##' @importFrom methods show
41
+##' @exportMethod show
42
+##' @usage show(object)
43
+##' @author Guangchuang Yu \url{http://ygc.name}
44
+##' @examples
45
+##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
46
+##' jp <- read.jplace(jp)
47
+##' show(jp)
48
+setMethod("show", signature(object = "jplace"),
49
+          function(object) {
50
+              cat("'jplace' S4 object that stored information of\n\t",
51
+                  paste0("'", object@file, "'."),
52
+                  "\n\n")
53
+
54
+              cat("...@ tree: ")
55
+
56
+              phylo <- get.tree(object)
57
+              phylo$node.label <- NULL
58
+              phylo$tip.label %<>% gsub("\\@\\d+", "", .) 
59
+        
60
+              print.phylo(phylo)
61
+
62
+              cat("\nwith the following features availables:\n")
63
+              cat("\t", paste0("'",
64
+                               paste(get.fields(object), collapse="',\t'"),
65
+                               "'."),
66
+                  "\n")
67
+          }
68
+          )
69
+
16 70
 
17 71
 ##' @rdname show-methods
18 72
 ##' @exportMethod show
... ...
@@ -25,3 +79,18 @@ setMethod("show", signature(object = "nhx"),
25 79
               cat("\nwith the following features available:\n")
26 80
               print_fields(object)
27 81
           })
82
+
83
+
84
+##' @rdname show-methods
85
+##' @exportMethod show
86
+setMethod("show", signature(object = "phylip"),
87
+          function(object) {
88
+              cat("'phylip' S4 object that stored information of\n\t",
89
+                  paste0("'", object@file, "'.\n\n"))
90
+              cat("...@ tree: ")
91
+              print.phylo(get.tree(object))                  
92
+              msg <- paste0("\nwith sequence alignment available (", length(object@sequence),
93
+                            " sequences of length ", width(object@sequence)[1], ")\n")
94
+              cat(msg)
95
+          })
96
+
... ...
@@ -1,3 +1,65 @@
1
+##' update tree 
2
+##'
3
+##'
4
+##' @rdname update-TREE
5
+##' @title \%<\%
6
+##' @param pg ggplot2 object
7
+##' @param x update by x
8
+##' @return updated ggplot object
9
+##' @export
10
+##' @author Yu Guangchuang
11
+##' @examples
12
+##' library("ggplot2")
13
+##' nwk <- system.file("extdata", "sample.nwk", package="ggtree")
14
+##' tree <- read.tree(nwk)
15
+##' p <- ggtree(tree) + geom_tippoint(color="#b5e521", alpha=1/4, size=10)
16
+##' p %<% rtree(30)
17
+`%<%` <- function(pg, x) {
18
+    if (! is.tree(x)) {
19
+        stop("input should be a tree object...")
20
+    }
21
+    pg %place% x
22
+}
23
+
24
+##' add annotation data to a tree
25
+##'
26
+##'
27
+##' @rdname add-TREEDATA
28
+##' @title \%<+\%
29
+##' @param pg ggplot2 object
30
+##' @param data annotation data
31
+##' @return ggplot object with annotation data added
32
+##' @export
33
+##' @author Yu Guangchuang
34
+##' @examples
35
+##' nwk <- system.file("extdata", "sample.nwk", package="ggtree")
36
+##' tree <- read.tree(nwk)
37
+##' p <- ggtree(tree) 
38
+##' dd <- data.frame(taxa=LETTERS[1:13], 
39
+##'    		 place=c(rep("GZ", 5), rep("HK", 3), rep("CZ", 4), NA),
40
+##'              value=round(abs(rnorm(13, mean=70, sd=10)), digits=1))
41
+##' row.names(dd) <- NULL
42
+##' p %<+% dd + geom_text(aes(color=place, label=label), hjust=-0.5)
43
+`%<+%` <- function(pg, data) {
44
+    if (! is.data.frame(data)) {
45
+        stop("input should be a data.frame...")
46
+    }
47
+    pg %add% data
48
+}
49
+
50
+`%place%` <- function(pg, tree) {
51
+    param <- attr(pg, "param")
52
+    pg$data <- fortify(tree,
53
+                       layout        = param[["layout"]],