git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@112578 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -1,7 +1,7 @@ |
1 | 1 |
Package: ggtree |
2 | 2 |
Type: Package |
3 | 3 |
Title: a phylogenetic tree viewer for different types of tree annotations |
4 |
-Version: 1.3.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 |
+ |
... | ... |
@@ -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"]], |
|