git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@119521 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -11,7 +11,6 @@ Depends: |
11 | 11 |
ggplot2 (>= 2.0.0) |
12 | 12 |
Imports: |
13 | 13 |
ape, |
14 |
- Biostrings, |
|
15 | 14 |
grDevices, |
16 | 15 |
grid, |
17 | 16 |
jsonlite, |
... | ... |
@@ -21,19 +20,17 @@ Imports: |
21 | 20 |
tidyr, |
22 | 21 |
utils |
23 | 22 |
Suggests: |
23 |
+ Biostrings, |
|
24 | 24 |
colorspace, |
25 | 25 |
EBImage, |
26 | 26 |
knitr, |
27 |
- phylobase, |
|
28 |
- phytools, |
|
29 |
- phangorn, |
|
30 | 27 |
rmarkdown, |
31 | 28 |
scales, |
32 | 29 |
testthat |
33 | 30 |
VignetteBuilder: knitr |
34 | 31 |
ByteCompile: true |
35 | 32 |
License: Artistic-2.0 |
36 |
-URL: http://guangchuangyu.github.io/ggtree |
|
33 |
+URL: https://guangchuangyu.github.io/ggtree |
|
37 | 34 |
BugReports: https://github.com/GuangchuangYu/ggtree/issues |
38 | 35 |
Packaged: 2014-12-03 08:16:14 UTC; root |
39 | 36 |
biocViews: Alignment, Annotation, Clustering, DataImport, |
... | ... |
@@ -147,11 +147,6 @@ exportMethods(plot) |
147 | 147 |
exportMethods(reroot) |
148 | 148 |
exportMethods(scale_color) |
149 | 149 |
exportMethods(show) |
150 |
-importFrom(Biostrings,BStringSet) |
|
151 |
-importFrom(Biostrings,DNAStringSet) |
|
152 |
-importFrom(Biostrings,GENETIC_CODE) |
|
153 |
-importFrom(Biostrings,readBStringSet) |
|
154 |
-importFrom(Biostrings,toString) |
|
155 | 150 |
importFrom(ape,Nnode) |
156 | 151 |
importFrom(ape,Ntip) |
157 | 152 |
importFrom(ape,drop.tip) |
... | ... |
@@ -232,9 +227,14 @@ importFrom(magrittr,"%<>%") |
232 | 227 |
importFrom(magrittr,"%>%") |
233 | 228 |
importFrom(magrittr,add) |
234 | 229 |
importFrom(magrittr,equals) |
230 |
+importFrom(methods,"slot<-") |
|
231 |
+importFrom(methods,.hasSlot) |
|
232 |
+importFrom(methods,is) |
|
233 |
+importFrom(methods,missingArg) |
|
234 |
+importFrom(methods,new) |
|
235 | 235 |
importFrom(methods,show) |
236 |
+importFrom(methods,slot) |
|
236 | 237 |
importFrom(stats4,plot) |
237 | 238 |
importFrom(tidyr,gather) |
238 | 239 |
importFrom(utils,download.file) |
239 | 240 |
importFrom(utils,modifyList) |
240 |
-importMethodsFrom(Biostrings,width) |
... | ... |
@@ -1,5 +1,11 @@ |
1 | 1 |
CHANGES IN VERSION 1.5.6 |
2 | 2 |
------------------------ |
3 |
+ o remove dependency of Biostring for installing ggtree <2016-07-21, Thu> |
|
4 |
+ + still needed for building vignette and for processing FASTA file |
|
5 |
+ o remove dependency of EBImage for building & installing ggtree <2016-07-21, Thu> |
|
6 |
+ + the package is still needed if user want to annotate tree with image file |
|
7 |
+ o `%<+%` now works with tbl_df <2016-07-21, Thu> |
|
8 |
+ + https://github.com/GuangchuangYu/ggtree/issues/66 |
|
3 | 9 |
o identify method for ggtree <2016-06-28, Tue> |
4 | 10 |
+ see https://guangchuangyu.github.io/2016/06/identify-method-for-ggtree |
5 | 11 |
o geom_balance contributed by Justin Silverman <2016-06-22, Wed> |
... | ... |
@@ -309,6 +309,7 @@ setClass("phangorn", |
309 | 309 |
) |
310 | 310 |
|
311 | 311 |
|
312 |
+ |
|
312 | 313 |
##' Class "phylip" |
313 | 314 |
##' This class stores phylip tree(s) |
314 | 315 |
##' |
... | ... |
@@ -330,7 +331,7 @@ setClass("phylip", |
330 | 331 |
fields = "character", |
331 | 332 |
phylo = "phyloOrmultiPhylo", |
332 | 333 |
ntree = "numeric", |
333 |
- sequence = "BStringSet", |
|
334 |
+ sequence = "character", |
|
334 | 335 |
extraInfo = "data.frame") |
335 | 336 |
) |
336 | 337 |
|
... | ... |
@@ -7,8 +7,8 @@ |
7 | 7 |
##' one of hyphy output |
8 | 8 |
##' @param tip.fasfile tip sequence file |
9 | 9 |
##' @return A hyphy object |
10 |
-##' @importFrom Biostrings readBStringSet |
|
11 |
-##' @importFrom Biostrings toString |
|
10 |
+## @importFrom Biostrings readBStringSet |
|
11 |
+## @importFrom Biostrings toString |
|
12 | 12 |
##' @export |
13 | 13 |
##' @author Guangchuang Yu \url{http://ygc.name} |
14 | 14 |
##' @examples |
... | ... |
@@ -86,6 +86,9 @@ read.hyphy <- function(nwk, ancseq, tip.fasfile=NULL) { |
86 | 86 |
) |
87 | 87 |
|
88 | 88 |
if ( !is.null(tip.fasfile) ) { |
89 |
+ readBStringSet <- get_fun_from_pkg("Biostrings", "readBStringSet") |
|
90 |
+ toString <- get_fun_from_pkg("Biostrings", "toString") |
|
91 |
+ |
|
89 | 92 |
tip_seq <- readBStringSet(tip.fasfile) |
90 | 93 |
nn <- names(tip_seq) |
91 | 94 |
tip_seq <- sapply(seq_along(tip_seq), function(i) { |
... | ... |
@@ -107,7 +107,7 @@ setMethod("show", signature(object = "phylip"), |
107 | 107 |
cat("...@ tree: ") |
108 | 108 |
print.phylo(get.tree(object)) |
109 | 109 |
msg <- paste0("\nwith sequence alignment available (", length(object@sequence), |
110 |
- " sequences of length ", width(object@sequence)[1], ")\n") |
|
110 |
+ " sequences of length ", nchar(object@sequence)[1], ")\n") |
|
111 | 111 |
cat(msg) |
112 | 112 |
}) |
113 | 113 |
|
... | ... |
@@ -10,8 +10,8 @@ |
10 | 10 |
##' @param window specific a slice to display |
11 | 11 |
##' @return tree view |
12 | 12 |
##' @export |
13 |
-##' @importFrom Biostrings readBStringSet |
|
14 |
-##' @importMethodsFrom Biostrings width |
|
13 |
+## @importFrom Biostrings readBStringSet |
|
14 |
+## @importMethodsFrom Biostrings width |
|
15 | 15 |
## @importFrom colorspace rainbow_hcl |
16 | 16 |
##' @importFrom ggplot2 geom_segment |
17 | 17 |
##' @importFrom ggplot2 geom_rect |
... | ... |
@@ -23,22 +23,26 @@ msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL){ |
23 | 23 |
} else if (is(fasta, "BStringSet")) { |
24 | 24 |
aln <- fasta |
25 | 25 |
} else if (is(fasta, "character")) { |
26 |
+ readBStringSet <- get_fun_from_pkg("Biostrings", "readBStringSet") |
|
26 | 27 |
aln <- readBStringSet(fasta) |
27 | 28 |
} else { |
28 | 29 |
aln <- NULL |
29 | 30 |
} |
30 | 31 |
|
31 | 32 |
if (is(p, "phylip")) { |
32 |
- aln <- p@sequence |
|
33 |
+ BStringSet <- get_fun_from_pkg("Biostrings", "BStringSet") |
|
34 |
+ aln <- BStringSet(p@sequence) |
|
33 | 35 |
p <- ggtree(p) + geom_tiplab() |
34 | 36 |
} |
35 | 37 |
|
36 | 38 |
if (is.null(aln)) { |
37 | 39 |
stop("multiple sequence alignment is not available...\n-> check the parameter 'fasta'...") |
38 | 40 |
} |
41 |
+ |
|
42 |
+ width_fun <- get_fun_from_pkg("Biostrings", "width") |
|
39 | 43 |
|
40 | 44 |
if (is.null(window)) { |
41 |
- window <- c(1, width(aln)[1]) |
|
45 |
+ window <- c(1, width_fun(aln)[1]) |
|
42 | 46 |
} |
43 | 47 |
slice <- seq(window[1], window[2], by=1) |
44 | 48 |
|
... | ... |
@@ -81,7 +81,7 @@ |
81 | 81 |
d2 <- d2[, ii] |
82 | 82 |
dd <- merge(d1, d2, by.x="node", by.y="node", all.x=TRUE) |
83 | 83 |
} else { |
84 |
- d2[,1] <- as.character(d2[,1]) |
|
84 |
+ d2[,1] <- as.character(unlist(d2[,1])) ## `unlist` to work with tbl_df |
|
85 | 85 |
dd <- merge(d1, d2, by.x="label", by.y=1, all.x=TRUE) |
86 | 86 |
} |
87 | 87 |
dd <- dd[match(d1$node, dd$node),] |
... | ... |
@@ -20,8 +20,8 @@ read.baseml <- function(rstfile, mlbfile) { |
20 | 20 |
##' read rst file from paml output |
21 | 21 |
##' |
22 | 22 |
##' |
23 |
-##' @importFrom Biostrings readBStringSet |
|
24 |
-##' @importFrom Biostrings toString |
|
23 |
+## @importFrom Biostrings readBStringSet |
|
24 |
+## @importFrom Biostrings toString |
|
25 | 25 |
##' @title read.paml_rst |
26 | 26 |
##' @param rstfile rst file |
27 | 27 |
##' @return A \code{paml_rst} object |
... | ... |
@@ -119,10 +119,11 @@ setMethod("get.fields", signature(object="phangorn"), |
119 | 119 |
##' @param pml pml object |
120 | 120 |
##' @param includeAncestor logical |
121 | 121 |
##' @return XStringSet |
122 |
-##' @importFrom Biostrings DNAStringSet |
|
122 |
+## @importFrom Biostrings DNAStringSet |
|
123 | 123 |
##' @export |
124 | 124 |
##' @author ygc |
125 | 125 |
pmlToSeq <- function(pml, includeAncestor=TRUE) { |
126 |
+ DNAStringSet <- get_fun_from_pkg("Biostrings", "DNAStringSet") |
|
126 | 127 |
pmlToSeqString(pml, includeAncestor) %>% |
127 | 128 |
DNAStringSet |
128 | 129 |
} |
... | ... |
@@ -132,10 +133,7 @@ pmlToSeqString <- function(pml, type, includeAncestor=TRUE) { |
132 | 133 |
if (includeAncestor == FALSE) { |
133 | 134 |
phyDat <- pml$data |
134 | 135 |
} else { |
135 |
- pkg <- "phangorn" |
|
136 |
- require(pkg, character.only = TRUE) |
|
137 |
- ## requireNamespace("phangorn") |
|
138 |
- ancestral.pml <- eval(parse(text="phangorn::ancestral.pml")) |
|
136 |
+ ancestral.pml <- get_fun_from_pkg("phangorn", "ancestral.pml") |
|
139 | 137 |
phyDat <- ancestral.pml(pml, type) |
140 | 138 |
} |
141 | 139 |
|
... | ... |
@@ -5,7 +5,7 @@ |
5 | 5 |
##' @param file phylip file |
6 | 6 |
##' @return an instance of 'phylip' |
7 | 7 |
##' @export |
8 |
-##' @importFrom Biostrings BStringSet |
|
8 |
+## @importFrom Biostrings BStringSet |
|
9 | 9 |
##' @author Guangchuang Yu |
10 | 10 |
read.phylip <- function(file) { |
11 | 11 |
phylip <- readLines(file) |
... | ... |
@@ -27,17 +27,16 @@ read.phylip <- function(file) { |
27 | 27 |
seq_with_name <- lapply(seqlines, function(x) unlist(strsplit(x, "\\s+"))) |
28 | 28 |
seqs <- sapply(seq_with_name, function(x) x[2]) |
29 | 29 |
names(seqs) <- sapply(seq_with_name, function(x) x[1]) |
30 |
- seq_obj <- BStringSet(seqs) |
|
31 | 30 |
|
32 |
- if (any(width(seq_obj) != seqLen)) { |
|
33 |
- stop(paste("sequence length not consistent...\n->", paste0(width(seq_obj), collapse=" "))) |
|
31 |
+ if (any(nchar(seqs) != seqLen)) { |
|
32 |
+ stop(paste("sequence length not consistent...\n->", paste0(nchar(seqs), collapse=" "))) |
|
34 | 33 |
} |
35 | 34 |
|
36 | 35 |
new("phylip", |
37 | 36 |
file = filename(file), |
38 | 37 |
phylo = trees, |
39 | 38 |
ntree = ntree, |
40 |
- sequence = seq_obj |
|
39 |
+ sequence = seqs |
|
41 | 40 |
) |
42 | 41 |
} |
43 | 42 |
|
... | ... |
@@ -32,8 +32,9 @@ 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 |
- requireNamespace("EBImage") |
|
36 |
- channel <- eval(parse(text=paste0("EBImage::", "channel"))) |
|
35 |
+ channel <- get_fun_from_pkg("EBImage", "channel") |
|
36 |
+ readImage <- get_fun_from_pkg("EBImage", "readImage") |
|
37 |
+ |
|
37 | 38 |
img <- readImage(imgfile) |
38 | 39 |
|
39 | 40 |
color <- col2rgb(color) / 255 |
... | ... |
@@ -135,6 +136,7 @@ annotation_image <- function(tree_view, img_info, width=0.1, align=TRUE, linetyp |
135 | 136 |
x <- df[idx, "x"] |
136 | 137 |
y <- df[idx, "y"] |
137 | 138 |
|
139 |
+ readImage <- get_fun_from_pkg("EBImage", "readImage") |
|
138 | 140 |
images <- lapply(img_info[,2], readImage) |
139 | 141 |
|
140 | 142 |
ARs <- sapply(images, getAR) |
... | ... |
@@ -30,6 +30,7 @@ subview <- function(mainview, subview, x, y, width=.1, height=.1) { |
30 | 30 |
} else if (is(subview, "grob")) { |
31 | 31 |
sv <- subview |
32 | 32 |
} else if (file.exists(subview)) { |
33 |
+ readImage <- get_fun_from_pkg("EBImage", "readImage") |
|
33 | 34 |
sv <- rasterGrob(readImage(subview)) |
34 | 35 |
} else { |
35 | 36 |
stop("subview should be a ggplot or grob object, or an image file...") |
... | ... |
@@ -19,6 +19,7 @@ get_tree_view <- function(tree_view) { |
19 | 19 |
} |
20 | 20 |
|
21 | 21 |
|
22 |
+##' @importFrom methods .hasSlot is missingArg new slot slot<- |
|
22 | 23 |
has.slot <- function(object, slotName) { |
23 | 24 |
if (!isS4(object)) { |
24 | 25 |
return(FALSE) |
... | ... |
@@ -251,8 +252,10 @@ seq2codon <- function(x) { |
251 | 252 |
substring(x, first=seq(1, nchar(x)-2, 3), last=seq(3, nchar(x), 3)) |
252 | 253 |
} |
253 | 254 |
|
254 |
-##' @importFrom Biostrings GENETIC_CODE |
|
255 |
+## @importFrom Biostrings GENETIC_CODE |
|
255 | 256 |
codon2AA <- function(codon) { |
257 |
+ ## a genetic code name vector |
|
258 |
+ GENETIC_CODE <- get_fun_from_pkg("Biostrings", "GENETIC_CODE") |
|
256 | 259 |
aa <- GENETIC_CODE[codon] |
257 | 260 |
aa[is.na(aa)] <- "X" |
258 | 261 |
return(aa) |
... | ... |
@@ -493,13 +496,15 @@ getCols <- function (n) { |
493 | 496 |
|
494 | 497 |
|
495 | 498 |
get_fun_from_pkg <- function(pkg, fun) { |
496 |
- requireNamespace(pkg) |
|
497 |
- eval(parse(text=paste0(pkg, "::", fun))) |
|
499 |
+ ## requireNamespace(pkg) |
|
500 |
+ ## eval(parse(text=paste0(pkg, "::", fun))) |
|
501 |
+ require(pkg, character.only = TRUE) |
|
502 |
+ eval(parse(text = fun)) |
|
498 | 503 |
} |
499 | 504 |
|
500 | 505 |
hist <- get_fun_from_pkg("graphics", "hist") |
501 | 506 |
|
502 |
-readImage <- get_fun_from_pkg("EBImage", "readImage") |
|
507 |
+ |
|
503 | 508 |
|
504 | 509 |
|
505 | 510 |
|
... | ... |
@@ -16,6 +16,7 @@ output: |
16 | 16 |
vignette: > |
17 | 17 |
%\VignetteIndexEntry{05 Advance Tree Annotation} |
18 | 18 |
%\VignetteEngine{knitr::rmarkdown} |
19 |
+ %\VignetteDepends{Biostrings} |
|
19 | 20 |
%\usepackage[utf8]{inputenc} |
20 | 21 |
--- |
21 | 22 |
|
... | ... |
@@ -27,6 +28,7 @@ knitr::opts_chunk$set(tidy = FALSE, |
27 | 28 |
|
28 | 29 |
```{r echo=FALSE, results="hide", message=FALSE} |
29 | 30 |
library("ape") |
31 |
+library("Biostrings") |
|
30 | 32 |
library("ggplot2") |
31 | 33 |
library("ggtree") |
32 | 34 |
``` |
... | ... |
@@ -16,8 +16,6 @@ output: |
16 | 16 |
vignette: > |
17 | 17 |
%\VignetteIndexEntry{04 Tree Annotation} |
18 | 18 |
%\VignetteEngine{knitr::rmarkdown} |
19 |
- %\VignetteDepends{phangorn} |
|
20 |
- %\VignetteDepends{phylobase} |
|
21 | 19 |
%\usepackage[utf8]{inputenc} |
22 | 20 |
--- |
23 | 21 |
|
... | ... |
@@ -215,7 +213,7 @@ ggtree(tree) + geom_label(aes(label=bootstrap)) + geom_tiplab() |
215 | 213 |
|
216 | 214 |
## annotating tree with phangorn output |
217 | 215 |
|
218 |
-```{r results='hide', message=FALSE} |
|
216 |
+```{r results='hide', message=FALSE, fig.width=12, fig.height=10, width=60, warning=FALSE, fig.align="center", eval=FALSE} |
|
219 | 217 |
library(phangorn) |
220 | 218 |
treefile <- system.file("extdata", "pa.nwk", package="ggtree") |
221 | 219 |
tre <- read.tree(treefile) |
... | ... |
@@ -225,13 +223,13 @@ fit <- pml(tre, tipseq, k=4) |
225 | 223 |
fit <- optim.pml(fit, optNni=FALSE, optBf=T, optQ=T, |
226 | 224 |
optInv=T, optGamma=T, optEdge=TRUE, |
227 | 225 |
optRooted=FALSE, model = "GTR") |
228 |
-``` |
|
229 | 226 |
|
230 |
-```{r fig.width=12, fig.height=10, width=60, warning=FALSE, fig.align="center"} |
|
231 | 227 |
phangorn <- phyPML(fit, type="ml") |
232 | 228 |
ggtree(phangorn) + geom_text(aes(x=branch, label=AA_subs, vjust=-.5)) |
233 | 229 |
``` |
234 | 230 |
|
231 |
+ |
|
232 |
+ |
|
235 | 233 |
# Tree annotation with output from evolution software |
236 | 234 |
|
237 | 235 |
In `ggtree`, we implemented several parser functions to parse output from commonly used software package in evolutionary biology, including: |
... | ... |
@@ -300,7 +298,7 @@ p + geom_text(aes(color=place, label=place), hjust=1, vjust=-0.4, size=3) + |
300 | 298 |
|
301 | 299 |
`phylo4d` was defined in the `phylobase` package, which can be employed to integrate user's data with phylogenetic tree. `phylo4d` was supported in `ggtree` and the data stored in the object can be used directly to annotate the tree. |
302 | 300 |
|
303 |
-```{r fig.width=6, fig.height=5, warning=FALSE, fig.align="center"} |
|
301 |
+```{r fig.width=6, fig.height=5, warning=FALSE, fig.align="center", eval=FALSE} |
|
304 | 302 |
dd2 <- dd[, -1] |
305 | 303 |
rownames(dd2) <- dd[,1] |
306 | 304 |
require(phylobase) |
... | ... |
@@ -309,7 +307,9 @@ ggtree(tr2) + geom_tiplab(aes(color=place)) + |
309 | 307 |
geom_tippoint(aes(size=value, shape=place, color=place), alpha=0.25) |
310 | 308 |
``` |
311 | 309 |
|
312 |
- |
|
310 |
+ |
|
311 |
+ |
|
312 |
+ |
|
313 | 313 |
## jplace file format |
314 | 314 |
|
315 | 315 |
`ggtree` provides `write.jplace()` function to store user's own data and associated newick tree to a single `jplace` file, which can be parsed directly in `ggtree` and user's data can be used to annotate the tree directly. For more detail, please refer to the [Tree Data Import](treeImport.html#jplace-file-format) vignette. |
... | ... |
@@ -17,6 +17,7 @@ vignette: > |
17 | 17 |
%\VignetteIndexEntry{01 Tree Data Import} |
18 | 18 |
%\VignetteEngine{knitr::rmarkdown} |
19 | 19 |
%\VignetteDepends{scales} |
20 |
+ %\VignetteDepends{Biostrings) |
|
20 | 21 |
%\usepackage[utf8]{inputenc} |
21 | 22 |
--- |
22 | 23 |
|
... | ... |
@@ -28,6 +29,7 @@ knitr::opts_chunk$set(tidy = FALSE, |
28 | 29 |
|
29 | 30 |
```{r echo=FALSE, results="hide", message=FALSE} |
30 | 31 |
library("ape") |
32 |
+library("Biostrings") |
|
31 | 33 |
library("ggplot2") |
32 | 34 |
library("ggtree") |
33 | 35 |
``` |
... | ... |
@@ -139,7 +141,7 @@ ggtree(beast, ndigits=2, branch.length = 'none') + geom_text(aes(x=branch, label |
139 | 141 |
`ggtree` provides `geom_range` layer to display uncertainty of branch length. |
140 | 142 |
|
141 | 143 |
```{r warning=FALSE, fig.width=10, fig.height=10} |
142 |
-ggtree(beast) + geom_range(range='height_0.95_HPD', color='red', alpha=.6, size=2) |
|
144 |
+ggtree(beast) + geom_range(range='length_0.95_HPD', color='red', alpha=.6, size=2) |
|
143 | 145 |
``` |
144 | 146 |
|
145 | 147 |
In `FigTree`, only `heigh_0.95_HPD` is meaningful since the branch is scaled by `height`. In `ggtree` we can display HPD of `rate`, `height` or other variable if available since `ggtree` can rescale a tree using `rescale_tree` function or by specifing `branch.length` in `ggtree` function. |