git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@98340 bc3139a8-67e5-0310-9ffc-ced21a209358
1 | 1 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,20 @@ |
1 |
+Package: ggtree |
|
2 |
+Type: Package |
|
3 |
+Title: a phylogenetic tree viewer for different types of tree |
|
4 |
+ annotations |
|
5 |
+Version: 0.99.5 |
|
6 |
+Author: Guangchuang Yu |
|
7 |
+Maintainer: Guangchuang Yu <guangchuangyu@gmail.com> |
|
8 |
+Description: ggtree extends the ggplot2 plotting system which |
|
9 |
+ implemented the grammar of graphics. ggtree is designed for |
|
10 |
+ visualizing phylogenetic tree and different types of associated |
|
11 |
+ annotation data. |
|
12 |
+Depends: R (>= 3.1.0), ape, ggplot2 |
|
13 |
+Imports: Biostrings, grid, gridExtra, jsonlite, magrittr, methods, |
|
14 |
+ reshape2, stats4 |
|
15 |
+Suggests: phylobase, BiocStyle, knitr, testthat, rmarkdown |
|
16 |
+VignetteBuilder: knitr |
|
17 |
+License: Artistic-2.0 |
|
18 |
+URL: https://github.com/GuangchuangYu/ggtree |
|
19 |
+BugReports: https://github.com/GuangchuangYu/ggtree/issues |
|
20 |
+biocViews: Visualization |
0 | 21 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,97 @@ |
1 |
+# Generated by roxygen2 (4.1.0): do not edit by hand |
|
2 |
+ |
|
3 |
+S3method(as.binary,phylo) |
|
4 |
+S3method(as.data.frame,phylo) |
|
5 |
+S3method(fortify,beast) |
|
6 |
+S3method(fortify,codeml) |
|
7 |
+S3method(fortify,codeml_mlc) |
|
8 |
+S3method(fortify,hyphy) |
|
9 |
+S3method(fortify,jplace) |
|
10 |
+S3method(fortify,paml_rst) |
|
11 |
+S3method(fortify,phylo) |
|
12 |
+S3method(fortify,phylo4) |
|
13 |
+export("%<%") |
|
14 |
+export("%<+%") |
|
15 |
+export(.) |
|
16 |
+export(as.binary) |
|
17 |
+export(geom_aline) |
|
18 |
+export(geom_tiplab) |
|
19 |
+export(geom_tippoint) |
|
20 |
+export(geom_tree) |
|
21 |
+export(get.fields) |
|
22 |
+export(get.placements) |
|
23 |
+export(get.subs) |
|
24 |
+export(get.tree) |
|
25 |
+export(get.treeinfo) |
|
26 |
+export(get.treetext) |
|
27 |
+export(ggtree) |
|
28 |
+export(gplot) |
|
29 |
+export(plot) |
|
30 |
+export(read.baseml) |
|
31 |
+export(read.beast) |
|
32 |
+export(read.codeml) |
|
33 |
+export(read.codeml_mlc) |
|
34 |
+export(read.hyphy) |
|
35 |
+export(read.jplace) |
|
36 |
+export(read.paml_rst) |
|
37 |
+export(theme_tree) |
|
38 |
+export(theme_tree2) |
|
39 |
+export(write.jplace) |
|
40 |
+exportClasses(beast) |
|
41 |
+exportClasses(codeml) |
|
42 |
+exportClasses(codeml_mlc) |
|
43 |
+exportClasses(hyphy) |
|
44 |
+exportClasses(jplace) |
|
45 |
+exportClasses(paml_rst) |
|
46 |
+exportMethods(get.fields) |
|
47 |
+exportMethods(get.placements) |
|
48 |
+exportMethods(get.subs) |
|
49 |
+exportMethods(get.tree) |
|
50 |
+exportMethods(get.treeinfo) |
|
51 |
+exportMethods(get.treetext) |
|
52 |
+exportMethods(plot) |
|
53 |
+exportMethods(show) |
|
54 |
+importFrom(Biostrings,GENETIC_CODE) |
|
55 |
+importFrom(Biostrings,readBStringSet) |
|
56 |
+importFrom(Biostrings,toString) |
|
57 |
+importFrom(ape,Ntip) |
|
58 |
+importFrom(ape,extract.clade) |
|
59 |
+importFrom(ape,is.binary.tree) |
|
60 |
+importFrom(ape,ladderize) |
|
61 |
+importFrom(ape,print.phylo) |
|
62 |
+importFrom(ape,read.nexus) |
|
63 |
+importFrom(ape,read.tree) |
|
64 |
+importFrom(ape,reorder.phylo) |
|
65 |
+importFrom(ape,write.tree) |
|
66 |
+importFrom(ggplot2,"%+replace%") |
|
67 |
+importFrom(ggplot2,aes) |
|
68 |
+importFrom(ggplot2,aes_string) |
|
69 |
+importFrom(ggplot2,annotate) |
|
70 |
+importFrom(ggplot2,coord_flip) |
|
71 |
+importFrom(ggplot2,coord_polar) |
|
72 |
+importFrom(ggplot2,element_blank) |
|
73 |
+importFrom(ggplot2,element_line) |
|
74 |
+importFrom(ggplot2,element_rect) |
|
75 |
+importFrom(ggplot2,element_text) |
|
76 |
+importFrom(ggplot2,fortify) |
|
77 |
+importFrom(ggplot2,geom_point) |
|
78 |
+importFrom(ggplot2,geom_segment) |
|
79 |
+importFrom(ggplot2,geom_text) |
|
80 |
+importFrom(ggplot2,geom_tile) |
|
81 |
+importFrom(ggplot2,ggplot) |
|
82 |
+importFrom(ggplot2,scale_fill_gradient) |
|
83 |
+importFrom(ggplot2,scale_x_reverse) |
|
84 |
+importFrom(ggplot2,theme) |
|
85 |
+importFrom(ggplot2,theme_bw) |
|
86 |
+importFrom(ggplot2,xlab) |
|
87 |
+importFrom(ggplot2,ylab) |
|
88 |
+importFrom(grid,unit) |
|
89 |
+importFrom(gridExtra,grid.arrange) |
|
90 |
+importFrom(jsonlite,fromJSON) |
|
91 |
+importFrom(magrittr,"%<>%") |
|
92 |
+importFrom(magrittr,"%>%") |
|
93 |
+importFrom(magrittr,add) |
|
94 |
+importFrom(magrittr,equals) |
|
95 |
+importFrom(methods,show) |
|
96 |
+importFrom(reshape2,melt) |
|
97 |
+importFrom(stats4,plot) |
0 | 98 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,92 @@ |
1 |
+CHANGES IN VERSION 0.99.5 |
|
2 |
+------------------------ |
|
3 |
+ o add examples in man pages of %<% and %<+% operators <2015-01-06, Tue> |
|
4 |
+ o remove <<- and update vignette <2015-01-06, Tue> |
|
5 |
+ o update vignette and use BibTex and CSL for references <2015-01-05, Mon> |
|
6 |
+ o update cladogram layout <2015-01-05, Mon> |
|
7 |
+ o read.baseml function and update vignette with baseml example <2015-01-04, Sun> |
|
8 |
+ o plot method for hyphy and hyphy example in vignette <2015-01-04, Sun> |
|
9 |
+ o merge all vignettes to ggtree vignette <2015-01-04, Sun> |
|
10 |
+ |
|
11 |
+CHANGES IN VERSION 0.99.4 |
|
12 |
+------------------------ |
|
13 |
+ o ggtree now support branch.length = "none" to only draw tree topology <2015-01-03, Sat> |
|
14 |
+ o get.subs method for hyphy object <2015-01-03, Sat> |
|
15 |
+ o show, get.tree and get.subs methods of hyphy <2015-01-02, Fri> |
|
16 |
+ o export read.hyphy <2015-01-02, Fri> |
|
17 |
+ o export hyphy class <2015-01-01, Thu> |
|
18 |
+ o plot method for beast class and get.tree method for codeml class <2014-12-31, Wed> |
|
19 |
+ o show, get.fields, get.subs and plot methods for codeml class <2014-12-30, Tue> |
|
20 |
+ o plot method for paml_rst class <2014-12-30, Tue> |
|
21 |
+ o get.subs, method for paml_rst class <2014-12-30, Tue> |
|
22 |
+ o show, plot, get.tree and fority methods for codeml_mlc class <2014-12-29, Mon> |
|
23 |
+ o codeml class <2014-12-29, Mon> |
|
24 |
+ o hyphy class and read.hyphy prototype <2014-12-27, Sat> |
|
25 |
+ o update man file and add example file of beast output <2014-12-26, Fri> |
|
26 |
+ o get.tree and get.fileds methods of beast class <2014-12-26, Fri> |
|
27 |
+ o read.beast <2014-12-26, Fri> |
|
28 |
+ o beast class and show method <2014-12-26, Fri> |
|
29 |
+ o coplot prototype<2014-12-24, Wed> |
|
30 |
+ o parse translation matrix in beast nexus <2014-12-24, Wed> |
|
31 |
+ o extract beast stats info <2014-12-23, Tue> |
|
32 |
+ |
|
33 |
+CHANGES IN VERSION 0.99.3 |
|
34 |
+------------------------ |
|
35 |
+ o gplot function that can view a tree and an associated matrix simultaneously <2014-12-22, Mon> |
|
36 |
+ o modified vignette to show based on branch position and break the evolution distance scale <2014-12-22, Mon> |
|
37 |
+ o label and annotation can be put based on branch. <2014-12-22, Mon> |
|
38 |
+ o write.jplace and fully supports of jplace by ggtree. <2014-12-21, Sun> |
|
39 |
+ o support unrooted layout in ggplot. <2014-12-21, Sun> |
|
40 |
+ o support fan, radial, dendrogram layout in geom_tree. <2014-12-21, Sun> |
|
41 |
+ |
|
42 |
+CHANGES IN VERSION 0.99.2 |
|
43 |
+------------------------ |
|
44 |
+ o layout of unrooted tree, implemented equal-angle algorithm that described in Chapter 34 |
|
45 |
+ of 'Inferring Phylogenies' (page 578-580) <2014-12-20, Sat> |
|
46 |
+ o add layout parameter in ggtree and geom_tree, now supports phylogram and cladogram <2014-12-20, Sat> |
|
47 |
+ o %<+% function for inserting annotation data to a tree view <2014-12-20, Sat> |
|
48 |
+ o update ggtree-treeAnnotation vignette <2014-12-20, Sat> |
|
49 |
+ |
|
50 |
+CHANGES IN VERSION 0.99.1 |
|
51 |
+------------------------ |
|
52 |
+ o %<% function for updating tree view with a new tree <2014-12-19, Fri> |
|
53 |
+ o add examples in man files <2014-12-19, Fri> |
|
54 |
+ |
|
55 |
+CHANGES IN VERSION 0.2.3 |
|
56 |
+------------------------ |
|
57 |
+ o add README.md <2014-12-19, Fri> |
|
58 |
+ o update ggtree-treeViewer vignette <2014-12-19, Fri> |
|
59 |
+ o use BiocStyle in vignette <2014-12-19, Fri> |
|
60 |
+ o geom_nplace and geom_place layer <2014-12-18, Thu> |
|
61 |
+ o add theme_tree2 theme for showing evolution distance <2014-12-18, Thu> |
|
62 |
+ o rm.singleton.newick now supports internal node like: |
|
63 |
+ ((()X, ()Y)Z)AA, in which Z is a singleton. <2014-12-15, Mon> |
|
64 |
+ |
|
65 |
+CHANGES IN VERSION 0.2.2 |
|
66 |
+------------------------ |
|
67 |
+ o rm.singleton.newick <2014-12-09, Tue> |
|
68 |
+ o as.binary method <2014-12-09, Tue> |
|
69 |
+ |
|
70 |
+CHANGES IN VERSION 0.2.1 |
|
71 |
+------------------------ |
|
72 |
+ o geom_eplace <2014-12-07, Sun> |
|
73 |
+ |
|
74 |
+CHANGES IN VERSION 0.2.0 |
|
75 |
+------------------------ |
|
76 |
+ o read.jplace to read the jplace file <2014-12-05, Fri> |
|
77 |
+ o jplace class for storing information of jplace file <2014-12-05, Fri> |
|
78 |
+ o show method of jplace class <2014-12-05, Fri> |
|
79 |
+ o get.tree method to get tree from jplace class <2014-12-05, Fri> |
|
80 |
+ o extend ggplot2 to support jplace class <2014-12-05, Fri> |
|
81 |
+ |
|
82 |
+CHANGES IN VERSION 0.1.1 |
|
83 |
+------------------------ |
|
84 |
+ o add distance legend in ggtree <2014-12-05, Fri> |
|
85 |
+ |
|
86 |
+CHANGES IN VERSION 0.1.0 |
|
87 |
+------------------------ |
|
88 |
+ o support ladderize tree <2014-12-05, Fri> |
|
89 |
+ o implement geom_tree, geom_tiplab, geom_tippoint, geom_aline and theme_tree <2014-12-04, Thu> |
|
90 |
+ o extend ggplot to support phylo object and implement ggtree function <2014-12-04, Thu> |
|
91 |
+ o implement fortify function <2014-12-04, Thu> |
|
92 |
+ o add getRoot, isRoot and getParent functions <2014-12-03, Wed> |
0 | 93 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,198 @@ |
1 |
+setOldClass("phylo") |
|
2 |
+ |
|
3 |
+ |
|
4 |
+##' Class "hyphy" |
|
5 |
+##' This class stores information of HYPHY output |
|
6 |
+##' |
|
7 |
+##' |
|
8 |
+##' @name hyphy-class |
|
9 |
+##' @docType class |
|
10 |
+##' @slot fields available features |
|
11 |
+##' @slot treetext tree text |
|
12 |
+##' @slot phylo phylo object |
|
13 |
+##' @slot seq_type one of "NT" and "AA" |
|
14 |
+##' @slot subs sequence substitutions |
|
15 |
+##' @slot AA_subs Amino acid sequence substitution |
|
16 |
+##' @slot ancseq ancestral sequences |
|
17 |
+##' @slot tip_seq tip sequences |
|
18 |
+##' @slot tip.fasfile fasta file of tip sequences |
|
19 |
+##' @slot tree.file tree file |
|
20 |
+##' @slot ancseq.file ancestral sequence file, nexus format |
|
21 |
+##' @exportClass hyphy |
|
22 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
23 |
+##' @seealso \linkS4class{paml_rst} |
|
24 |
+##' @keywords classes |
|
25 |
+setClass("hyphy", |
|
26 |
+ representation = representation( |
|
27 |
+ fields = "character", |
|
28 |
+ treetext = "character", |
|
29 |
+ phylo = "phylo", |
|
30 |
+ seq_type = "character", |
|
31 |
+ subs = "data.frame", |
|
32 |
+ AA_subs = "data.frame", |
|
33 |
+ ancseq = "character", |
|
34 |
+ tip_seq = "character", |
|
35 |
+ tip.fasfile = "character", |
|
36 |
+ tree.file = "character", |
|
37 |
+ ancseq.file = "character" |
|
38 |
+ ) |
|
39 |
+ ) |
|
40 |
+ |
|
41 |
+ |
|
42 |
+##' Class "paml_rst" |
|
43 |
+##' This class stores information of rst file from PAML output |
|
44 |
+##' |
|
45 |
+##' |
|
46 |
+##' @name paml_rst-class |
|
47 |
+##' @aliases paml_rst-class |
|
48 |
+##' set.subs,paml_rst-method |
|
49 |
+##' set.subs<-,paml_rst-method |
|
50 |
+##' |
|
51 |
+##' @docType class |
|
52 |
+##' @slot fields availabel attributes |
|
53 |
+##' @slot treetext tree text |
|
54 |
+##' @slot phylo phylo object |
|
55 |
+##' @slot seq_type one of "NT" and "AA" |
|
56 |
+##' @slot tip_seq sequences of tips |
|
57 |
+##' @slot marginal_ancseq Marginal reconstruction of ancestral sequences |
|
58 |
+##' @slot joint_ancseq Joint reconstruction of ancestral sequences |
|
59 |
+##' @slot marginal_subs sequence substitutions based on marginal_ancseq |
|
60 |
+##' @slot joint_subs sequence substitutions based on joint_ancseq |
|
61 |
+##' @slot marginal_AA_subs Amino acid sequence substitutions based on marginal_ancseq |
|
62 |
+##' @slot joint_AA_subs Amino acid sequence substitutions based on joint_ancseq |
|
63 |
+##' @slot tip.fasfile fasta file of tip sequences |
|
64 |
+##' @slot rstfile rst file |
|
65 |
+##' @exportClass paml_rst |
|
66 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
67 |
+##' @seealso \linkS4class{codeml} \linkS4class{codeml_mlc} |
|
68 |
+##' @keywords classes |
|
69 |
+setClass("paml_rst", |
|
70 |
+ representation = representation( |
|
71 |
+ fields = "character", |
|
72 |
+ treetext = "character", |
|
73 |
+ phylo = "phylo", |
|
74 |
+ seq_type = "character", |
|
75 |
+ tip_seq = "character", |
|
76 |
+ marginal_ancseq = "character", |
|
77 |
+ joint_ancseq = "character", |
|
78 |
+ marginal_subs = "data.frame", |
|
79 |
+ joint_subs = "data.frame", |
|
80 |
+ marginal_AA_subs = "data.frame", |
|
81 |
+ joint_AA_subs = "data.frame", |
|
82 |
+ tip.fasfile = "character", |
|
83 |
+ rstfile = "character" |
|
84 |
+ ) |
|
85 |
+ ) |
|
86 |
+ |
|
87 |
+##' Class "codeml_mlc" |
|
88 |
+##' This class stores information of mlc file frm codeml output |
|
89 |
+##' |
|
90 |
+##' |
|
91 |
+##' @name codeml_mlc-class |
|
92 |
+##' @docType class |
|
93 |
+##' @slot fields available features |
|
94 |
+##' @slot treetext tree text |
|
95 |
+##' @slot phylo phylo object |
|
96 |
+##' @slot dNdS dN dS information |
|
97 |
+##' @slot seq_type one of "NT" and "AA" |
|
98 |
+##' @slot tip_seq sequences of tips |
|
99 |
+##' @slot mlcfile mlc file |
|
100 |
+##' @exportClass codeml_mlc |
|
101 |
+##' @author Guangchuang Yu |
|
102 |
+##' @seealso \linkS4class{paml_rst} \linkS4class{codeml} |
|
103 |
+##' @keywords classes |
|
104 |
+setClass("codeml_mlc", |
|
105 |
+ representation = representation( |
|
106 |
+ fields = "character", |
|
107 |
+ treetext = "character", |
|
108 |
+ phylo = "phylo", |
|
109 |
+ dNdS = "matrix", |
|
110 |
+ seq_type = "character", |
|
111 |
+ tip_seq = "character", |
|
112 |
+ mlcfile = "character" |
|
113 |
+ ) |
|
114 |
+ ) |
|
115 |
+ |
|
116 |
+##' Class "codeml" |
|
117 |
+##' This class stores information of output from codeml |
|
118 |
+##' |
|
119 |
+##' |
|
120 |
+##' @name codeml-class |
|
121 |
+##' @docType class |
|
122 |
+##' @slot mlc A \code{code_mlc} object |
|
123 |
+##' @slot rst A \code{paml_rst} object |
|
124 |
+##' @exportClass codeml |
|
125 |
+##' @seealso \linkS4class{codeml_mlc} \linkS4class{paml_rst} |
|
126 |
+##' @keywords codeml |
|
127 |
+setClass("codeml", |
|
128 |
+ representation = representation( |
|
129 |
+ mlc = "codeml_mlc", |
|
130 |
+ rst = "paml_rst" |
|
131 |
+ ) |
|
132 |
+ ) |
|
133 |
+ |
|
134 |
+##' Class "jplace" |
|
135 |
+##' This class stores information of jplace file. |
|
136 |
+##' |
|
137 |
+##' |
|
138 |
+##' @name jplace-class |
|
139 |
+##' @aliases jplace-class |
|
140 |
+##' show,jplace-method |
|
141 |
+##' get.placements,jplace-method |
|
142 |
+##' get.treeinfo,jplace-method |
|
143 |
+##' get.fields,jplace-method |
|
144 |
+##' get.treetext,jplace-method |
|
145 |
+##' |
|
146 |
+##' @docType class |
|
147 |
+##' @slot fields colnames of first variable of placements |
|
148 |
+##' @slot treetext tree text |
|
149 |
+##' @slot placements placement information |
|
150 |
+##' @slot version version |
|
151 |
+##' @slot metadata metadata |
|
152 |
+##' @slot file jplace file |
|
153 |
+##' @exportClass jplace |
|
154 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
155 |
+##' @seealso \code{\link{show}} \code{\link{get.tree}} |
|
156 |
+##' \code{\link{ggtree}} |
|
157 |
+##' @keywords classes |
|
158 |
+setClass("jplace", |
|
159 |
+ representation = representation( |
|
160 |
+ fields = "character", |
|
161 |
+ treetext = "character", |
|
162 |
+ placements = "data.frame", |
|
163 |
+ version = "numeric", |
|
164 |
+ metadata = "list", |
|
165 |
+ file = "character" |
|
166 |
+ ) |
|
167 |
+ ) |
|
168 |
+ |
|
169 |
+##' Class "beast" |
|
170 |
+##' This class stores information of beast output |
|
171 |
+##' |
|
172 |
+##' |
|
173 |
+##' @name beast-class |
|
174 |
+##' @aliases beast-class |
|
175 |
+##' get.tree,beast-method |
|
176 |
+##' |
|
177 |
+##' @docType class |
|
178 |
+##' @slot fields beast statistic variables |
|
179 |
+##' @slot treetext tree text in beast file |
|
180 |
+##' @slot phylo tree phylo object |
|
181 |
+##' @slot translation tip number to name translation in beast file |
|
182 |
+##' @slot stats beast statistics |
|
183 |
+##' @slot file beast file, nexus format |
|
184 |
+##' @exportClass beast |
|
185 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
186 |
+##' @seealso \code{\link{show}} \code{\link{get.fields}} |
|
187 |
+##' \code{\link{ggtree}} |
|
188 |
+##' @keywords classes |
|
189 |
+setClass("beast", |
|
190 |
+ representation = representation( |
|
191 |
+ fields = "character", |
|
192 |
+ treetext = "character", |
|
193 |
+ phylo = "phylo", |
|
194 |
+ translation = "matrix", |
|
195 |
+ stats = "data.frame", |
|
196 |
+ file = "character" |
|
197 |
+ ) |
|
198 |
+ ) |
0 | 199 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,95 @@ |
1 |
+##' @title as.binary |
|
2 |
+##' @param tree phylo, object |
|
3 |
+##' @param ... additional parameter |
|
4 |
+##' @rdname as.binary |
|
5 |
+##' @export |
|
6 |
+as.binary <- function(tree, ...) { |
|
7 |
+ UseMethod("as.binary") |
|
8 |
+} |
|
9 |
+ |
|
10 |
+##' plot method generics |
|
11 |
+##' |
|
12 |
+##' |
|
13 |
+##' @docType methods |
|
14 |
+##' @name plot |
|
15 |
+##' @rdname plot-methods |
|
16 |
+##' @title plot method |
|
17 |
+##' @param x object |
|
18 |
+##' @param ... Additional argument list |
|
19 |
+##' @return plot |
|
20 |
+##' @importFrom stats4 plot |
|
21 |
+##' @export |
|
22 |
+if ( !isGeneric("plot") ) |
|
23 |
+ setGeneric("plot", function(x, ...) standardGeneric("plot")) |
|
24 |
+ |
|
25 |
+ |
|
26 |
+##' @docType methods |
|
27 |
+##' @name get.tree |
|
28 |
+##' @rdname get.tree-methods |
|
29 |
+##' @title get.tree method |
|
30 |
+##' @param object one of \code{jplace}, \code{beast} object |
|
31 |
+##' @param ... additional parameter |
|
32 |
+##' @return phylo object |
|
33 |
+##' @export |
|
34 |
+setGeneric("get.tree", function(object, ...) standardGeneric("get.tree")) |
|
35 |
+ |
|
36 |
+##' @docType methods |
|
37 |
+##' @name get.treetext |
|
38 |
+##' @rdname get.treetext-methods |
|
39 |
+##' @title get.treetext method |
|
40 |
+##' @param object one of \code{jplace}, \code{beast} object |
|
41 |
+##' @param ... additional parameter |
|
42 |
+##' @return phylo object |
|
43 |
+##' @export |
|
44 |
+setGeneric("get.treetext", function(object, ...) standardGeneric("get.treetext")) |
|
45 |
+ |
|
46 |
+ |
|
47 |
+##' @docType methods |
|
48 |
+##' @name get.treeinfo |
|
49 |
+##' @rdname get.treeinfo-methods |
|
50 |
+##' @title get.treeinfo method |
|
51 |
+##' @param object jplace object |
|
52 |
+##' @param layout layout |
|
53 |
+##' @param ladderize ladderize, logical |
|
54 |
+##' @param right logical, parameter for ladderize |
|
55 |
+##' @param ... additional parameter |
|
56 |
+##' @return data.frame |
|
57 |
+##' @export |
|
58 |
+setGeneric("get.treeinfo", function(object, layout="phylogram", ladderize=TRUE, right=FALSE, ...) standardGeneric("get.treeinfo")) |
|
59 |
+ |
|
60 |
+ |
|
61 |
+##' @docType methods |
|
62 |
+##' @name get.fields |
|
63 |
+##' @rdname get.fields-methods |
|
64 |
+##' @title get.fields method |
|
65 |
+##' @param object one of \code{jplace}, \code{beast} object |
|
66 |
+##' @param ... additional parameter |
|
67 |
+##' @return available annotation variables |
|
68 |
+##' @export |
|
69 |
+setGeneric("get.fields", function(object, ...) standardGeneric("get.fields")) |
|
70 |
+ |
|
71 |
+ |
|
72 |
+##' @docType methods |
|
73 |
+##' @name get.placements |
|
74 |
+##' @rdname get.placements-methods |
|
75 |
+##' @title get.placements method |
|
76 |
+##' @param object jplace object |
|
77 |
+##' @param by get best hit or others |
|
78 |
+##' @param ... additional parameter |
|
79 |
+##' @return data.frame |
|
80 |
+##' @export |
|
81 |
+setGeneric("get.placements", function(object, by, ...) standardGeneric("get.placements")) |
|
82 |
+ |
|
83 |
+##' @docType methods |
|
84 |
+##' @name get.subs |
|
85 |
+##' @rdname get.subs-methods |
|
86 |
+##' @title get.subs method |
|
87 |
+##' @param object paml_rst object |
|
88 |
+##' @param type one of 'marginal_subs', 'marginal_AA_subs', |
|
89 |
+##' 'joint_subs' or 'joint_AA_subs'. |
|
90 |
+##' @param ... additional parameter |
|
91 |
+##' @return data.frame |
|
92 |
+##' @export |
|
93 |
+setGeneric("get.subs", function(object, type, ...) standardGeneric("get.subs")) |
|
94 |
+ |
|
95 |
+ |
0 | 96 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,88 @@ |
1 |
+##' neighbor-joining method |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title NJ |
|
5 |
+##' @param X distance matrix |
|
6 |
+##' @return phylo object |
|
7 |
+##' @author ygc |
|
8 |
+##' @examples |
|
9 |
+##' \dontrun{ |
|
10 |
+##' X <- matrix(c(0,5,4,7,6,8, |
|
11 |
+##' 5,0,7,10,9,11, |
|
12 |
+##' 4,7,0,7,6,8, |
|
13 |
+##' 7,10,7,0,5,9, |
|
14 |
+##' 6,9,6,5,0,8, |
|
15 |
+##' 8,11,8,9,8,0), ncol=6) |
|
16 |
+##' rownames(X) <- colnames(X) <- LETTERS[1:6] |
|
17 |
+##' tree <- NJ(X) |
|
18 |
+##' print(tree) |
|
19 |
+##' } |
|
20 |
+NJ <- function(X) { |
|
21 |
+ labels <- colnames(X) |
|
22 |
+ N <- ncol(X) |
|
23 |
+ otu_labs <- 1:N |
|
24 |
+ |
|
25 |
+ dm <- as.matrix(X) |
|
26 |
+ S <- colSums(dm) |
|
27 |
+ |
|
28 |
+ ## edge list of node 1 and node 2 |
|
29 |
+ edge1 <- edge2 <- numeric(2*N-3) |
|
30 |
+ edge_length <- numeric(2*N-3) |
|
31 |
+ k <- 1 |
|
32 |
+ cur_node <- 2*N-2 |
|
33 |
+ while (N > 3) { |
|
34 |
+ ds <- 1e50 |
|
35 |
+ for (i in 1:(N-1)) { |
|
36 |
+ for (j in (i+1):N) { |
|
37 |
+ A <- N * dm[i,j] - S[i] - S[j] |
|
38 |
+ if (A < ds) { |
|
39 |
+ OUT1 <- i; |
|
40 |
+ OUT2 <- j; |
|
41 |
+ ds <- A |
|
42 |
+ } |
|
43 |
+ } |
|
44 |
+ } |
|
45 |
+ edge2[k] <- otu_labs[OUT1] |
|
46 |
+ edge2[k+1] <- otu_labs[OUT2] |
|
47 |
+ edge1[k] <- edge1[k+1] <- cur_node |
|
48 |
+ dij <- dm[OUT1, OUT2] |
|
49 |
+ B <- (S[OUT1]-S[OUT2]) / (N-2) |
|
50 |
+ edge_length[k] <- (dij + B)/2 |
|
51 |
+ edge_length[k+1] <- (dij - B)/2 |
|
52 |
+ |
|
53 |
+ ij <- 1 |
|
54 |
+ new_dist <- numeric(N-2) |
|
55 |
+ ## d_kn=1/2(d_ik+d_jk−d_ij) |
|
56 |
+ for (i in 1:N) { |
|
57 |
+ if (i == OUT1 || i == OUT2) next |
|
58 |
+ x <- dm[i, OUT1] |
|
59 |
+ y <- dm[i, OUT2] |
|
60 |
+ new_dist[ij] <- 1/2 * (x+y-dij) |
|
61 |
+ ij <- ij + 1 |
|
62 |
+ } |
|
63 |
+ ## update data |
|
64 |
+ dm <- dm[-c(OUT1, OUT2), -c(OUT1, OUT2)] |
|
65 |
+ dm <- rbind(dm, new_dist) |
|
66 |
+ dm <- cbind(dm, c(new_dist, 0)) |
|
67 |
+ otu_labs <- otu_labs[-c(OUT1, OUT2)] |
|
68 |
+ otu_labs <- c(otu_labs, cur_node) |
|
69 |
+ rownames(dm) <- otu_labs |
|
70 |
+ colnames(dm) <- otu_labs |
|
71 |
+ S <- colSums(dm) |
|
72 |
+ cur_node <- cur_node-1 |
|
73 |
+ k <- k+2 |
|
74 |
+ N <- N - 1 |
|
75 |
+ } |
|
76 |
+ |
|
77 |
+ n <- length(edge1) |
|
78 |
+ edge1[(n-2):n] <- cur_node |
|
79 |
+ edge2[(n-2):n] <- otu_labs |
|
80 |
+ edge_length[n-2] <- (dm[1,2]+dm[1,3]-dm[2,3])/2 |
|
81 |
+ edge_length[n-1] <- (dm[2,1]+dm[2,3]-dm[1,3])/2 |
|
82 |
+ edge_length[n] <- (dm[3,1]+dm[3,2]-dm[1,2])/2 |
|
83 |
+ obj <- list(edge=cbind(as.numeric(edge1), as.numeric(edge2)), |
|
84 |
+ edge.length=edge_length, |
|
85 |
+ tip.label=labels, Nnode=length(labels)-2) |
|
86 |
+ class(obj) <- "phylo" |
|
87 |
+ return(obj) |
|
88 |
+} |
0 | 89 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,265 @@ |
1 |
+ |
|
2 |
+##' read beast output |
|
3 |
+##' |
|
4 |
+##' |
|
5 |
+##' @title read.beast |
|
6 |
+##' @param file beast file |
|
7 |
+##' @return \code{beast} object |
|
8 |
+##' @importFrom ape read.nexus |
|
9 |
+##' @export |
|
10 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
11 |
+##' @examples |
|
12 |
+##' file <- system.file("extdata/BEAST", "beast_mcc.tree", package="ggtree") |
|
13 |
+##' read.beast(file) |
|
14 |
+read.beast <- function(file) { |
|
15 |
+ stats <- read.stats_beast(file) |
|
16 |
+ fields <- sub("_lower|_upper", "", names(stats)) %>% unique |
|
17 |
+ fields %<>% `[`(.!="node") |
|
18 |
+ |
|
19 |
+ new("beast", |
|
20 |
+ fields = fields, |
|
21 |
+ treetext = read.treetext_beast(file), |
|
22 |
+ phylo = read.nexus(file), |
|
23 |
+ translation = read.trans_beast(file), |
|
24 |
+ stats = stats, |
|
25 |
+ file = file |
|
26 |
+ ) |
|
27 |
+} |
|
28 |
+ |
|
29 |
+##' @rdname plot-methods |
|
30 |
+##' @exportMethod plot |
|
31 |
+##' @param tip.label.size size of tip label |
|
32 |
+##' @param tip.label.hjust hjust of tip.label |
|
33 |
+##' @param annotation.size size of annotation |
|
34 |
+##' @param annotation.color color of annotation |
|
35 |
+##' @examples |
|
36 |
+##' file <- system.file("extdata/BEAST", "beast_mcc.tree", package="ggtree") |
|
37 |
+##' beast <- read.beast(file) |
|
38 |
+##' plot(beast, annotation="length_0.95_HPD", branch.length="none") + theme_tree() |
|
39 |
+setMethod("plot", signature( x= "beast"), |
|
40 |
+ function(x, layout = "phylogram", |
|
41 |
+ branch.length = "branch.length", |
|
42 |
+ show.tip.label = TRUE, |
|
43 |
+ tip.label.size = 4, |
|
44 |
+ tip.label.hjust = -0.1, |
|
45 |
+ position = "branch", |
|
46 |
+ annotation = "rate", |
|
47 |
+ ndigits = 2, |
|
48 |
+ annotation.size = 3, |
|
49 |
+ annotation.color = "black", |
|
50 |
+ ...) { |
|
51 |
+ |
|
52 |
+ p <- ggtree(x, layout = layout, |
|
53 |
+ branch.length = branch.length, |
|
54 |
+ ndigits = ndigits, ...) |
|
55 |
+ |
|
56 |
+ if (show.tip.label) { |
|
57 |
+ p <- p + geom_tiplab(hjust = tip.label.hjust, |
|
58 |
+ size = tip.label.size) |
|
59 |
+ offset <- ceiling(max(p$data$x)) * 0.1 |
|
60 |
+ p <- p + xlim(-offset, max(p$data$x) + offset) |
|
61 |
+ } |
|
62 |
+ if (!is.null(annotation) && !is.na(annotation)) { |
|
63 |
+ p <- p + geom_text(aes_string(x=position, |
|
64 |
+ label=annotation), |
|
65 |
+ size=annotation.size, vjust=-.5, |
|
66 |
+ color=annotation.color) |
|
67 |
+ } |
|
68 |
+ p + theme_tree2() |
|
69 |
+ }) |
|
70 |
+ |
|
71 |
+##' @rdname show-methods |
|
72 |
+##' @importFrom ape print.phylo |
|
73 |
+##' @exportMethod show |
|
74 |
+setMethod("show", signature(object = "beast"), |
|
75 |
+ function(object) { |
|
76 |
+ cat("'beast' S4 object that stored information of\n\t", |
|
77 |
+ paste0("'", object@file, "'.\n\n")) |
|
78 |
+ cat("...@ tree: ") |
|
79 |
+ print.phylo(get.tree(object)) |
|
80 |
+ cat("\nwith the following features available:\n") |
|
81 |
+ print_fields(object) |
|
82 |
+ }) |
|
83 |
+ |
|
84 |
+ |
|
85 |
+##' get.tree method |
|
86 |
+##' |
|
87 |
+##' |
|
88 |
+##' @docType methods |
|
89 |
+##' @name get.tree |
|
90 |
+##' @rdname get.tree-methods |
|
91 |
+##' @aliases get.tree,beast |
|
92 |
+##' @exportMethod get.tree |
|
93 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
94 |
+##' @usage get.tree(object, ...) |
|
95 |
+setMethod("get.tree", signature(object="beast"), |
|
96 |
+ function(object,...) { |
|
97 |
+ object@phylo |
|
98 |
+ } |
|
99 |
+ ) |
|
100 |
+ |
|
101 |
+ |
|
102 |
+##' @rdname get.fields-methods |
|
103 |
+##' @exportMethod get.fields |
|
104 |
+setMethod("get.fields", signature(object="beast"), |
|
105 |
+ function(object, ...) { |
|
106 |
+ object@fields |
|
107 |
+ } |
|
108 |
+ ) |
|
109 |
+ |
|
110 |
+ |
|
111 |
+read.treetext_beast <- function(file) { |
|
112 |
+ beast <- readLines(file) |
|
113 |
+ ii <- grep("tree TREE1\\s+=", beast) |
|
114 |
+ jj <- grep("End;", beast) |
|
115 |
+ jj <- jj[jj > ii][1] |
|
116 |
+ tree <- beast[ii:(jj-1)] |
|
117 |
+ if (length(tree) > 1) { |
|
118 |
+ tree <- paste0(tree) |
|
119 |
+ } |
|
120 |
+ tree %<>% sub("tree TREE1\\s+=\\s+\\[&R\\]\\s+", "", .) |
|
121 |
+ return(tree) |
|
122 |
+} |
|
123 |
+ |
|
124 |
+read.trans_beast <- function(file) { |
|
125 |
+ beast <- readLines(file) |
|
126 |
+ i <- grep("TRANSLATE", beast, ignore.case = TRUE) |
|
127 |
+ end <- grep(";", beast) |
|
128 |
+ j <- end[end %>% `>`(i) %>% which %>% `[`(1)] |
|
129 |
+ trans <- beast[(i+1):j] |
|
130 |
+ trans %<>% gsub("\\t+", "", .) |
|
131 |
+ trans %<>% gsub(",|;", "", .) |
|
132 |
+ trans %<>% `[`(nzchar(trans)) |
|
133 |
+ ## remove quote if strings were quoted |
|
134 |
+ trans %<>% gsub("'|\"", "",.) |
|
135 |
+ trans %<>% sapply(., strsplit, split="\\s+") |
|
136 |
+ trans %<>% do.call(rbind, .) |
|
137 |
+ ## trans is a matrix |
|
138 |
+ return(trans) |
|
139 |
+} |
|
140 |
+ |
|
141 |
+read.stats_beast <- function(file) { |
|
142 |
+ beast <- readLines(file) |
|
143 |
+ tree <- read.treetext_beast(file) |
|
144 |
+ |
|
145 |
+ tree2 <- gsub("\\[[^\\[]*\\]", "", tree) |
|
146 |
+ phylo <- read.tree(text = tree2) |
|
147 |
+ if(is.null(phylo$node.label)) { |
|
148 |
+ nnode <- phylo$Nnode |
|
149 |
+ nlab <- paste("X", 1:nnode, sep="") |
|
150 |
+ for (i in 1:nnode) { |
|
151 |
+ tree2 <- sub("\\)([:;])", paste0("\\)", nlab[i], "\\1"), tree2) |
|
152 |
+ } |
|
153 |
+ } |
|
154 |
+ |
|
155 |
+ ## node name corresponding to stats |
|
156 |
+ nn <- strsplit(tree2, split=",") %>% unlist %>% |
|
157 |
+ strsplit(., split="\\)") %>% unlist %>% |
|
158 |
+ gsub("\\(*", "", .) %>% |
|
159 |
+ gsub("[:;].*", "", .) |
|
160 |
+ |
|
161 |
+ phylo <- read.tree(text = tree2) |
|
162 |
+ root <- getRoot(phylo) |
|
163 |
+ nnode <- phylo$Nnode |
|
164 |
+ |
|
165 |
+ ## phylo2 <- read.nexus(file) |
|
166 |
+ ## treeinfo <- fortify.phylo(phylo) |
|
167 |
+ ## treeinfo2 <- fortify.phylo(phylo2) |
|
168 |
+ ## treeinfo$label2 <- NA |
|
169 |
+ ## treeinfo$label2[treeinfo$isTip] <- treeinfo2$node[as.numeric(treeinfo$label[treeinfo$isTip])] |
|
170 |
+ ## treeinfo$visited <- FALSE |
|
171 |
+ ## root <- getRoot(phylo2) |
|
172 |
+ ## treeinfo[root, "visited"] <- TRUE |
|
173 |
+ ## currentNode <- 1:Ntip(phylo2) |
|
174 |
+ ## while(any(treeinfo$visited == FALSE)) { |
|
175 |
+ ## pNode <- c() |
|
176 |
+ ## for (kk in currentNode) { |
|
177 |
+ ## i <- which(treeinfo$label2 == kk) |
|
178 |
+ ## treeinfo[i, "visited"] <- TRUE |
|
179 |
+ ## j <- which(treeinfo2$node == kk) |
|
180 |
+ ## ip <- treeinfo$parent[i] |
|
181 |
+ ## if (ip != root) { |
|
182 |
+ ## ii <- which(treeinfo$node == ip) |
|
183 |
+ ## if (treeinfo$visited[ii] == FALSE) { |
|
184 |
+ ## jp <- treeinfo2$parent[j] |
|
185 |
+ ## jj <- which(treeinfo2$node == jp) |
|
186 |
+ ## treeinfo[ii, "label2"] <- treeinfo2[jj, "node"] |
|
187 |
+ ## pNode <- c(pNode, jp) |
|
188 |
+ ## } |
|
189 |
+ ## treeinfo[ii, "visited"] <- TRUE |
|
190 |
+ ## } |
|
191 |
+ ## } |
|
192 |
+ ## currentNode <- unique(pNode) |
|
193 |
+ ## } |
|
194 |
+ ## treeinfo[root, "label2"] <- root |
|
195 |
+ ## ## convert nn to node that encoded in phylo2 |
|
196 |
+ ## node <- treeinfo$label2[match(nn, treeinfo$label)] |
|
197 |
+ |
|
198 |
+ |
|
199 |
+ #################################################### |
|
200 |
+ ## ## |
|
201 |
+ ## after doing it in the hard way ## |
|
202 |
+ ## I finally figure out the following easy way ## |
|
203 |
+ ## ## |
|
204 |
+ #################################################### |
|
205 |
+ treeinfo <- fortify.phylo(phylo) |
|
206 |
+ label2 <- c(treeinfo[treeinfo$isTip, "label"], |
|
207 |
+ root:(root+nnode-1)) |
|
208 |
+ node <- label2[match(nn, treeinfo$label)] |
|
209 |
+ |
|
210 |
+ |
|
211 |
+ |
|
212 |
+ stats <- unlist(strsplit(tree, "\\["))[-1] |
|
213 |
+ stats <- sub(":.+$", "", stats) |
|
214 |
+ stats <- sub("^&", "", stats) |
|
215 |
+ stats <- sub("];*$", "", stats) |
|
216 |
+ |
|
217 |
+ stats2 <- lapply(stats, function(x) { |
|
218 |
+ y <- unlist(strsplit(x, ",")) |
|
219 |
+ idx <- grep("=\\{", y) |
|
220 |
+ names.range <- gsub("=\\{.*", "", y[idx]) |
|
221 |
+ nr.lower <- paste0(names.range, "_lower") |
|
222 |
+ nr.upper <- paste0(names.range, "_upper") |
|
223 |
+ |
|
224 |
+ lo <- as.numeric(gsub(".*=\\{", "", y[idx])) |
|
225 |
+ hi <- as.numeric(gsub("\\}", "", y[idx+1])) |
|
226 |
+ |
|
227 |
+ |
|
228 |
+ jj <- -c(idx, idx+1) |
|
229 |
+ names <- gsub("=.*", "", y[jj]) |
|
230 |
+ val <- as.numeric(gsub(".*=", "", y[jj])) |
|
231 |
+ |
|
232 |
+ nn <- c(nr.lower, nr.upper, names) |
|
233 |
+ res <- numeric(length(nn)) |
|
234 |
+ names(res) <- nn |
|
235 |
+ for (i in seq_along(nr.lower)) { |
|
236 |
+ res[i] <- lo[i] |
|
237 |
+ } |
|
238 |
+ j <- i |
|
239 |
+ for (i in seq_along(nr.upper)) { |
|
240 |
+ res[i+j] <- hi[i] |
|
241 |
+ } |
|
242 |
+ j <- i+j |
|
243 |
+ for (i in seq_along(names)) { |
|
244 |
+ res[i+j] <- val[i] |
|
245 |
+ } |
|
246 |
+ return(res) |
|
247 |
+ }) |
|
248 |
+ |
|
249 |
+ nn <- lapply(stats2, names) %>% unlist %>% |
|
250 |
+ unique %>% sort |
|
251 |
+ |
|
252 |
+ ## stats3 is a matrix |
|
253 |
+ stats3 <- t(sapply(stats2, function(x) { |
|
254 |
+ for (ii in nn[!nn %in% names(x)]) { |
|
255 |
+ x[ii] <- NA |
|
256 |
+ } |
|
257 |
+ x[nn] |
|
258 |
+ })) |
|
259 |
+ |
|
260 |
+ stats3 <- as.data.frame(stats3) |
|
261 |
+ stats3$node <- node |
|
262 |
+ colnames(stats3) <- gsub("(\\d+)%", "0.\\1", colnames(stats3)) |
|
263 |
+ return(stats3) |
|
264 |
+} |
|
265 |
+ |
0 | 266 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,106 @@ |
1 |
+##' read baseml output |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title read.codeml |
|
5 |
+##' @param rstfile rst file |
|
6 |
+##' @param mlcfile mlc file |
|
7 |
+##' @return A \code{codeml} object |
|
8 |
+##' @export |
|
9 |
+##' @author ygc |
|
10 |
+##' @examples |
|
11 |
+##' rstfile <- system.file("extdata/PAML_Codeml", "rst", package="ggtree") |
|
12 |
+##' mlcfile <- system.file("extdata/PAML_Codeml", "mlc", package="ggtree") |
|
13 |
+##' read.codeml(rstfile, mlcfile) |
|
14 |
+read.codeml <- function(rstfile, mlcfile) { |
|
15 |
+ rst = read.paml_rst(rstfile) |
|
16 |
+ mlc = read.codeml_mlc(mlcfile) |
|
17 |
+ rst@tip_seq <- mlc@tip_seq |
|
18 |
+ new("codeml", |
|
19 |
+ rst = set.paml_rst_(rst), |
|
20 |
+ mlc = mlc |
|
21 |
+ ) |
|
22 |
+} |
|
23 |
+ |
|
24 |
+ |
|
25 |
+##' @rdname show-methods |
|
26 |
+##' @exportMethod show |
|
27 |
+setMethod("show", signature(object = "codeml"), |
|
28 |
+ function(object) { |
|
29 |
+ cat("'codeml' S4 object that stored information of\n\t", |
|
30 |
+ paste0("'", object@rst@rstfile, "' and \n\t'", |
|
31 |
+ object@mlc@mlcfile, "'."), |
|
32 |
+ "\n\n") |
|
33 |
+ cat("...@ tree:") |
|
34 |
+ print.phylo(get.tree(object)) |
|
35 |
+ cat("\nwith the following features available:\n") |
|
36 |
+ print_fields(object, len=4) |
|
37 |
+ }) |
|
38 |
+ |
|
39 |
+ |
|
40 |
+##' @rdname get.tree-methods |
|
41 |
+##' @exportMethod get.tree |
|
42 |
+##' @param by one of rst or mlc |
|
43 |
+setMethod("get.tree", signature(object="codeml"), |
|
44 |
+ function(object, by="rst", ...) { |
|
45 |
+ if (by == "rst") { |
|
46 |
+ return(object@rst@phylo) |
|
47 |
+ } else { |
|
48 |
+ return(object@mlc@phylo) |
|
49 |
+ } |
|
50 |
+ }) |
|
51 |
+ |
|
52 |
+##' @rdname get.subs-methods |
|
53 |
+##' @exportMethod get.subs |
|
54 |
+setMethod("get.subs", signature(object = "codeml"), |
|
55 |
+ function(object, type, ...) { |
|
56 |
+ get.subs(object@rst, type, ...) |
|
57 |
+ } |
|
58 |
+ ) |
|
59 |
+ |
|
60 |
+ |
|
61 |
+##' @rdname get.fields-methods |
|
62 |
+##' @exportMethod get.fields |
|
63 |
+setMethod("get.fields", signature(object="codeml"), |
|
64 |
+ function(object) { |
|
65 |
+ fields <- c(get.fields(object@rst), |
|
66 |
+ get.fields(object@mlc)) |
|
67 |
+ return(unique(fields)) |
|
68 |
+ } |
|
69 |
+ ) |
|
70 |
+ |
|
71 |
+##' @rdname plot-methods |
|
72 |
+##' @exportMethod plot |
|
73 |
+##' @importFrom ggplot2 aes_string |
|
74 |
+setMethod("plot", signature(x = "codeml"), |
|
75 |
+ function(x, layout = "phylogram", |
|
76 |
+ branch.length = "mlc.branch.length", |
|
77 |
+ show.tip.label = TRUE, |
|
78 |
+ tip.label.size = 4, |
|
79 |
+ tip.label.hjust = -0.1, |
|
80 |
+ position = "branch", |
|
81 |
+ annotation = "dN.dS", |
|
82 |
+ annotation.size = 3, |
|
83 |
+ annotation.color = "black", |
|
84 |
+ ndigits = 2, |
|
85 |
+ ...) { |
|
86 |
+ |
|
87 |
+ p <- ggtree(x, layout = layout, |
|
88 |
+ branch.length = branch.length, |
|
89 |
+ ndigits=ndigits, ...) |
|
90 |
+ |
|
91 |
+ if (show.tip.label) { |
|
92 |
+ p <- p + geom_tiplab(hjust = tip.label.hjust, |
|
93 |
+ size = tip.label.size) |
|
94 |
+ } |
|
95 |
+ |
|
96 |
+ if (!is.null(annotation) && !is.na(annotation)) { |
|
97 |
+ p <- p + geom_text(aes_string(x=position, |
|
98 |
+ label = annotation), |
|
99 |
+ size = annotation.size, vjust = -.5, |
|
100 |
+ color = annotation.color) |
|
101 |
+ } |
|
102 |
+ p + theme_tree2() |
|
103 |
+ } |
|
104 |
+ ) |
|
105 |
+ |
|
106 |
+ |
0 | 107 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,110 @@ |
1 |
+##' read mlc file of codeml output |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title read.codeml_mlc |
|
5 |
+##' @param mlcfile mlc file |
|
6 |
+##' @return A \code{codeml_mlc} object |
|
7 |
+##' @export |
|
8 |
+##' @author ygc |
|
9 |
+##' @examples |
|
10 |
+##' mlcfile <- system.file("extdata/PAML_Codeml", "mlc", package="ggtree") |
|
11 |
+##' read.codeml_mlc(mlcfile) |
|
12 |
+read.codeml_mlc <- function(mlcfile) { |
|
13 |
+ tip_seq <- read.tip_seq_mlc(mlcfile) |
|
14 |
+ dNdS <- read.dnds_mlc(mlcfile) |
|
15 |
+ |
|
16 |
+ new("codeml_mlc", |
|
17 |
+ fields = colnames(dNdS)[-c(1,2)], |
|
18 |
+ treetext = read.treetext_paml_mlc(mlcfile), |
|
19 |
+ phylo = read.phylo_paml_mlc(mlcfile), |
|
20 |
+ dNdS = dNdS, |
|
21 |
+ seq_type = get_seqtype(tip_seq), |
|
22 |
+ tip_seq = tip_seq, |
|
23 |
+ mlcfile = mlcfile) |
|
24 |
+} |
|
25 |
+ |
|
26 |
+##' @rdname show-methods |
|
27 |
+##' @exportMethod show |
|
28 |
+setMethod("show", signature(object = "codeml_mlc"), |
|
29 |
+ function(object) { |
|
30 |
+ cat("'codeml_mlc' S4 object that stored information of\n\t", |
|
31 |
+ paste0("'", object@mlcfile, "'."), |
|
32 |
+ "\n\n") |
|
33 |
+ |
|
34 |
+ cat("...@ tree:") |
|
35 |
+ print.phylo(get.tree(object)) |
|
36 |
+ |
|
37 |
+ cat("\nwith the following features available:\n") |
|
38 |
+ cat("\t", paste0("'", |
|
39 |
+ paste(get.fields(object), collapse="',\t'"), |
|
40 |
+ "'."), |
|
41 |
+ "\n") |
|
42 |
+ } |
|
43 |
+ ) |
|
44 |
+ |
|
45 |
+ |
|
46 |
+##' @rdname get.fields-methods |
|
47 |
+##' @exportMethod get.fields |
|
48 |
+setMethod("get.fields", signature(object = "codeml_mlc"), |
|
49 |
+ function(object) { |
|
50 |
+ object@fields |
|
51 |
+ }) |
|
52 |
+ |
|
53 |
+##' @rdname plot-methods |
|
54 |
+##' @exportMethod plot |
|
55 |
+##' @param layout layout |
|
56 |
+##' @param branch.length branch length |
|
57 |
+##' @param show.tip.label logical |
|
58 |
+##' @param position one of "branch" and "node" |
|
59 |
+##' @param annotation one of get.fields(x) |
|
60 |
+##' @param ndigits round digits |
|
61 |
+setMethod("plot", signature(x = "codeml_mlc"), |
|
62 |
+ function(x, layout = "phylogram", |
|
63 |
+ branch.length = "branch.length", |
|
64 |
+ show.tip.label = TRUE, |
|
65 |
+ tip.label.size = 4, |
|
66 |
+ tip.label.hjust = -0.1, |
|
67 |
+ position = "branch", |
|
68 |
+ annotation = "dN_vs_dS", |
|
69 |
+ annotation.size = 3, |
|
70 |
+ annotation.color = "black", |
|
71 |
+ ndigits = 2, |
|
72 |
+ ... |
|
73 |
+ ) { |
|
74 |
+ |
|
75 |
+ p <- ggtree(x, layout=layout, |
|
76 |
+ branch.length=branch.length, |
|
77 |
+ ndigits=ndigits, ...) |
|
78 |
+ |
|
79 |
+ if (show.tip.label) { |
|
80 |
+ p <- p + geom_tiplab(hjust = tip.label.hjust, |
|
81 |
+ size = tip.label.size) |
|
82 |
+ } |
|
83 |
+ plot.codeml_mlc_(p, position, annotation, |
|
84 |
+ annotation.size, annotation.color) |
|
85 |
+ }) |
|
86 |
+ |
|
87 |
+ |
|
88 |
+plot.codeml_mlc_<- function(p, position, annotation=NULL, |
|
89 |
+ annotation.size, annotation.color){ |
|
90 |
+ |
|
91 |
+ if (!is.null(annotation) && !is.na(annotation)) { |
|
92 |
+ p <- p + geom_text(aes_string(x=position, |
|
93 |
+ label = annotation), |
|
94 |
+ size=annotation.size, vjust=-.5, |
|
95 |
+ color = annotation.color) |
|
96 |
+ } |
|
97 |
+ p + theme_tree2() |
|
98 |
+} |
|
99 |
+ |
|
100 |
+ |
|
101 |
+##' @rdname get.tree-methods |
|
102 |
+##' @exportMethod get.tree |
|
103 |
+setMethod("get.tree", signature(object = "codeml_mlc"), |
|
104 |
+ function(object, ...) { |
|
105 |
+ object@phylo |
|
106 |
+ } |
|
107 |
+ ) |
|
108 |
+ |
|
109 |
+ |
|
110 |
+ |
0 | 111 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,8 @@ |
1 |
+##' visualizing phylogenetic tree and heterogenous associated data based on grammar of graphics |
|
2 |
+##' \code{ggtree} provides functions for visualizing phylogenetic tree and its associated data in R. |
|
3 |
+##' |
|
4 |
+##' @docType package |
|
5 |
+##' @name ggtree |
|
6 |
+##' @aliases ggtree package-ggtree |
|
7 |
+NULL |
|
8 |
+ |
0 | 9 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,205 @@ |
1 |
+##' drawing phylogenetic tree from phylo object |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title ggtree |
|
5 |
+##' @param tr phylo object |
|
6 |
+##' @param showDistance add distance legend, logical |
|
7 |
+##' @param layout one of phylogram, dendrogram, cladogram, fan, radial and unrooted |
|
8 |
+##' @param ... additional parameter |
|
9 |
+##' @return tree |
|
10 |
+##' @importFrom ggplot2 ggplot |
|
11 |
+##' @importFrom ggplot2 xlab |
|
12 |
+##' @importFrom ggplot2 ylab |
|
13 |
+##' @importFrom ggplot2 annotate |
|
14 |
+##' @importFrom ggplot2 scale_x_reverse |
|
15 |
+##' @importFrom ggplot2 coord_flip |
|
16 |
+##' @importFrom ggplot2 coord_polar |
|
17 |
+##' @export |
|
18 |
+##' @author Yu Guangchuang |
|
19 |
+##' @examples |
|
20 |
+##' require(ape) |
|
21 |
+##' tr <- rtree(10) |
|
22 |
+##' ggtree(tr) |
|
23 |
+ggtree <- function(tr, showDistance=FALSE, layout="phylogram", ...) { |
|
24 |
+ d <- x <- y <- NULL |
|
25 |
+ if (layout == "fan") { |
|
26 |
+ layout <- "phylogram" |
|
27 |
+ type <- "fan" |
|
28 |
+ } else if (layout == "radial") { |
|
29 |
+ layout <- "cladogram" |
|
30 |
+ type <- "radial" |
|
31 |
+ } else if (layout == "dendrogram") { |
|
32 |
+ layout <- "phylogram" |
|
33 |
+ type <- "dendrogram" |
|
34 |
+ } else { |
|
35 |
+ type <- "none" |
|
36 |
+ } |
|
37 |
+ p <- ggplot(tr, aes(x, y), layout=layout, ...) + geom_tree(layout, ...) + xlab("") + ylab("") + theme_tree2() |
|
38 |
+ |
|
39 |
+ if (type == "dendrogram") { |
|
40 |
+ p <- p + scale_x_reverse() + coord_flip() |
|
41 |
+ } else if (type == "fan" || type == "radial") { |
|
42 |
+ p <- p + coord_polar(theta = "y") |
|
43 |
+ } |
|
44 |
+ |
|
45 |
+ if (showDistance == FALSE) { |
|
46 |
+ p <- p + theme_tree() |
|
47 |
+ } |
|
48 |
+ return(p) |
|
49 |
+} |
|
50 |
+ |
|
51 |
+##' add tree layer |
|
52 |
+##' |
|
53 |
+##' |
|
54 |
+##' @title geom_tree |
|
55 |
+##' @param layout one of phylogram, cladogram |
|
56 |
+##' @param ... additional parameter |
|
57 |
+##' @return tree layer |
|
58 |
+##' @importFrom ggplot2 geom_segment |
|
59 |
+##' @importFrom ggplot2 aes |
|
60 |
+##' @export |
|
61 |
+##' @author Yu Guangchuang |
|
62 |
+##' @examples |
|
63 |
+##' require(ape) |
|
64 |
+##' tr <- rtree(10) |
|
65 |
+##' require(ggplot2) |
|
66 |
+##' ggplot(tr) + geom_tree() |
|
67 |
+geom_tree <- function(layout="phylogram", ...) { |
|
68 |
+ x <- y <- parent <- NULL |
|
69 |
+ if (layout == "phylogram") { |
|
70 |
+ geom_segment(aes(x=c(x[parent], x[parent]), |
|
71 |
+ xend=c(x, x[parent]), |
|
72 |
+ y=c(y, y[parent]), |
|
73 |
+ yend=c(y, y)),...) |
|
74 |
+ } else if (layout == "cladogram" || layout == "unrooted") { |
|
75 |
+ geom_segment(aes(x=x[parent], |
|
76 |
+ xend=x, |
|
77 |
+ y=y[parent], |
|
78 |
+ yend=y)) |
|
79 |
+ } |
|
80 |
+} |
|
81 |
+ |
|
82 |
+##' add tip label layer |
|
83 |
+##' |
|
84 |
+##' |
|
85 |
+##' @title geom_tiplab |
|
86 |
+##' @param align align tip lab or not, logical |
|
87 |
+##' @param hjust horizontal adjustment |
|
88 |
+##' @param ... additional parameter |
|
89 |
+##' @return tip label layer |
|
90 |
+##' @importFrom ggplot2 geom_text |
|
91 |
+##' @export |
|
92 |
+##' @author Yu Guangchuang |
|
93 |
+##' @examples |
|
94 |
+##' require(ape) |
|
95 |
+##' tr <- rtree(10) |
|
96 |
+##' ggtree(tr) + geom_tiplab() |
|
97 |
+geom_tiplab <- function(align=FALSE, hjust=-.25, ...) { |
|
98 |
+ x <- y <- label <- isTip <- NULL |
|
99 |
+ if (align == TRUE) { |
|
100 |
+ geom_text(aes(x=max(x), label=label), subset=.(isTip), hjust=hjust, ...) |
|
101 |
+ } else { |
|
102 |
+ geom_text(aes(label=label), subset=.(isTip), hjust=hjust, ...) |
|
103 |
+ } |
|
104 |
+} |
|
105 |
+ |
|
106 |
+ |
|
107 |
+ |
|
108 |
+##' add horizontal align lines |
|
109 |
+##' |
|
110 |
+##' |
|
111 |
+##' @title geom_aline |
|
112 |
+##' @param linetype line type |
|
113 |
+##' @param ... additional parameter |
|
114 |
+##' @return aline layer |
|
115 |
+##' @export |
|
116 |
+##' @author Yu Guangchuang |
|
117 |
+##' @examples |
|
118 |
+##' require(ape) |
|
119 |
+##' tr <- rtree(10) |
|
120 |
+##' ggtree(tr) + geom_tiplab(align=TRUE) + geom_aline() |
|
121 |
+geom_aline <- function(linetype="dashed", ...) { |
|
122 |
+ x <- y <- isTip <- NULL |
|
123 |
+ geom_segment(aes(x=ifelse(x==max(x), x, x*1.02), |
|
124 |
+ xend=max(x), yend=y), |
|
125 |
+ subset=.(isTip), linetype=linetype, ...) |
|
126 |
+} |
|
127 |
+ |
|
128 |
+##' add points layer of tips |
|
129 |
+##' |
|
130 |
+##' |
|
131 |
+##' @title geom_tippoint |
|
132 |
+##' @param ... additional parameter |
|
133 |
+##' @return tip point layer |
|
134 |
+##' @importFrom ggplot2 geom_point |
|
135 |
+##' @export |
|
136 |
+##' @author Yu Guangchuang |
|
137 |
+##' @examples |
|
138 |
+##' require(ape) |
|
139 |
+##' tr <- rtree(10) |
|
140 |
+##' ggtree(tr) + geom_tippoint() |
|
141 |
+geom_tippoint <- function(...) { |
|
142 |
+ isTip <- NULL |
|
143 |
+ geom_point(subset=.(isTip), ...) |
|
144 |
+} |
|
145 |
+ |
|
146 |
+ |
|
147 |
+##' tree theme |
|
148 |
+##' |
|
149 |
+##' |
|
150 |
+##' @title theme_tree |
|
151 |
+##' @param bgcolor background color |
|
152 |
+##' @param fgcolor foreground color |
|
153 |
+##' @importFrom ggplot2 theme_bw |
|
154 |
+##' @importFrom ggplot2 theme |
|
155 |
+##' @importFrom ggplot2 element_blank |
|
156 |
+##' @importFrom ggplot2 %+replace% |
|
157 |
+##' @export |
|
158 |
+##' @return updated ggplot object with new theme |
|
159 |
+##' @author Yu Guangchuang |
|
160 |
+##' @examples |
|
161 |
+##' require(ape) |
|
162 |
+##' tr <- rtree(10) |
|
163 |
+##' ggtree(tr) + theme_tree() |
|
164 |
+theme_tree <- function(bgcolor="white", fgcolor="black") { |
|
165 |
+ theme_tree2() %+replace% |
|
166 |
+ theme(panel.background=element_rect(fill=bgcolor, colour=bgcolor), |
|
167 |
+ axis.line.x = element_line(color=bgcolor), |
|
168 |
+ axis.text.x = element_blank(), |
|
169 |
+ axis.ticks.x = element_blank() |
|
170 |
+ ) |
|
171 |
+} |
|
172 |
+ |
|
173 |
+##' tree2 theme |
|
174 |
+##' |
|
175 |
+##' |
|
176 |
+##' @title theme_tree2 |
|
177 |
+##' @param bgcolor background color |
|
178 |
+##' @param fgcolor foreground color |
|
179 |
+##' @importFrom ggplot2 theme_bw |
|
180 |
+##' @importFrom ggplot2 theme |
|
181 |
+##' @importFrom ggplot2 element_blank |
|
182 |
+##' @importFrom ggplot2 element_line |
|
183 |
+##' @importFrom ggplot2 %+replace% |
|
184 |
+##' @importFrom ggplot2 element_rect |
|
185 |
+##' @export |
|
186 |
+##' @return updated ggplot object with new theme |
|
187 |
+##' @author Yu Guangchuang |
|
188 |
+##' @examples |
|
189 |
+##' require(ape) |
|
190 |
+##' tr <- rtree(10) |
|
191 |
+##' ggtree(tr) + theme_tree2() |
|
192 |
+theme_tree2 <- function(bgcolor="white", fgcolor="black") { |
|
193 |
+ theme_bw() %+replace% |
|
194 |
+ theme(legend.position="none", |
|
195 |
+ panel.grid.minor=element_blank(), |
|
196 |
+ panel.grid.major=element_blank(), |
|
197 |
+ panel.background=element_rect(fill=bgcolor, colour=bgcolor), |
|
198 |
+ panel.border=element_blank(), |
|
199 |
+ axis.line=element_line(color=fgcolor), |
|
200 |
+ axis.line.y=element_line(color=bgcolor), |
|
201 |
+ axis.ticks.y=element_blank(), |
|
202 |
+ axis.text.y=element_blank() |
|
203 |
+ ) |
|
204 |
+} |
|
205 |
+ |
0 | 206 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,79 @@ |
1 |
+ |
|
2 |
+merge_baseml_hyphy <- function(baseml, hyphy) { |
|
3 |
+ ml_phylo <- baseml@mlc@phylo |
|
4 |
+ hy_phylo <- hyphy@phylo |
|
5 |
+ phylo_merge_check(ml_phylo, hy_phylo) |
|
6 |
+} |
|
7 |
+ |
|
8 |
+ |
|
9 |
+phylo_merge_check <- function(phy1, phy2) { |
|
10 |
+ if (Ntip(phy1) != Ntip(phy2)) { |
|
11 |
+ stop("Number of tip is not eqaul...") |
|
12 |
+ } |
|
13 |
+ if ( ! all(phy1$tip.label %in% phy2$tip.label)) { |
|
14 |
+ stop("tip label is not consistent...") |
|
15 |
+ } |
|
16 |
+ |
|
17 |
+ if (phy1$Nnode != phy2$Nnode) { |
|
18 |
+ stop("Number of node is not eqaul...") |
|
19 |
+ } |
|
20 |
+ if (!is.null(phy1$node.label) && !is.null(phy2$node.label)) { |
|
21 |
+ n <- getNodeNum(phy1) |
|
22 |
+ node <- (Ntip(phy1)+1):n |
|
23 |
+ if (all(phy1$node.label == node) || all(phy2$node.label == node)) { |
|
24 |
+ ## nothing happend. |
|
25 |
+ } else if (any(phy1$node.label != phy2$node.label)){ |
|
26 |
+ stop("node label is not consistent...") |
|
27 |
+ } |
|
28 |
+ } |
|
29 |
+ |
|
30 |
+ degree1 <- table(phy1$edge[,1]) %>% sort |
|
31 |
+ degree2 <- table(phy2$edge[,1]) %>% sort |
|
32 |
+ if (length(degree1) != length(degree2)) { |
|
33 |
+ stop("node degree is not consistent...") |
|
34 |
+ } else if (!all(degree1 == degree2)) { |
|
35 |
+ stop("node degree is not consistent...") |
|
36 |
+ } |
|
37 |
+} |
|
38 |
+ |
|
39 |
+ |
|
40 |
+node_mapper <- function(phy1, phy2) { |
|
41 |
+ df1 <- fortify(phy1) |
|
42 |
+ df2 <- fortify(phy2) |
|
43 |
+ |
|
44 |
+ df1$node2 <- NA |
|
45 |
+ df1$visited <- FALSE |
|
46 |
+ ntip <- Ntip(phy1) |
|
47 |
+ df1$node2[1:ntip] <- match(phy1$tip.label, phy2$tip.label) |
|
48 |
+ |
|
49 |
+ root <- getRoot(phy1) |
|
50 |
+ currentNode <- 1:ntip |
|
51 |
+ while(any(df1$visited == FALSE)) { |
|
52 |
+ pNode <- c() |
|
53 |
+ for (i in currentNode) { |
|
54 |
+ df1[i, "visited"] <- TRUE |
|
55 |
+ j <- df1[i, "node2"] |
|
56 |
+ ip <- df1[i, "parent"] |
|
57 |
+ if (df1[ip, "visited"] == FALSE) { |
|
58 |
+ jp <- df2[j, "parent"] |
|
59 |
+ df1[ip, "node2"] <- jp |
|
60 |
+ df1[ip, "visited"] <- TRUE |
|
61 |
+ } |
|
62 |
+ pNode <- c(pNode, ip) |
|
63 |
+ } |
|
64 |
+ currentNode <- unique(pNode) |
|
65 |
+ } |
|
66 |
+ |
|
67 |
+ if (df1[root, "node"] != df1[root, "node2"]) { |
|
68 |
+ stop("phylogenies not compatible...") |
|
69 |
+ } |
|
70 |
+ |
|
71 |
+ |
|
72 |
+ node <- df1$node |
|
73 |
+ names(node) <- df1$node2 |
|
74 |
+ phy2$edge <- cbind(node[as.character(phy2$edge[,1])], |
|
75 |
+ node[as.character(phy2$edge[,2])]) |
|
76 |
+ phy2$tip.label <- phy1$tip.label |
|
77 |
+ |
|
78 |
+ reorder(phy2) |
|