git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@111813 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.0 |
|
4 |
+Version: 1.3.6 |
|
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 |
... | ... |
@@ -9,11 +9,11 @@ Description: ggtree extends the ggplot2 plotting system which implemented the |
9 | 9 |
and different types of associated annotation data. |
10 | 10 |
Depends: |
11 | 11 |
R (>= 3.1.0) |
12 |
+ ggplot2 (>= 2.0.0) |
|
12 | 13 |
Imports: |
13 | 14 |
ape, |
14 | 15 |
Biostrings, |
15 | 16 |
colorspace, |
16 |
- EBImage, |
|
17 | 17 |
ggplot2, |
18 | 18 |
grid, |
19 | 19 |
gridExtra, |
... | ... |
@@ -23,15 +23,19 @@ Imports: |
23 | 23 |
reshape2, |
24 | 24 |
stats4 |
25 | 25 |
Suggests: |
26 |
- phylobase, |
|
27 | 26 |
BiocStyle, |
27 |
+ EBImage, |
|
28 | 28 |
knitr, |
29 |
- testthat, |
|
30 |
- rmarkdown |
|
29 |
+ phylobase, |
|
30 |
+ phytools, |
|
31 |
+ phangorn, |
|
32 |
+ rmarkdown, |
|
33 |
+ testthat |
|
31 | 34 |
VignetteBuilder: knitr |
32 | 35 |
License: Artistic-2.0 |
33 | 36 |
URL: https://github.com/GuangchuangYu/ggtree |
34 | 37 |
BugReports: https://github.com/GuangchuangYu/ggtree/issues |
35 | 38 |
Packaged: 2014-12-03 08:16:14 UTC; root |
36 |
-biocViews: Alignment, Annotation, Clustering, DataImport, MultipleSequenceAlignment, |
|
37 |
- ReproducibleResearch, Software, Visualization |
|
39 |
+biocViews: Alignment, Annotation, Clustering, DataImport, |
|
40 |
+ MultipleSequenceAlignment, ReproducibleResearch, Software, Visualization |
|
41 |
+RoxygenNote: 5.0.1 |
... | ... |
@@ -1,14 +1,17 @@ |
1 |
-# Generated by roxygen2 (4.1.1): do not edit by hand |
|
1 |
+# Generated by roxygen2: do not edit by hand |
|
2 | 2 |
|
3 | 3 |
S3method(as.binary,phylo) |
4 | 4 |
S3method(as.data.frame,phylo) |
5 |
+S3method(fortify,apeBootstrap) |
|
5 | 6 |
S3method(fortify,beast) |
6 | 7 |
S3method(fortify,codeml) |
7 | 8 |
S3method(fortify,codeml_mlc) |
8 | 9 |
S3method(fortify,hyphy) |
9 | 10 |
S3method(fortify,jplace) |
10 | 11 |
S3method(fortify,multiPhylo) |
12 |
+S3method(fortify,nhx) |
|
11 | 13 |
S3method(fortify,paml_rst) |
14 |
+S3method(fortify,phangorn) |
|
12 | 15 |
S3method(fortify,phylo) |
13 | 16 |
S3method(fortify,phylo4) |
14 | 17 |
S3method(fortify,r8s) |
... | ... |
@@ -18,12 +21,14 @@ export("%<+%") |
18 | 21 |
export("%>%") |
19 | 22 |
export(.) |
20 | 23 |
export(Date2decimal) |
24 |
+export(MRCA) |
|
25 |
+export(StatHilight) |
|
21 | 26 |
export(add_colorbar) |
22 |
-export(add_legend) |
|
23 | 27 |
export(aes) |
24 | 28 |
export(annotation_clade) |
25 | 29 |
export(annotation_clade2) |
26 | 30 |
export(annotation_image) |
31 |
+export(apeBoot) |
|
27 | 32 |
export(as.binary) |
28 | 33 |
export(collapse) |
29 | 34 |
export(decimal2Date) |
... | ... |
@@ -31,12 +36,18 @@ export(download.phylopic) |
31 | 36 |
export(expand) |
32 | 37 |
export(flip) |
33 | 38 |
export(geom_aline) |
39 |
+export(geom_cladelabel) |
|
40 |
+export(geom_hilight) |
|
34 | 41 |
export(geom_nodepoint) |
42 |
+export(geom_point2) |
|
35 | 43 |
export(geom_rootpoint) |
44 |
+export(geom_segment2) |
|
36 | 45 |
export(geom_text) |
46 |
+export(geom_text2) |
|
37 | 47 |
export(geom_tiplab) |
38 | 48 |
export(geom_tippoint) |
39 | 49 |
export(geom_tree) |
50 |
+export(geom_treescale) |
|
40 | 51 |
export(get.fields) |
41 | 52 |
export(get.offspring.tip) |
42 | 53 |
export(get.path) |
... | ... |
@@ -49,6 +60,8 @@ export(get.treeinfo) |
49 | 60 |
export(get.treetext) |
50 | 61 |
export(getNodeNum) |
51 | 62 |
export(getRoot) |
63 |
+export(get_clade_position) |
|
64 |
+export(get_heatmap_column_position) |
|
52 | 65 |
export(get_taxa_name) |
53 | 66 |
export(ggplotGrob) |
54 | 67 |
export(ggtree) |
... | ... |
@@ -57,18 +70,20 @@ export(gplot) |
57 | 70 |
export(groupClade) |
58 | 71 |
export(groupOTU) |
59 | 72 |
export(gzoom) |
60 |
-export(hilight) |
|
61 | 73 |
export(mask) |
62 | 74 |
export(merge_tree) |
63 | 75 |
export(msaplot) |
76 |
+export(phyPML) |
|
64 | 77 |
export(phylopic) |
65 | 78 |
export(plot) |
79 |
+export(pmlToSeq) |
|
66 | 80 |
export(read.baseml) |
67 | 81 |
export(read.beast) |
68 | 82 |
export(read.codeml) |
69 | 83 |
export(read.codeml_mlc) |
70 | 84 |
export(read.hyphy) |
71 | 85 |
export(read.jplace) |
86 |
+export(read.nhx) |
|
72 | 87 |
export(read.paml_rst) |
73 | 88 |
export(read.r8s) |
74 | 89 |
export(read.raxml) |
... | ... |
@@ -79,17 +94,21 @@ export(rtree) |
79 | 94 |
export(scaleClade) |
80 | 95 |
export(scale_color) |
81 | 96 |
export(scale_x_ggtree) |
97 |
+export(stat_hilight) |
|
82 | 98 |
export(subview) |
83 | 99 |
export(theme_transparent) |
84 | 100 |
export(theme_tree) |
85 | 101 |
export(theme_tree2) |
86 | 102 |
export(write.jplace) |
103 |
+exportClasses(apeBootstrap) |
|
87 | 104 |
exportClasses(beast) |
88 | 105 |
exportClasses(codeml) |
89 | 106 |
exportClasses(codeml_mlc) |
90 | 107 |
exportClasses(hyphy) |
91 | 108 |
exportClasses(jplace) |
109 |
+exportClasses(nhx) |
|
92 | 110 |
exportClasses(paml_rst) |
111 |
+exportClasses(phangorn) |
|
93 | 112 |
exportClasses(r8s) |
94 | 113 |
exportClasses(raxml) |
95 | 114 |
exportMethods(get.fields) |
... | ... |
@@ -106,14 +125,15 @@ exportMethods(plot) |
106 | 125 |
exportMethods(reroot) |
107 | 126 |
exportMethods(scale_color) |
108 | 127 |
exportMethods(show) |
128 |
+importFrom(Biostrings,DNAStringSet) |
|
109 | 129 |
importFrom(Biostrings,GENETIC_CODE) |
110 | 130 |
importFrom(Biostrings,readBStringSet) |
111 | 131 |
importFrom(Biostrings,toString) |
112 |
-importFrom(EBImage,channel) |
|
113 |
-importFrom(EBImage,readImage) |
|
132 |
+importFrom(ape,Nnode) |
|
114 | 133 |
importFrom(ape,Ntip) |
115 | 134 |
importFrom(ape,drop.tip) |
116 | 135 |
importFrom(ape,extract.clade) |
136 |
+importFrom(ape,getMRCA) |
|
117 | 137 |
importFrom(ape,is.binary.tree) |
118 | 138 |
importFrom(ape,ladderize) |
119 | 139 |
importFrom(ape,print.phylo) |
... | ... |
@@ -124,27 +144,38 @@ importFrom(ape,which.edge) |
124 | 144 |
importFrom(ape,write.tree) |
125 | 145 |
importFrom(colorspace,rainbow_hcl) |
126 | 146 |
importFrom(ggplot2,"%+replace%") |
147 |
+importFrom(ggplot2,GeomPoint) |
|
148 |
+importFrom(ggplot2,GeomRect) |
|
149 |
+importFrom(ggplot2,GeomSegment) |
|
150 |
+importFrom(ggplot2,GeomText) |
|
151 |
+importFrom(ggplot2,Stat) |
|
127 | 152 |
importFrom(ggplot2,aes) |
153 |
+importFrom(ggplot2,aes_) |
|
128 | 154 |
importFrom(ggplot2,aes_string) |
129 | 155 |
importFrom(ggplot2,annotate) |
130 | 156 |
importFrom(ggplot2,annotation_custom) |
131 | 157 |
importFrom(ggplot2,coord_flip) |
132 | 158 |
importFrom(ggplot2,coord_polar) |
159 |
+importFrom(ggplot2,draw_key_path) |
|
160 |
+importFrom(ggplot2,draw_key_point) |
|
161 |
+importFrom(ggplot2,draw_key_text) |
|
133 | 162 |
importFrom(ggplot2,element_blank) |
134 | 163 |
importFrom(ggplot2,element_line) |
135 | 164 |
importFrom(ggplot2,element_rect) |
136 | 165 |
importFrom(ggplot2,element_text) |
137 | 166 |
importFrom(ggplot2,fortify) |
138 |
-importFrom(ggplot2,geom_point) |
|
139 | 167 |
importFrom(ggplot2,geom_rect) |
140 | 168 |
importFrom(ggplot2,geom_segment) |
141 | 169 |
importFrom(ggplot2,geom_text) |
142 | 170 |
importFrom(ggplot2,geom_tile) |
143 | 171 |
importFrom(ggplot2,ggplot) |
144 | 172 |
importFrom(ggplot2,ggplotGrob) |
173 |
+importFrom(ggplot2,ggproto) |
|
145 | 174 |
importFrom(ggplot2,guide_legend) |
146 | 175 |
importFrom(ggplot2,guides) |
147 | 176 |
importFrom(ggplot2,labs) |
177 |
+importFrom(ggplot2,layer) |
|
178 |
+importFrom(ggplot2,position_nudge) |
|
148 | 179 |
importFrom(ggplot2,scale_color_manual) |
149 | 180 |
importFrom(ggplot2,scale_fill_discrete) |
150 | 181 |
importFrom(ggplot2,scale_fill_gradient) |
... | ... |
@@ -158,14 +189,9 @@ importFrom(ggplot2,theme_bw) |
158 | 189 |
importFrom(ggplot2,xlab) |
159 | 190 |
importFrom(ggplot2,xlim) |
160 | 191 |
importFrom(ggplot2,ylab) |
161 |
-importFrom(ggplot2,ylim) |
|
162 | 192 |
importFrom(grDevices,col2rgb) |
163 | 193 |
importFrom(grDevices,rgb) |
164 |
-importFrom(grid,editGrob) |
|
165 |
-importFrom(grid,gpar) |
|
166 |
-importFrom(grid,linesGrob) |
|
167 | 194 |
importFrom(grid,rasterGrob) |
168 |
-importFrom(grid,textGrob) |
|
169 | 195 |
importFrom(grid,unit) |
170 | 196 |
importFrom(gridExtra,grid.arrange) |
171 | 197 |
importFrom(jsonlite,fromJSON) |
... | ... |
@@ -1,6 +1,58 @@ |
1 |
-CHANGES IN VERSION 1.1.20 |
|
1 |
+CHANGES IN VERSION 1.3.6 |
|
2 |
+------------------------ |
|
3 |
+ o MRCA function for finding Most Recent Common Ancestor among a vector of tips <2015-12-22, Tue> |
|
4 |
+ o geom_cladelabel: add bar and label to annotate a clade <2015-12-21, Mon> |
|
5 |
+ - remove annotation_clade and annotation_clade2 functions. |
|
6 |
+ o geom_treescale: tree scale layer. (add_legend was removed) <2015-12-21, Mon> |
|
7 |
+ |
|
8 |
+CHANGES IN VERSION 1.3.5 |
|
9 |
+------------------------ |
|
10 |
+ o bug fixed, read.nhx now works with scientific notation <2015-11-30, Mon> |
|
11 |
+ + see https://github.com/GuangchuangYu/ggtree/issues/30 |
|
12 |
+ |
|
13 |
+CHANGES IN VERSION 1.3.4 |
|
14 |
+------------------------ |
|
15 |
+ o rename beast feature when name conflict with reserve keywords (label, branch, etc) <2015-11-27, Fri> |
|
16 |
+ o get_clade_position function <2015-11-26, Thu> |
|
17 |
+ + https://github.com/GuangchuangYu/ggtree/issues/28 |
|
18 |
+ o get_heatmap_column_position function <2015-11-25, Wed> |
|
19 |
+ + see https://github.com/GuangchuangYu/ggtree/issues/26 |
|
20 |
+ o support NHX (New Hampshire X) format via read.nhx function <2015-11-17, Tue> |
|
21 |
+ o bug fixed in extract.treeinfo.jplace <2015-11-17, Thu> |
|
22 |
+ |
|
23 |
+CHANGES IN VERSION 1.3.3 |
|
24 |
+------------------------ |
|
25 |
+ o support color=NULL in gheatmap, then no colored line will draw within the heatmap <2015-10-30, Fri> |
|
26 |
+ o add `angle` for also rectangular, so that it will be available for layout='rectangular' following by coord_polar() <2015-10-27, Tue> |
|
27 |
+ |
|
28 |
+CHANGES IN VERSION 1.3.2 |
|
2 | 29 |
------------------------ |
30 |
+ o update vignette, add example of ape bootstrap and phangorn ancestral sequences <2015-10-26, Mon> |
|
31 |
+ o add support of ape bootstrap analysis <2015-10-26, Mon> |
|
32 |
+ see https://github.com/GuangchuangYu/ggtree/issues/20 |
|
33 |
+ o add support of ancestral sequences inferred by phangorn <2015-10-26, Mon> |
|
34 |
+ see https://github.com/GuangchuangYu/ggtree/issues/21 |
|
35 |
+ |
|
36 |
+CHANGES IN VERSION 1.3.1 |
|
37 |
+------------------------ |
|
38 |
+ o change angle to angle + 90, so that label will in radial direction <2015-10-22, Thu> |
|
39 |
+ + see https://github.com/GuangchuangYu/ggtree/issues/17 |
|
40 |
+ o na.rm should be always passed to layer(), fixed it in geom_hilight and geom_text2 <2015-10-21, Wed> |
|
41 |
+ + see https://github.com/hadley/ggplot2/issues/1380 |
|
42 |
+ o matching beast stats with tree using internal node number instead of label <2015-10-20, Tue> |
|
43 |
+ |
|
44 |
+CHANGES IN VERSION 1.3.0 |
|
45 |
+------------------------ |
|
46 |
+ o BioC 3.3 branch |
|
47 |
+ |
|
48 |
+CHANGES IN VERSION 1.1.21 |
|
49 |
+------------------------ |
|
50 |
+ o support hyphy output of ancestral sequences that is in phylip sequential format (no TAXALABELS block available) <2015-10-07, Wed> |
|
3 | 51 |
o fixed bug in geom_tiplab when x contains NA (eg, removing by collapse function) <2015-10-01, Thu> |
52 |
+ o new implementation of geom_hilight, a truly geom layer function <2015-09-10, Thu> |
|
53 |
+ |
|
54 |
+CHANGES IN VERSION 1.1.20 |
|
55 |
+------------------------ |
|
4 | 56 |
o bug fixed in %add2%, if node available use node, otherwise use label <2015-09-04, Fri> |
5 | 57 |
o bug fixed of subview for considering aes mapping of x and y <2015-09-03, Thu> |
6 | 58 |
o update vignette by adding r8s example <2015-09-02, Wed> |
... | ... |
@@ -3,6 +3,11 @@ 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 | 11 |
|
7 | 12 |
##' Class "hyphy" |
8 | 13 |
##' This class stores information of HYPHY output |
... | ... |
@@ -66,6 +71,78 @@ setClass("r8s", |
66 | 71 |
) |
67 | 72 |
) |
68 | 73 |
|
74 |
+##' Class "r8s" |
|
75 |
+##' This class stores output info from r8s |
|
76 |
+##' |
|
77 |
+##' |
|
78 |
+##' @name r8s-class |
|
79 |
+##' @docType class |
|
80 |
+##' @slot file input file |
|
81 |
+##' @slot fields available feature |
|
82 |
+##' @slot treetext tree text |
|
83 |
+##' @slot phylo multiPhylo, time tree, rate tree and absolute substitution tree |
|
84 |
+##' @slot extraInfo extra information |
|
85 |
+##' @exportClass r8s |
|
86 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
87 |
+##' @keywords classes |
|
88 |
+setClass("r8s", |
|
89 |
+ representation = representation( |
|
90 |
+ file = "character", |
|
91 |
+ fields = "character", |
|
92 |
+ treetext = "character", |
|
93 |
+ phylo = "multiPhylo", |
|
94 |
+ extraInfo = "data.frame" |
|
95 |
+ ) |
|
96 |
+ ) |
|
97 |
+ |
|
98 |
+##' Class "nhx" |
|
99 |
+##' This class stores nhx tree |
|
100 |
+##' |
|
101 |
+##' |
|
102 |
+##' @name nhx-class |
|
103 |
+##' @rdname nhx-class |
|
104 |
+##' @docType class |
|
105 |
+##' @slot file input file |
|
106 |
+##' @slot fields available feature |
|
107 |
+##' @slot phylo phylo object |
|
108 |
+##' @slot nhx_tags tag information in nhx file |
|
109 |
+##' @slot extraInfo extra information |
|
110 |
+##' @exportClass nhx |
|
111 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
112 |
+##' @keywords classes |
|
113 |
+setClass("nhx", |
|
114 |
+ representation = representation( |
|
115 |
+ file = "character", |
|
116 |
+ fields = "character", |
|
117 |
+ phylo = "phylo", |
|
118 |
+ nhx_tags = "data.frame", |
|
119 |
+ extraInfo = "data.frame" |
|
120 |
+ ) |
|
121 |
+ ) |
|
122 |
+ |
|
123 |
+##' Class "apeBootstrap" |
|
124 |
+##' This class stores ape bootstrapping analysis result |
|
125 |
+##' |
|
126 |
+##' |
|
127 |
+##' @name apeBootstrap-class |
|
128 |
+##' @docType class |
|
129 |
+##' @slot phylo phylo object of treetext |
|
130 |
+##' @slot fields available features |
|
131 |
+##' @slot bootstrap bootstrap value |
|
132 |
+##' @slot extraInfo extra information |
|
133 |
+##' @exportClass apeBootstrap |
|
134 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
135 |
+##' @keywords classes |
|
136 |
+setClass("apeBootstrap", |
|
137 |
+ representation = representation( |
|
138 |
+ phylo = "phylo", |
|
139 |
+ fields = "character", |
|
140 |
+ bootstrap = "data.frame", |
|
141 |
+ extraInfo = "data.frame" |
|
142 |
+ ) |
|
143 |
+ ) |
|
144 |
+ |
|
145 |
+ |
|
69 | 146 |
##' Class "raxml" |
70 | 147 |
##' This class stores RAxML bootstrapping analysis result |
71 | 148 |
##' |
... | ... |
@@ -84,12 +161,9 @@ setClass("r8s", |
84 | 161 |
setClass("raxml", |
85 | 162 |
representation = representation( |
86 | 163 |
file = "character", |
87 |
- fields = "character", |
|
88 |
- treetext = "character", |
|
89 |
- phylo = "phylo", |
|
90 |
- bootstrap = "data.frame", |
|
91 |
- extraInfo = "data.frame" |
|
92 |
- ) |
|
164 |
+ treetext = "character" |
|
165 |
+ ), |
|
166 |
+ contains = "apeBootstrap" |
|
93 | 167 |
) |
94 | 168 |
|
95 | 169 |
|
... | ... |
@@ -138,6 +212,37 @@ setClass("paml_rst", |
138 | 212 |
) |
139 | 213 |
) |
140 | 214 |
|
215 |
+##' Class "phangorn" |
|
216 |
+##' This class stores ancestral sequences inferred from 'phangorn' |
|
217 |
+##' |
|
218 |
+##' |
|
219 |
+##' @name phangorn-class |
|
220 |
+##' @docType class |
|
221 |
+##' @slot fields available attributes |
|
222 |
+##' @slot phylo phylo object |
|
223 |
+##' @slot seq_type one of "NT" and "AA" |
|
224 |
+##' @slot tip_seq sequences of tips |
|
225 |
+##' @slot ancseq ancenstral sequences |
|
226 |
+##' @slot subs sequence substitution |
|
227 |
+##' @slot AA_subs Amino acid sequence substitution |
|
228 |
+##' @slot extraInfo extra information |
|
229 |
+##' @exportClass phangorn |
|
230 |
+##' @author Guangchuang Yu \url{http://ygc.name} |
|
231 |
+##' @seealso \linkS4class{paml_rst} |
|
232 |
+##' @keywords classes |
|
233 |
+setClass("phangorn", |
|
234 |
+ representation = representation( |
|
235 |
+ fields = "character", |
|
236 |
+ phylo = "phylo", |
|
237 |
+ seq_type = "character", |
|
238 |
+ tip_seq = "character", |
|
239 |
+ ancseq = "character", |
|
240 |
+ subs = "data.frame", |
|
241 |
+ AA_subs = "data.frame", |
|
242 |
+ extraInfo = "data.frame") |
|
243 |
+ ) |
|
244 |
+ |
|
245 |
+ |
|
141 | 246 |
##' Class "codeml_mlc" |
142 | 247 |
##' This class stores information of mlc file frm codeml output |
143 | 248 |
##' |
... | ... |
@@ -26,7 +26,7 @@ if ( !isGeneric("plot") ) |
26 | 26 |
##' @name reroot |
27 | 27 |
##' @rdname reroot-methods |
28 | 28 |
##' @title reroot method |
29 |
-##' @param object one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object |
|
29 |
+##' @param object one of \code{phylo}, \code{nhx}, \code{phangorn}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object |
|
30 | 30 |
##' @param node internal nnode number |
31 | 31 |
##' @param ... additional parameter |
32 | 32 |
##' @return tree object |
... | ... |
@@ -37,7 +37,7 @@ setGeneric("reroot", function(object, node, ...) standardGeneric("reroot")) |
37 | 37 |
##' @name get.tree |
38 | 38 |
##' @rdname get.tree-methods |
39 | 39 |
##' @title get.tree method |
40 |
-##' @param object one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object |
|
40 |
+##' @param object one of \code{phylo}, \code{jplace}, \code{nhx}, \code{phangorn}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object |
|
41 | 41 |
##' @param ... additional parameter |
42 | 42 |
##' @return phylo object |
43 | 43 |
##' @export |
... | ... |
@@ -43,3 +43,77 @@ read.tree <- ape::read.tree |
43 | 43 |
##' \link[ape]{rtree} |
44 | 44 |
rtree <- ape::rtree |
45 | 45 |
|
46 |
+ |
|
47 |
+##' merge phylo and output of boot.phylo to 'apeBootstrap' object |
|
48 |
+##' |
|
49 |
+##' |
|
50 |
+##' @title apeBoot |
|
51 |
+##' @param phylo phylo |
|
52 |
+##' @param boot bootstrap values |
|
53 |
+##' @return an instance of 'apeBootstrap' |
|
54 |
+##' @importFrom ape Nnode |
|
55 |
+##' @export |
|
56 |
+##' @author Guangchuang Yu |
|
57 |
+apeBoot <- function(phylo, boot) { |
|
58 |
+ ## phylo is a phylo object |
|
59 |
+ ## boot is output from boot.phylo |
|
60 |
+ new("apeBootstrap", |
|
61 |
+ phylo=phylo, |
|
62 |
+ bootstrap=data.frame(node=(1:Nnode(phylo)) + Ntip(phylo), bootstrap=boot) |
|
63 |
+ ) |
|
64 |
+} |
|
65 |
+ |
|
66 |
+ |
|
67 |
+##' @rdname show-methods |
|
68 |
+##' @importFrom ape print.phylo |
|
69 |
+##' @exportMethod show |
|
70 |
+setMethod("show", signature(object = "apeBootstrap"), |
|
71 |
+ function(object) { |
|
72 |
+ cat("'apeBoot' S4 object that stored bootstrap value generated by 'ape::boot.phylo'", ".\n\n") |
|
73 |
+ cat("...@ tree: ") |
|
74 |
+ print.phylo(get.tree(object)) |
|
75 |
+ }) |
|
76 |
+ |
|
77 |
+ |
|
78 |
+ |
|
79 |
+ |
|
80 |
+##' @rdname groupClade-methods |
|
81 |
+##' @exportMethod groupClade |
|
82 |
+setMethod("groupClade", signature(object="apeBootstrap"), |
|
83 |
+ function(object, node, group_name="group") { |
|
84 |
+ groupClade_(object, node, group_name) |
|
85 |
+ }) |
|
86 |
+ |
|
87 |
+##' @rdname scale_color-methods |
|
88 |
+##' @exportMethod scale_color |
|
89 |
+setMethod("scale_color", signature(object="apeBootstrap"), |
|
90 |
+ function(object, by="bootstrap", ...) { |
|
91 |
+ scale_color_(object, by, ...) |
|
92 |
+ }) |
|
93 |
+ |
|
94 |
+ |
|
95 |
+##' @rdname gzoom-methods |
|
96 |
+##' @exportMethod gzoom |
|
97 |
+setMethod("gzoom", signature(object="apeBootstrap"), |
|
98 |
+ function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
99 |
+ gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
100 |
+ }) |
|
101 |
+ |
|
102 |
+ |
|
103 |
+##' @rdname get.tree-methods |
|
104 |
+##' @exportMethod get.tree |
|
105 |
+setMethod("get.tree", signature(object="apeBootstrap"), |
|
106 |
+ function(object,...) { |
|
107 |
+ object@phylo |
|
108 |
+ } |
|
109 |
+ ) |
|
110 |
+ |
|
111 |
+ |
|
112 |
+##' @rdname get.fields-methods |
|
113 |
+##' @exportMethod get.fields |
|
114 |
+setMethod("get.fields", signature(object="apeBootstrap"), |
|
115 |
+ function(object, ...) { |
|
116 |
+ get.fields.tree(object) |
|
117 |
+ } |
|
118 |
+ ) |
|
119 |
+ |
... | ... |
@@ -13,6 +13,8 @@ |
13 | 13 |
##' read.beast(file) |
14 | 14 |
read.beast <- function(file) { |
15 | 15 |
stats <- read.stats_beast(file) |
16 |
+ stats$node %<>% gsub("\"*'*", "", .) |
|
17 |
+ |
|
16 | 18 |
fields <- sub("_lower|_upper", "", names(stats)) %>% unique |
17 | 19 |
fields %<>% `[`(.!="node") |
18 | 20 |
|
... | ... |
@@ -35,26 +37,6 @@ read.beast <- function(file) { |
35 | 37 |
} |
36 | 38 |
|
37 | 39 |
|
38 |
-##' @rdname show-methods |
|
39 |
-##' @importFrom ape print.phylo |
|
40 |
-##' @exportMethod show |
|
41 |
-setMethod("show", signature(object = "beast"), |
|
42 |
- function(object) { |
|
43 |
- cat("'beast' S4 object that stored information of\n\t", |
|
44 |
- paste0("'", object@file, "'.\n\n")) |
|
45 |
- cat("...@ tree: ") |
|
46 |
- print.phylo(get.tree(object)) |
|
47 |
- cat("\nwith the following features available:\n") |
|
48 |
- print_fields(object) |
|
49 |
- }) |
|
50 |
- |
|
51 |
-##' @rdname groupOTU-methods |
|
52 |
-##' @exportMethod groupOTU |
|
53 |
-setMethod("groupOTU", signature(object="beast"), |
|
54 |
- function(object, focus, group_name="group") { |
|
55 |
- groupOTU_(object, focus, group_name) |
|
56 |
- } |
|
57 |
- ) |
|
58 | 40 |
|
59 | 41 |
##' @rdname groupClade-methods |
60 | 42 |
##' @exportMethod groupClade |
... | ... |
@@ -63,20 +45,7 @@ setMethod("groupClade", signature(object="beast"), |
63 | 45 |
groupClade_(object, node, group_name) |
64 | 46 |
}) |
65 | 47 |
|
66 |
-##' @rdname scale_color-methods |
|
67 |
-##' @exportMethod scale_color |
|
68 |
-setMethod("scale_color", signature(object="beast"), |
|
69 |
- function(object, by, ...) { |
|
70 |
- scale_color_(object, by, ...) |
|
71 |
- }) |
|
72 |
- |
|
73 | 48 |
|
74 |
-##' @rdname gzoom-methods |
|
75 |
-##' @exportMethod gzoom |
|
76 |
-setMethod("gzoom", signature(object="beast"), |
|
77 |
- function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
78 |
- gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
79 |
- }) |
|
80 | 49 |
|
81 | 50 |
##' get.tree method |
82 | 51 |
##' |
... | ... |
@@ -163,8 +132,8 @@ read.stats_beast <- function(file) { |
163 | 132 |
## node name corresponding to stats |
164 | 133 |
nn <- strsplit(tree2, split=",") %>% unlist %>% |
165 | 134 |
strsplit(., split="\\)") %>% unlist %>% |
166 |
- gsub("\\(*", "", .) %>% |
|
167 |
- gsub("[:;].*", "", .) |
|
135 |
+ gsub("\\(*", "", .) %>% |
|
136 |
+ gsub("[:;].*", "", .) |
|
168 | 137 |
|
169 | 138 |
phylo <- read.tree(text = tree2) |
170 | 139 |
root <- getRoot(phylo) |
... | ... |
@@ -211,9 +180,14 @@ read.stats_beast <- function(file) { |
211 | 180 |
## ## |
212 | 181 |
#################################################### |
213 | 182 |
treeinfo <- fortify.phylo(phylo) |
214 |
- label2 <- c(treeinfo[treeinfo$isTip, "label"], |
|
215 |
- root:(root+nnode-1)) |
|
216 |
- node <- label2[match(nn, treeinfo$label)] |
|
183 |
+ |
|
184 |
+ if (any(grepl("TRANSLATE", beast, ignore.case = TRUE))) { |
|
185 |
+ label2 <- c(treeinfo[treeinfo$isTip, "label"], |
|
186 |
+ root:(root+nnode-1)) |
|
187 |
+ node <- label2[match(nn, treeinfo$label)] |
|
188 |
+ } else { |
|
189 |
+ node <- as.character(treeinfo$node[match(nn, treeinfo$label)]) |
|
190 |
+ } |
|
217 | 191 |
|
218 | 192 |
## stats <- unlist(strsplit(tree, "\\["))[-1] |
219 | 193 |
## stats <- sub(":.+$", "", stats |
... | ... |
@@ -1,46 +1,120 @@ |
1 |
+ |
|
1 | 2 |
##' add tip point |
2 | 3 |
##' |
3 | 4 |
##' |
4 | 5 |
##' @title geom_tippoint |
5 |
-##' @param mapping aes mapping |
|
6 |
-##' @param ... additional parameter |
|
6 |
+##' @inheritParams geom_point2 |
|
7 | 7 |
##' @return tip point layer |
8 | 8 |
##' @export |
9 | 9 |
##' @author Guangchuang Yu |
10 |
-geom_tippoint <- function(mapping = NULL, ...) { |
|
10 |
+geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity", |
|
11 |
+ position = "identity", na.rm = FALSE, |
|
12 |
+ show.legend = NA, inherit.aes = TRUE, ...) { |
|
11 | 13 |
isTip <- NULL |
12 |
- geom_point(mapping, subset=.(isTip), ...) |
|
14 |
+ self_mapping <- aes(subset = isTip) |
|
15 |
+ if (is.null(mapping)) { |
|
16 |
+ mapping <- self_mapping |
|
17 |
+ } else { |
|
18 |
+ mapping %<>% modifyList(self_mapping) |
|
19 |
+ } |
|
20 |
+ geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...) |
|
13 | 21 |
} |
14 | 22 |
|
15 | 23 |
##' add node point |
16 | 24 |
##' |
17 | 25 |
##' |
18 | 26 |
##' @title geom_nodepoint |
19 |
-##' @param mapping aes mapping |
|
20 |
-##' @param ... additional parameter |
|
27 |
+##' @inheritParams geom_point2 |
|
21 | 28 |
##' @return node point layer |
22 | 29 |
##' @export |
23 | 30 |
##' @author Guangchuang Yu |
24 |
-geom_nodepoint <- function(mapping = NULL, ...) { |
|
31 |
+geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity", |
|
32 |
+ position = "identity", na.rm = FALSE, |
|
33 |
+ show.legend = NA, inherit.aes = TRUE, ...) { |
|
25 | 34 |
isTip <- NULL |
26 |
- geom_point(mapping, subset=.(!isTip), ...) |
|
35 |
+ self_mapping <- aes(subset = !isTip) |
|
36 |
+ if (is.null(mapping)) { |
|
37 |
+ mapping <- self_mapping |
|
38 |
+ } else { |
|
39 |
+ mapping %<>% modifyList(self_mapping) |
|
40 |
+ } |
|
41 |
+ geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...) |
|
27 | 42 |
} |
28 | 43 |
|
29 | 44 |
|
30 |
- |
|
31 | 45 |
##' add root point |
32 | 46 |
##' |
33 | 47 |
##' |
34 | 48 |
##' @title geom_rootpoint |
35 |
-##' @param mapping aes mapping |
|
36 |
-##' @param ... additional parameter |
|
49 |
+##' @inheritParams geom_point2 |
|
37 | 50 |
##' @return root point layer |
38 |
-##' @importFrom ggplot2 geom_point |
|
39 | 51 |
##' @export |
40 | 52 |
##' @author Guangchuang Yu |
41 |
-geom_rootpoint <- function(mapping = NULL, ...) { |
|
53 |
+geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity", |
|
54 |
+ position = "identity", na.rm = FALSE, |
|
55 |
+ show.legend = NA, inherit.aes = TRUE, ...) { |
|
42 | 56 |
isTip <- node <- parent <- NULL |
43 |
- geom_point(mapping, subset=.(node == parent), ...) |
|
57 |
+ self_mapping <- aes(subset = (node == parent)) |
|
58 |
+ if (is.null(mapping)) { |
|
59 |
+ mapping <- self_mapping |
|
60 |
+ } else { |
|
61 |
+ mapping %<>% modifyList(self_mapping) |
|
62 |
+ } |
|
63 |
+ geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...) |
|
44 | 64 |
} |
45 | 65 |
|
46 | 66 |
|
67 |
+##' geom_point2 support aes(subset) via setup_data |
|
68 |
+##' |
|
69 |
+##' |
|
70 |
+##' @title geom_point2 |
|
71 |
+##' @param mapping aes mapping |
|
72 |
+##' @param data data |
|
73 |
+##' @param stat stat |
|
74 |
+##' @param position position |
|
75 |
+##' @param na.rm logical |
|
76 |
+##' @param show.legend logical |
|
77 |
+##' @param inherit.aes logical |
|
78 |
+##' @param ... addktional parameter |
|
79 |
+##' @importFrom ggplot2 layer |
|
80 |
+##' @export |
|
81 |
+##' @seealso |
|
82 |
+##' \link[ggplot2]{geom_point} |
|
83 |
+##' @return point layer |
|
84 |
+##' @author Guangchuang Yu |
|
85 |
+geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity", |
|
86 |
+ position = "identity", na.rm = FALSE, |
|
87 |
+ show.legend = NA, inherit.aes = TRUE, ...) { |
|
88 |
+ layer( |
|
89 |
+ data = data, |
|
90 |
+ mapping = mapping, |
|
91 |
+ stat = stat, |
|
92 |
+ geom = GeomPointGGtree, |
|
93 |
+ position = position, |
|
94 |
+ show.legend = show.legend, |
|
95 |
+ inherit.aes = inherit.aes, |
|
96 |
+ params = list( |
|
97 |
+ na.rm = na.rm, |
|
98 |
+ ... |
|
99 |
+ ) |
|
100 |
+ ) |
|
101 |
+} |
|
102 |
+ |
|
103 |
+##' @importFrom ggplot2 ggproto |
|
104 |
+##' @importFrom ggplot2 GeomPoint |
|
105 |
+##' @importFrom ggplot2 draw_key_point |
|
106 |
+GeomPointGGtree <- ggproto("GeomPointGGtree", GeomPoint, |
|
107 |
+ setup_data = function(data, params) { |
|
108 |
+ data[data$subset,] |
|
109 |
+ } ## , |
|
110 |
+ |
|
111 |
+## draw_panel = function(data, panel_scales, coord, na.rm = FALSE){ |
|
112 |
+## GeomPoint$draw_panel(data, panel_scales, coord, na.rm) |
|
113 |
+## }, |
|
114 |
+ |
|
115 |
+## draw_key = draw_key_point, |
|
116 |
+ |
|
117 |
+## required_aes = c("x", "y"), |
|
118 |
+## default_aes = aes(shape = 19, colour = "black", size = 1.5, fill = NA, |
|
119 |
+## alpha = NA, stroke = 0.5) |
|
120 |
+ ) |
... | ... |
@@ -11,14 +11,75 @@ |
11 | 11 |
##' @author Yu Guangchuang |
12 | 12 |
geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) { |
13 | 13 |
x <- y <- isTip <- NULL |
14 |
- dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y) |
|
14 |
+ dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y, subset=isTip) |
|
15 | 15 |
if (!is.null(mapping)) { |
16 | 16 |
dot_mapping <- modifyList(dot_mapping, mapping) |
17 | 17 |
} |
18 | 18 |
|
19 |
- geom_segment(mapping, |
|
20 |
- subset=.(isTip), |
|
21 |
- linetype=linetype, |
|
22 |
- size=size, ...) |
|
19 |
+ geom_segment2(dot_mapping, |
|
20 |
+ linetype=linetype, |
|
21 |
+ size=size, ...) |
|
23 | 22 |
} |
24 | 23 |
|
24 |
+ |
|
25 |
+ |
|
26 |
+##' geom_segment2 support aes(subset) via setup_data |
|
27 |
+##' |
|
28 |
+##' |
|
29 |
+##' @title geom_segment2 |
|
30 |
+##' @param mapping aes mapping |
|
31 |
+##' @param data data |
|
32 |
+##' @param stat stat |
|
33 |
+##' @param position position |
|
34 |
+##' @param arrow arrow |
|
35 |
+##' @param lineend lineend |
|
36 |
+##' @param na.rm logical |
|
37 |
+##' @param show.legend logical |
|
38 |
+##' @param inherit.aes logical |
|
39 |
+##' @param ... additional parameter |
|
40 |
+##' @importFrom ggplot2 layer |
|
41 |
+##' @export |
|
42 |
+##' @seealso |
|
43 |
+##' \link[ggplot2]{geom_segment} |
|
44 |
+##' @return add segment layer |
|
45 |
+##' @author Guangchuang Yu |
|
46 |
+geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity", |
|
47 |
+ position = "identity", arrow = NULL, lineend = "butt", |
|
48 |
+ na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, |
|
49 |
+ ...) { |
|
50 |
+ layer( |
|
51 |
+ data = data, |
|
52 |
+ mapping = mapping, |
|
53 |
+ stat = stat, |
|
54 |
+ geom = GeomSegmentGGtree, |
|
55 |
+ position = position, |
|
56 |
+ show.legend = show.legend, |
|
57 |
+ inherit.aes = inherit.aes, |
|
58 |
+ params = list( |
|
59 |
+ arrow = arrow, |
|
60 |
+ lineend = lineend, |
|
61 |
+ na.rm = na.rm, |
|
62 |
+ ... |
|
63 |
+ ) |
|
64 |
+ ) |
|
65 |
+} |
|
66 |
+ |
|
67 |
+##' @importFrom ggplot2 GeomSegment |
|
68 |
+##' @importFrom ggplot2 draw_key_path |
|
69 |
+GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment, |
|
70 |
+ setup_data = function(data, params) { |
|
71 |
+ data[data$subset,] |
|
72 |
+ }, |
|
73 |
+ |
|
74 |
+ draw_panel = function(data, panel_scales, coord, arrow = NULL, |
|
75 |
+ lineend = "butt", na.rm = FALSE) { |
|
76 |
+ |
|
77 |
+ GeomSegment$draw_panel(data, panel_scales, coord, arrow, |
|
78 |
+ lineend, na.rm) |
|
79 |
+ }, |
|
80 |
+ |
|
81 |
+ required_aes = c("x", "y", "xend", "yend"), |
|
82 |
+ default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), |
|
83 |
+ |
|
84 |
+ draw_key = draw_key_path |
|
85 |
+ ) |
... | ... |
@@ -1,3 +1,43 @@ |
1 |
+##' geom_text2 support aes(subset) via setup_data |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title geom_text2 |
|
5 |
+##' @inheritParams geom_text |
|
6 |
+##' @return text layer |
|
7 |
+##' @importFrom ggplot2 layer |
|
8 |
+##' @importFrom ggplot2 position_nudge |
|
9 |
+##' @export |
|
10 |
+##' @seealso |
|
11 |
+##' \link[ggplot2]{geom_text} |
|
12 |
+##' @author Guangchuang Yu |
|
13 |
+geom_text2 <- function(mapping = NULL, data = NULL, stat = "identity", |
|
14 |
+ position = "identity", parse = FALSE, na.rm=TRUE, show.legend = NA, inherit.aes = TRUE, |
|
15 |
+ ..., nudge_x = 0, nudge_y = 0, check_overlap = FALSE) |
|
16 |
+{ |
|
17 |
+ if (!missing(nudge_x) || !missing(nudge_y)) { |
|
18 |
+ if (!missing(position)) { |
|
19 |
+ stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) |
|
20 |
+ } |
|
21 |
+ |
|
22 |
+ position <- position_nudge(nudge_x, nudge_y) |
|
23 |
+ } |
|
24 |
+ |
|
25 |
+ layer( |
|
26 |
+ data = data, |
|
27 |
+ mapping = mapping, |
|
28 |
+ stat = stat, |
|
29 |
+ geom = GeomTextGGtree, |
|
30 |
+ position = position, |
|
31 |
+ show.legend = show.legend, |
|
32 |
+ inherit.aes = inherit.aes, |
|
33 |
+ params = list( |
|
34 |
+ parse = parse, |
|
35 |
+ check_overlap = check_overlap, |
|
36 |
+ na.rm = na.rm, |
|
37 |
+ ... |
|
38 |
+ ) |
|
39 |
+ ) |
|
40 |
+} |
|
1 | 41 |
|
2 | 42 |
##' text annotations |
3 | 43 |
##' @export |
... | ... |
@@ -8,7 +48,13 @@ |
8 | 48 |
##' @param stat The statistical transformation to use on the data for this layer |
9 | 49 |
##' @param position The position adjustment to use for overlapping points on this layer |
10 | 50 |
##' @param parse if TRUE, the labels will be passd into expressions |
51 |
+##' @param na.rm logical |
|
52 |
+##' @param show.legend logical |
|
53 |
+##' @param inherit.aes logical |
|
11 | 54 |
##' @param ... other arguments passed on to 'layer' |
55 |
+##' @param nudge_x horizontal adjustment |
|
56 |
+##' @param nudge_y vertical adjustment |
|
57 |
+##' @param check_overlap if TRUE, text that overlaps previous text in the same layer will not be plotted |
|
12 | 58 |
##' @source |
13 | 59 |
##' This is just the imported function |
14 | 60 |
##' from the ggplot2 package. The documentation you should |
... | ... |
@@ -18,3 +64,24 @@ |
18 | 64 |
##' \link[ggplot2]{geom_text} |
19 | 65 |
geom_text <- ggplot2::geom_text |
20 | 66 |
|
67 |
+ |
|
68 |
+##' @importFrom ggplot2 GeomText |
|
69 |
+##' @importFrom ggplot2 draw_key_text |
|
70 |
+GeomTextGGtree <- ggproto("GeomTextGGtree", GeomText, |
|
71 |
+ setup_data = function(data, params) { |
|
72 |
+ data[data$subset,] |
|
73 |
+ }, |
|
74 |
+ |
|
75 |
+ draw_panel = function(data, panel_scales, coord, parse = FALSE, |
|
76 |
+ na.rm = FALSE, check_overlap = FALSE) { |
|
77 |
+ GeomText$draw_panel(data, panel_scales, coord, parse, |
|
78 |
+ na.rm, check_overlap) |
|
79 |
+ }, |
|
80 |
+ |
|
81 |
+ required_aes = c("x", "y", "label"), |
|
82 |
+ |
|
83 |
+ default_aes = aes(colour = "black", size = 3.88, angle = 0, hjust = 0.5, |
|
84 |
+ vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2), |
|
85 |
+ |
|
86 |
+ draw_key = draw_key_text |
|
87 |
+ ) |
... | ... |
@@ -40,12 +40,10 @@ geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dott |
40 | 40 |
} |
41 | 41 |
|
42 | 42 |
list( |
43 |
- geom_text(mapping=text_mapping, |
|
44 |
- subset=.(isTip), |
|
45 |
- hjust = hjust, ...), |
|
43 |
+ geom_text2(mapping=text_mapping, |
|
44 |
+ hjust = hjust, ...), |
|
46 | 45 |
if (!is.null(dot_mapping)) |
47 |
- geom_segment(mapping=dot_mapping, |
|
48 |
- subset=.(isTip), |
|
46 |
+ geom_segment2(mapping=dot_mapping, |
|
49 | 47 |
linetype = linetype, |
50 | 48 |
size = linesize, ...) |
51 | 49 |
) |
... | ... |
@@ -35,7 +35,7 @@ ggtree <- function(tr, |
35 | 35 |
showDistance=FALSE, |
36 | 36 |
layout="rectangular", |
37 | 37 |
mrsd = NULL, |
38 |
- as.Date=FALSE, |
|
38 |
+ as.Date = FALSE, |
|
39 | 39 |
yscale="none", |
40 | 40 |
yscale_mapping = NULL, |
41 | 41 |
ladderize = TRUE, right=FALSE, |
... | ... |
@@ -54,6 +54,7 @@ ggtree <- function(tr, |
54 | 54 |
layout <- "slanted" |
55 | 55 |
} |
56 | 56 |
if (layout == "fan" || layout == "circular") { |
57 |
+ layout <- "circular" |
|
57 | 58 |
type <- "circular" |
58 | 59 |
} else if (layout == "radial") { |
59 | 60 |
layout <- "slanted" |
... | ... |
@@ -82,6 +83,7 @@ ggtree <- function(tr, |
82 | 83 |
if (type == "circular" || type == "radial") { |
83 | 84 |
p <- p + coord_polar(theta = "y") |
84 | 85 |
## refer to: https://github.com/GuangchuangYu/ggtree/issues/6 |
86 |
+ ## and also have some space for tree scale (legend) |
|
85 | 87 |
p <- p + scale_y_continuous(limits=c(0, max(p$data$y))) |
86 | 88 |
} |
87 | 89 |
|
... | ... |
@@ -141,26 +143,6 @@ geom_tree <- function(layout="rectangular", ...) { |
141 | 143 |
} |
142 | 144 |
|
143 | 145 |
|
144 |
-##' hilight clade with rectangle |
|
145 |
-##' |
|
146 |
-##' |
|
147 |
-##' @title geom_hilight |
|
148 |
-##' @param tree_object supported tree object |
|
149 |
-##' @param node internal node |
|
150 |
-##' @param ... additional parameters |
|
151 |
-##' @return ggplot layer |
|
152 |
-##' @importFrom ape extract.clade |
|
153 |
-##' @author Guangchuang Yu |
|
154 |
-geom_hilight <- function(tree_object, node, ...) { |
|
155 |
- clade <- extract.clade(get.tree(tree_object), node) |
|
156 |
- idx <- groupOTU(tree_object, clade$tip.label) |
|
157 |
- dd <- fortify(tree_object, ...) |
|
158 |
- x <- dd[idx == 2, "x"] |
|
159 |
- y <- dd[idx == 2, "y"] |
|
160 |
- annotate("rect", xmin=min(x)-dd[node, "branch.length"]/2, |
|
161 |
- xmax=max(x), ymin=min(y)-0.5, ymax=max(y)+0.5, ...) |
|
162 |
-} |
|
163 |
- |
|
164 | 146 |
|
165 | 147 |
##' tree theme |
166 | 148 |
##' |
... | ... |
@@ -243,29 +225,6 @@ theme_transparent <- function(...) { |
243 | 225 |
} |
244 | 226 |
|
245 | 227 |
|
246 |
-##' hilight clade with rectangle |
|
247 |
-##' |
|
248 |
-##' |
|
249 |
-##' @title hilight |
|
250 |
-##' @param tree_view tree view |
|
251 |
-##' @param node clade node |
|
252 |
-##' @param fill fill color |
|
253 |
-##' @param alpha alpha |
|
254 |
-##' @param ... additional parameter |
|
255 |
-##' @return tree view |
|
256 |
-##' @export |
|
257 |
-##' @author Guangchuang Yu |
|
258 |
-hilight <- function(tree_view, node, fill="steelblue", alpha=0.5, ...) { |
|
259 |
- df <- tree_view$data |
|
260 |
- sp <- get.offspring.df(df, node) |
|
261 |
- sp.df <- df[c(sp, node),] |
|
262 |
- x <- sp.df$x |
|
263 |
- y <- sp.df$y |
|
264 |
- tree_view + annotate("rect", xmin=min(x)-df[node, "branch.length"]/2, |
|
265 |
- xmax=max(x), ymin=min(y)-0.5, ymax=max(y)+0.5, |
|
266 |
- fill = fill, alpha = alpha, ...) |
|
267 |
-} |
|
268 |
- |
|
269 | 228 |
##' scale clade |
270 | 229 |
##' |
271 | 230 |
##' |
... | ... |
@@ -467,7 +426,7 @@ collapse <- function(tree_view, node) { |
467 | 426 |
|
468 | 427 |
## re-calculate branch mid position |
469 | 428 |
df <- calculate_branch_mid(df) |
470 |
- |
|
429 |
+ |
|
471 | 430 |
tree_view$data <- df |
472 | 431 |
clade <- paste0("clade_", node) |
473 | 432 |
attr(tree_view, clade) <- sp.df |
... | ... |
@@ -535,14 +494,12 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) { |
535 | 494 |
mrsd <- attr(p, "mrsd") |
536 | 495 |
if (!is.null(mrsd)) { |
537 | 496 |
attr(p, "mrsd") <- NULL |
538 |
- if (class(p$data$x) == "Date") { |
|
539 |
- p$data$x <- Date2decimal(p$data$x) |
|
540 |
- p$data$branch <- Date2decimal(p$data$branch) |
|
541 |
- } |
|
497 |
+ |
|
498 |
+ p$data$x <- Date2decimal(p$data$x) |
|
499 |
+ p$data$branch <- Date2decimal(p$data$branch) |
|
542 | 500 |
## annotation segment not support using Date as x-axis |
543 | 501 |
} |
544 |
- |
|
545 |
- |
|
502 |
+ |
|
546 | 503 |
legend <- do.call("cbind", attr(color, "scale")) |
547 | 504 |
|
548 | 505 |
legend[,1] <- round(as.numeric(legend[,1]), 2) |
... | ... |
@@ -584,56 +541,15 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) { |
584 | 541 |
|
585 | 542 |
} |
586 | 543 |
|
587 |
-##' add evolution distance legend |
|
588 |
-##' |
|
589 |
-##' |
|
590 |
-##' @title add_legend |
|
591 |
-##' @param p tree view |
|
592 |
-##' @param width width of legend |
|
593 |
-##' @param x x position |
|
594 |
-##' @param y y position |
|
595 |
-##' @param offset offset of text and line |
|
596 |
-##' @param font.size font size |
|
597 |
-##' @param ... additional parameter |
|
598 |
-##' @return tree view |
|
599 |
-##' @importFrom grid linesGrob |
|
600 |
-##' @importFrom grid textGrob |
|
601 |
-##' @importFrom grid gpar |
|
602 |
-##' @importFrom ggplot2 ylim |
|
603 |
-##' @export |
|
604 |
-##' @author Guangchuang Yu |
|
605 |
-add_legend <- function(p, width=NULL, x=NULL, y=NULL, offset=NULL, font.size=4, ...) { |
|
606 |
- dx <- p$data$x %>% range %>% diff |
|
607 |
- |
|
608 |
- if (is.null(x)) { |
|
609 |
- ## x <- min(p$data$x) |
|
610 |
- x <- dx/2 |
|
611 |
- } |
|
612 |
- if (is.null(y)) { |
|
613 |
- y <- 0 |
|
614 |
- p <- p + ylim(0, max(p$data$y)) |
|
615 |
- } |
|
616 | 544 |
|
617 |
- if (is.null(width) || is.na(width)) { |
|
618 |
- d <- dx/10 |
|
619 |
- n <- 0 |
|
620 |
- while (d < 1) { |
|
621 |
- d <- d*10 |
|
622 |
- n <- n + 1 |
|
623 |
- } |
|
624 |
- d <- floor(d)/(10^n) |
|
625 |
- } else { |
|
626 |
- d <- width |
|
627 |
- } |
|
628 |
- |
|
629 |
- if (is.null(offset)) { |
|
630 |
- offset <- 0.4 |
|
631 |
- } |
|
632 |
- p <- p + annotation_custom(linesGrob(), xmin=x, xmax=x+d, ymin=y, ymax=y) + |
|
633 |
- annotation_custom(textGrob(label=d, gp = gpar(fontsize = font.size)), |
|
634 |
- xmin=x+d/2, xmax=x+d/2, ymin=y+offset, ymax=y+offset) |
|
635 |
- return(p) |
|
636 |
-} |
|
545 |
+ |
|
546 |
+ |
|
547 |
+ |
|
548 |
+ |
|
549 |
+ |
|
550 |
+ |
|
551 |
+ |
|
552 |
+ |
|
637 | 553 |
|
638 | 554 |
##' get taxa name of a selected node |
639 | 555 |
##' |
... | ... |
@@ -744,3 +660,6 @@ setMethod("groupClade", signature(object="gg"), |
744 | 660 |
groupClade.ggplot(object, node, group_name) |
745 | 661 |
}) |
746 | 662 |
|
663 |
+ |
|
664 |
+ |
|
665 |
+ |
... | ... |
@@ -56,8 +56,11 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", |
56 | 56 |
|
57 | 57 |
dd$x <- V2 |
58 | 58 |
|
59 |
- p2 <- p + geom_tile(data=dd, aes(x, y, fill=value), color=color, inherit.aes=FALSE) |
|
60 |
- |
|
59 |
+ if (is.null(color)) { |
|
60 |
+ p2 <- p + geom_tile(data=dd, aes(x, y, fill=value), inherit.aes=FALSE) |
|
61 |
+ } else { |
|
62 |
+ p2 <- p + geom_tile(data=dd, aes(x, y, fill=value), color=color, inherit.aes=FALSE) |
|
63 |
+ } |
|
61 | 64 |
if (is(dd$value,"numeric")) { |
62 | 65 |
p2 <- p2 + scale_fill_gradient(low=low, high=high, na.value="white") |
63 | 66 |
} else { |
... | ... |
@@ -80,6 +83,33 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", |
80 | 83 |
return(p2) |
81 | 84 |
} |
82 | 85 |
|
86 |
+##' return a data.frame that contains position information |
|
87 |
+##' for labeling column names of heatmap produced by `gheatmap` function |
|
88 |
+##' |
|
89 |
+##' |
|
90 |
+##' @title get_heatmap_column_position |
|
91 |
+##' @param treeview output of `gheatmap` |
|
92 |
+##' @param by one of 'bottom' or 'top' |
|
93 |
+##' @return data.frame |
|
94 |
+##' @export |
|
95 |
+##' @author Guangchuang Yu |
|
96 |
+get_heatmap_column_position <- function(treeview, by="bottom") { |
|
97 |
+ by %<>% match.arg(c("bottom", "top")) |
|
98 |
+ |
|
99 |
+ mapping <- attr(treeview, "mapping") |
|
100 |
+ if (is.null(mapping)) { |
|
101 |
+ stop("treeview is not an output of `gheatmap`...") |
|
102 |
+ } |
|
103 |
+ |
|
104 |
+ colnames(mapping) <- c("label", "x") |
|
105 |
+ if (by == "bottom") { |
|
106 |
+ mapping$y <- 0 |
|
107 |
+ } else { |
|
108 |
+ mapping$y <- max(treeview$data$y) + 1 |
|
109 |
+ } |
|
110 |
+ return(mapping) |
|
111 |
+} |
|
112 |
+ |
|
83 | 113 |
##' multiple sequence alignment with phylogenetic tree |
84 | 114 |
##' |
85 | 115 |
##' |
... | ... |
@@ -195,12 +225,12 @@ scale_x_ggtree <- function(p, breaks=NULL, labels=NULL) { |
195 | 225 |
} else { |
196 | 226 |
x <- p$data$x |
197 | 227 |
} |
228 |
+ |
|
198 | 229 |
if (is.null(breaks)) { |
199 | 230 |
breaks <- hist(x, breaks=5, plot=FALSE)$breaks |
200 | 231 |
} |
201 | 232 |
m <- attr(p, "mapping") |
202 | 233 |
|
203 |
- |
|
204 | 234 |
if (!is.null(mrsd) &&class(m$to) == "Date") { |
205 | 235 |
to <- Date2decimal(m$to) |
206 | 236 |
} else { |
... | ... |
@@ -218,13 +248,13 @@ scale_x_ggtree <- function(p, breaks=NULL, labels=NULL) { |
218 | 248 |
|
219 | 249 |
breaks <- c(breaks, to) |
220 | 250 |
labels <- c(labels, gsub("\\.", "", as.character(m$from))) |
221 |
- |
|
251 |
+ |
|
222 | 252 |
if (!is.null(mrsd) && class(p$data$x) == "Date") { |
223 | 253 |
p <- p + scale_x_date(breaks=decimal2Date(breaks), labels) |
224 | 254 |
} else { |
225 | 255 |
p <- p + scale_x_continuous(breaks=breaks, labels=labels) |
226 | 256 |
} |
227 |
- return(p) |
|
257 |
+ return(p) |
|
228 | 258 |
} |
229 | 259 |
|
230 | 260 |
|
... | ... |
@@ -17,27 +17,54 @@ |
17 | 17 |
##' read.hyphy(nwk, ancseq) |
18 | 18 |
read.hyphy <- function(nwk, ancseq, tip.fasfile=NULL) { |
19 | 19 |
anc <- scan(ancseq, what="", sep="\n", quiet=TRUE) |
20 |
- end <- grep("END;", anc) |
|
20 |
+ end <- grep("END;", anc, ignore.case=TRUE) |
|
21 | 21 |
|
22 |
- seq.start <- grep("MATRIX", anc) |
|
22 |
+ seq.start <- grep("MATRIX", anc, ignore.case=TRUE) |
|
23 | 23 |
seq.end <- end[end > seq.start][1] |
24 | 24 |
seq <- anc[(seq.start+1):(seq.end-1)] |
25 |
- seq <- gsub(" ", "", seq) |
|
26 |
- |
|
27 |
- label.start <- grep("TAXLABELS", anc) |
|
28 |
- label.end <- end[end > label.start][1] |
|
29 |
- label <- anc[(label.start+1):(label.end-1)] |
|
25 |
+ seq <- seq[seq != ";"] |
|
26 |
+ seq <- seq[seq != ""] |
|
27 |
+ |
|
28 |
+ ## some files may only contains sequences (should have TAXALABELS block that contains seq names). |
|
29 |
+ ## some may contains sequence name like phylip format in MATRIX block (no need to have TAXALABELS block). |
|
30 |
+ ## |
|
31 |
+ ## extract sequence name if available |
|
32 |
+ if (all(grepl("\\s+", seq))) { |
|
33 |
+ ## if contains blank space, may contains seq name |
|
34 |
+ sn <- gsub("(\\w*)\\s.*", "\\1", seq) |
|
35 |
+ } |
|
36 |
+ |
|
37 |
+ seq <- gsub("\\w*\\s+", "", seq) |
|
38 |
+ |
|
39 |
+ label.start <- grep("TAXLABELS", anc, ignore.case = TRUE) |
|
40 |
+ if (length(label.start) == 0) { |
|
41 |
+ if (all(sn == "")) { |
|
42 |
+ stop("taxa labels is not available...") |
|
43 |
+ } |
|
44 |
+ label <- sn |
|
45 |
+ } else { |
|
46 |
+ label.end <- end[end > label.start][1] |
|
47 |
+ label <- anc[(label.start+1):(label.end-1)] |
|
48 |
+ |
|
49 |
+ label <- sub("^\t+", "", label) |
|
50 |
+ label <- sub("\\s*;$", "", label) |
|
51 |
+ label <- unlist(strsplit(label, split="\\s+")) |
|
52 |
+ label <- gsub("'|\"", "", label) |
|
53 |
+ } |
|
30 | 54 |
|
31 |
- label <- sub("^\t+", "", label) |
|
32 |
- label <- sub("\\s*;$", "", label) |
|
33 |
- label <- unlist(strsplit(label, split="\\s+")) |
|
34 |
- label <- gsub("'|\"", "", label) |
|
35 |
- |
|
36 | 55 |
names(seq) <- label |
37 | 56 |
|
38 | 57 |
tr <- read.tree(nwk) |
39 | 58 |
nl <- tr$node.label |
40 |
- nl[nl == ""] <- "Node1" |
|
59 |
+ ## root node may missing, which was supposed to be 'Node1' |
|
60 |
+ ## |
|
61 |
+ ## from a user's file, which is 'Node0', but it seems the file is not from the output of HYPHY. |
|
62 |
+ ## |
|
63 |
+ ## I am not sure. But it's safe to use "label[!label %in% nl]" instead of just assign it to "Node1". |
|
64 |
+ ## |
|
65 |
+ ## nl[nl == ""] <- "Node1" |
|
66 |
+ nl[nl == ""] <- label[!label %in% nl] |
|
67 |
+ |
|
41 | 68 |
tr$node.label <- nl |
42 | 69 |
|
43 | 70 |
type <- get_seqtype(seq) |
... | ... |
@@ -199,7 +199,7 @@ setMethod("get.placements", signature(object = "jplace"), |
199 | 199 |
## if not equals, the output is a descript string of the differences |
200 | 200 |
idx <- sapply(2:nrow(x), function(i) all.equal(x[1,2], x[i,2])) |
201 | 201 |
if (any(idx == TRUE)) { |
202 |
- return(x[c(1, which(idx==TRUE)),]) |
|
202 |
+ return(x[c(1, which(idx==TRUE)+1),]) |
|
203 | 203 |
} else { |
204 | 204 |
return(x[1,]) |
205 | 205 |
} |
... | ... |
@@ -251,7 +251,7 @@ get.fields.jplace <- function(object, ...) { |
251 | 251 |
get.treeinfo.jplace <- function(object, layout, |
252 | 252 |
ladderize, right, ...) { |
253 | 253 |
extract.treeinfo.jplace(object, layout, |
254 |
- ladderize, right) |
|
254 |
+ ladderize, right, ...) |
|
255 | 255 |
} |
256 | 256 |
|
257 | 257 |
##' generate jplace file |
... | ... |
@@ -62,14 +62,6 @@ read.paml_rst <- function(rstfile) { |
62 | 62 |
} |
63 | 63 |
|
64 | 64 |
|
65 |
-##' @rdname gzoom-methods |
|
66 |
-##' @exportMethod gzoom |
|
67 |
-setMethod("gzoom", signature(object="paml_rst"), |
|
68 |
- function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
69 |
- gzoom.phylo(get.tree(object), focus, subtree, widths) |
|
70 |
- }) |
|
71 |
- |
|
72 |
- |
|
73 | 65 |
|
74 | 66 |
##' @rdname groupClade-methods |
75 | 67 |
##' @exportMethod groupClade |
... | ... |
@@ -79,13 +71,10 @@ setMethod("groupClade", signature(object="paml_rst"), |
79 | 71 |
} |
80 | 72 |
) |
81 | 73 |
|
82 |
-##' @rdname scale_color-methods |
|
83 |
-##' @exportMethod scale_color |
|
84 |
-setMethod("scale_color", signature(object="paml_rst"), |
|
85 |
- function(object, by, ...) { |
|
86 |
- scale_color_(object, by, ...) |
|
87 |
- }) |
|
88 | 74 |
|
75 |
+##' get tipseq |
|
76 |
+##' |
|
77 |
+##' |
|
89 | 78 |
##' @rdname get.tipseq-methods |
90 | 79 |
##' @exportMethod get.tipseq |
91 | 80 |
setMethod("get.tipseq", signature(object="paml_rst"), |
... | ... |
@@ -149,7 +138,9 @@ setMethod("get.tree", signature(object = "paml_rst"), |
149 | 138 |
) |
150 | 139 |
|
151 | 140 |
|
152 |
- |
|
141 |
+##' get substitution information |
|
142 |
+##' |
|
143 |
+##' |
|
153 | 144 |
##' @rdname get.subs-methods |
154 | 145 |
##' @exportMethod get.subs |
155 | 146 |
setMethod("get.subs", signature(object = "paml_rst"), |
... | ... |
@@ -1,10 +1,13 @@ |
1 |
+##' reroot a tree |
|
2 |
+##' |
|
3 |
+##' |
|
1 | 4 |
##' @rdname reroot-methods |
2 | 5 |
##' @exportMethod reroot |
3 | 6 |
setMethod("reroot", signature(object="phylo"), |
4 | 7 |
function(object, node, ...) { |
5 | 8 |
pos <- 0.5* object$edge.length[which(object$edge[,2] == node)] |
6 | 9 |
|
7 |
- ##' @importFrom phytools reroot |
|
10 |
+ ## @importFrom phytools reroot |
|
8 | 11 |
phytools <- "phytools" |
9 | 12 |
require(phytools, character.only = TRUE) |
10 | 13 |
|
... | ... |
@@ -80,11 +83,5 @@ groupClade.phylo <- function(object, node, group_name) { |
80 | 83 |
} |
81 | 84 |
|
82 | 85 |
|
83 |
-##' @rdname gzoom-methods |
|
84 |
-##' @exportMethod gzoom |
|
85 |
-setMethod("gzoom", signature(object="phylo"), |
|
86 |
- function(object, focus, subtree=FALSE, widths=c(.3, .7)) { |
|
87 |
- gzoom.phylo(object, focus, subtree, widths) |
|
88 |
- }) |
|
89 | 86 |
|
90 | 87 |
|
... | ... |
@@ -24,14 +24,20 @@ get.phylopic <- function(id, size=512, color="black", alpha=1) { |
24 | 24 |
##' @return matrix |
25 | 25 |
##' @importFrom grDevices rgb |
26 | 26 |
##' @importFrom grDevices col2rgb |
27 |
-##' @importFrom EBImage readImage |
|
28 |
-##' @importFrom EBImage channel |
|
27 |
+## @importFrom EBImage readImage |
|
28 |
+## @importFrom EBImage channel |
|
29 | 29 |
##' @export |
30 | 30 |
##' @author Guangchuang Yu |
31 | 31 |
download.phylopic <- function(id, size=512, color="black", alpha=1) { |
32 | 32 |
imgfile <- tempfile(fileext = ".png") |
33 | 33 |
download.phylopic_internal(id, size, imgfile) |
34 | 34 |
|
35 |
+ EBImage <- "EBImage" |
|
36 |
+ require(EBImage, character.only = TRUE) |
|
37 |
+ |
|
38 |
+ readImage <- eval(parse(text="readImage")) |
|
39 |
+ channel <- eval(parse(text="channel")) |
|
40 |
+ |
|
35 | 41 |
img <- readImage(imgfile) |
36 | 42 |
|
37 | 43 |
color <- col2rgb(color) / 255 |
... | ... |
@@ -130,6 +136,10 @@ annotation_image <- function(tree_view, img_info, width=0.1, align=TRUE, linetyp |
130 | 136 |
x <- df[idx, "x"] |
131 | 137 |
y <- df[idx, "y"] |
132 | 138 |
|
139 |
+ EBImage <- "EBImage" |
|
140 |
+ require(EBImage, character.only = TRUE) |
|
141 |
+ readImage <- eval(parse(text="readImage")) |
|
142 |
+ |
|
133 | 143 |
images <- lapply(img_info[,2], readImage) |
134 | 144 |
|
135 | 145 |
ARs <- sapply(images, getAR) |
... | ... |
@@ -9,7 +9,6 @@ |