git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@118925 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.5.5 |
|
4 |
+Version: 1.5.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 |
... | ... |
@@ -27,6 +27,7 @@ export("%>%") |
27 | 27 |
export(.) |
28 | 28 |
export(Date2decimal) |
29 | 29 |
export(MRCA) |
30 |
+export(StatBalance) |
|
30 | 31 |
export(StatHilight) |
31 | 32 |
export(add_colorbar) |
32 | 33 |
export(annotation_image) |
... | ... |
@@ -38,6 +39,7 @@ export(download.phylopic) |
38 | 39 |
export(expand) |
39 | 40 |
export(flip) |
40 | 41 |
export(geom_aline) |
42 |
+export(geom_balance) |
|
41 | 43 |
export(geom_cladelabel) |
42 | 44 |
export(geom_hilight) |
43 | 45 |
export(geom_label2) |
... | ... |
@@ -67,6 +69,7 @@ export(get.treeinfo) |
67 | 69 |
export(get.treetext) |
68 | 70 |
export(getNodeNum) |
69 | 71 |
export(getRoot) |
72 |
+export(get_balance_position) |
|
70 | 73 |
export(get_clade_position) |
71 | 74 |
export(get_heatmap_column_position) |
72 | 75 |
export(get_taxa_name) |
... | ... |
@@ -108,6 +111,7 @@ export(rtree) |
108 | 111 |
export(scaleClade) |
109 | 112 |
export(scale_color) |
110 | 113 |
export(scale_x_ggtree) |
114 |
+export(stat_balance) |
|
111 | 115 |
export(stat_hilight) |
112 | 116 |
export(subview) |
113 | 117 |
export(theme_inset) |
... | ... |
@@ -1,3 +1,8 @@ |
1 |
+CHANGES IN VERSION 1.5.6 |
|
2 |
+------------------------ |
|
3 |
+ o geom_balance contributed by Justin Silverman <2016-06-22, Wed> |
|
4 |
+ + see https://github.com/GuangchuangYu/ggtree/pull/64 |
|
5 |
+ |
|
1 | 6 |
CHANGES IN VERSION 1.5.5 |
2 | 7 |
------------------------ |
3 | 8 |
o update geom_tiplab2 according to angle change introduced by open_tree <2016-06-20, Mon> |
... | ... |
@@ -1,24 +1,6 @@ |
1 |
-##' read newick tree |
|
1 |
+ |
|
2 | 2 |
##' @export |
3 |
-##' @rdname read.tree |
|
4 |
-##' @param file file name |
|
5 |
-##' @param text alternatively, using newick text |
|
6 |
-##' @param tree.names if read several trees, specify their names |
|
7 |
-##' @param skip number of lines of the input file to skip |
|
8 |
-##' @param comment.char a single character, |
|
9 |
-##' the remaining of the line after this character is ignored. |
|
10 |
-##' @param keep.multi if 'TRUE' and 'tree.names = NULL' |
|
11 |
-##' then single trees are returned in 'multiPhylo' format |
|
12 |
-##' with any name that is present. Default is 'FALSE' |
|
13 |
-##' @param ... further arguments to be passed to 'scan()'. |
|
14 |
-##' @source |
|
15 |
-##' This is just the imported function |
|
16 |
-##' from the ape package. The documentation you should |
|
17 |
-##' read for the read.tree function can be found here: \link[ape]{read.tree} |
|
18 |
-##' |
|
19 |
-##' @seealso |
|
20 |
-##' \link[ape]{read.tree} |
|
21 |
-read.tree <- ape::read.tree |
|
3 |
+ape::read.tree |
|
22 | 4 |
|
23 | 5 |
|
24 | 6 |
##' generate random tree |
25 | 7 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,208 @@ |
1 |
+#' highlights the two direct descendant clades of an internal node |
|
2 |
+#' |
|
3 |
+#' Particularly useful when studying neighboring clades. Note that balances that |
|
4 |
+#' correspond to multichotomies will not be displayed. |
|
5 |
+#' |
|
6 |
+#' @title geom_balance |
|
7 |
+#' @param node selected node (balance) to highlight |
|
8 |
+#' @param fill color fill |
|
9 |
+#' @param color color to outline highlights and divide balance |
|
10 |
+#' @param alpha alpha (transparency) |
|
11 |
+#' @param extend extend xmax of the rectangle |
|
12 |
+#' @param extendto extend xmax to extendto |
|
13 |
+#' @return ggplot2 |
|
14 |
+#' @export |
|
15 |
+#' @importFrom ggplot2 aes_ |
|
16 |
+#' @importFrom ggplot2 GeomRect |
|
17 |
+#' @author Justin Silverman |
|
18 |
+#' @references J. Silverman, et al. \emph{A phylogenetic transform enhances |
|
19 |
+#' analysis of compositional microbiota data}. (in preparation) |
|
20 |
+geom_balance <- function(node, fill="steelblue", color='white', alpha=.5, extend=0, extendto=NULL) { |
|
21 |
+ |
|
22 |
+ data = NULL |
|
23 |
+ stat = "balance" |
|
24 |
+ position = "identity" |
|
25 |
+ show.legend = NA |
|
26 |
+ na.rm = TRUE |
|
27 |
+ inherit.aes = FALSE |
|
28 |
+ |
|
29 |
+ default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length) |
|
30 |
+ mapping <- default_aes |
|
31 |
+ |
|
32 |
+ l1 <- layer( |
|
33 |
+ stat=StatBalance, |
|
34 |
+ data = data, |
|
35 |
+ mapping = mapping, |
|
36 |
+ geom = GeomRect, |
|
37 |
+ position = position, |
|
38 |
+ show.legend=show.legend, |
|
39 |
+ inherit.aes = inherit.aes, |
|
40 |
+ params = list(node=node, |
|
41 |
+ fill=fill, |
|
42 |
+ color=color, |
|
43 |
+ alpha=alpha, |
|
44 |
+ extend=extend, |
|
45 |
+ extendto=extendto, |
|
46 |
+ direction=1, |
|
47 |
+ na.rm = na.rm) |
|
48 |
+ ) |
|
49 |
+ l2 <- layer( |
|
50 |
+ stat=StatBalance, |
|
51 |
+ data = data, |
|
52 |
+ mapping = mapping, |
|
53 |
+ geom = GeomRect, |
|
54 |
+ position = position, |
|
55 |
+ show.legend=show.legend, |
|
56 |
+ inherit.aes = inherit.aes, |
|
57 |
+ params = list(node=node, |
|
58 |
+ fill=fill, |
|
59 |
+ color=color, |
|
60 |
+ alpha=alpha, |
|
61 |
+ extend=extend, |
|
62 |
+ extendto=extendto, |
|
63 |
+ direction=2, |
|
64 |
+ na.rm = na.rm) |
|
65 |
+ ) |
|
66 |
+ return(c(l1,l2)) |
|
67 |
+} |
|
68 |
+ |
|
69 |
+#' stat_balance |
|
70 |
+#' |
|
71 |
+#' |
|
72 |
+#' @title stat_balance |
|
73 |
+#' @param mapping aes mapping |
|
74 |
+#' @param data data |
|
75 |
+#' @param geom geometric object |
|
76 |
+#' @param position position |
|
77 |
+#' @param node node number |
|
78 |
+#' @param show.legend show legend |
|
79 |
+#' @param inherit.aes logical |
|
80 |
+#' @param fill fill color |
|
81 |
+#' @param color color to outline highlights and divide balance |
|
82 |
+#' @param alpha transparency |
|
83 |
+#' @param extend extend xmax of the rectangle |
|
84 |
+#' @param extendto extend xmax to extendto |
|
85 |
+#' @param ... additional parameter |
|
86 |
+#' @return layer |
|
87 |
+#' @importFrom ggplot2 layer |
|
88 |
+#' @export |
|
89 |
+stat_balance <- function(mapping=NULL, data=NULL, geom="rect", |
|
90 |
+ position="identity", node, |
|
91 |
+ show.legend=NA, inherit.aes=FALSE, |
|
92 |
+ fill, color, alpha, extend=0, extendto=NULL, |
|
93 |
+ ...) { |
|
94 |
+ default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length) |
|
95 |
+ if (is.null(mapping)) { |
|
96 |
+ mapping <- default_aes |
|
97 |
+ } else { |
|
98 |
+ mapping <- modifyList(mapping, default_aes) |
|
99 |
+ } |
|
100 |
+ |
|
101 |
+ l1 <- layer( |
|
102 |
+ stat=StatBalance, |
|
103 |
+ data = data, |
|
104 |
+ mapping = mapping, |
|
105 |
+ geom = geom, |
|
106 |
+ position = position, |
|
107 |
+ show.legend=show.legend, |
|
108 |
+ inherit.aes = inherit.aes, |
|
109 |
+ params = list(node=node, |
|
110 |
+ fill=fill, |
|
111 |
+ color=color, |
|
112 |
+ alpha=alpha, |
|
113 |
+ extend=extend, |
|
114 |
+ extendto=extendto, |
|
115 |
+ direction=1, |
|
116 |
+ ...) |
|
117 |
+ ) |
|
118 |
+ l2 <- layer( |
|
119 |
+ stat=StatBalance, |
|
120 |
+ data = data, |
|
121 |
+ mapping = mapping, |
|
122 |
+ geom = geom, |
|
123 |
+ position = position, |
|
124 |
+ show.legend=show.legend, |
|
125 |
+ inherit.aes = inherit.aes, |
|
126 |
+ params = list(node=node, |
|
127 |
+ fill=fill, |
|
128 |
+ color=color, |
|
129 |
+ alpha=alpha, |
|
130 |
+ extend=extend, |
|
131 |
+ extendto=extendto, |
|
132 |
+ direction=2, |
|
133 |
+ ...) |
|
134 |
+ ) |
|
135 |
+ return(c(l1,l2)) |
|
136 |
+} |
|
137 |
+ |
|
138 |
+##' StatBalance |
|
139 |
+##' @rdname ggtree-ggproto |
|
140 |
+##' @format NULL |
|
141 |
+##' @usage NULL |
|
142 |
+##' @importFrom ggplot2 Stat |
|
143 |
+##' @export |
|
144 |
+StatBalance <- ggproto("StatBalance", Stat, |
|
145 |
+ compute_group = function(self, data, scales, params, node, extend, extendto, direction) { |
|
146 |
+ df <- get_balance_position_(data, node, direction) |
|
147 |
+ |
|
148 |
+ df$xmax <- df$xmax + extend |
|
149 |
+ if (!is.null(extendto) && !is.na(extendto)) { |
|
150 |
+ if (extendto < df$xmax) { |
|
151 |
+ warning("extendto is too small, keep the original xmax value...") |
|
152 |
+ } else { |
|
153 |
+ df$xmax <- extendto |
|
154 |
+ } |
|
155 |
+ } |
|
156 |
+ return(df) |
|
157 |
+ }, |
|
158 |
+ required_aes = c("x", "y", "branch.length") |
|
159 |
+) |
|
160 |
+ |
|
161 |
+ |
|
162 |
+#' get position of balance (xmin, xmax, ymin, ymax) |
|
163 |
+#' |
|
164 |
+#' |
|
165 |
+#' @title get_balance_position |
|
166 |
+#' @param treeview tree view |
|
167 |
+#' @param node selected node |
|
168 |
+#' @param direction either (1 for 'up' or 2 for 'down') |
|
169 |
+#' @return data.frame |
|
170 |
+#' @export |
|
171 |
+#' @author Justin Silverman |
|
172 |
+get_balance_position <- function(treeview, node, direction) { |
|
173 |
+ get_balance_position_(treeview$data, node, direction) |
|
174 |
+} |
|
175 |
+ |
|
176 |
+get_balance_position_ <- function(data, node, direction) { |
|
177 |
+ ch <- tryCatch(getChild.df(data, node), error=function(e) NULL) |
|
178 |
+ |
|
179 |
+ if (length(ch) < 2 || is.null(ch)){ |
|
180 |
+ stop('balance cannot be a tip') |
|
181 |
+ } else if (length(ch) > 2){ |
|
182 |
+ stop('balance has >2 direct child nodes, can use ape::multi2di to convert to binary tree') |
|
183 |
+ } |
|
184 |
+ |
|
185 |
+ i <- match(node, data$node) |
|
186 |
+ sp <- tryCatch(get.offspring.df(data, ch[direction]), error=function(e) ch[direction]) |
|
187 |
+ sp.all <- get.offspring.df(data, i) |
|
188 |
+ sp.df <- data[match(sp, data$node),] |
|
189 |
+ sp.all.df <- data[match(sp.all, data$node),] |
|
190 |
+ n.df <- data[i,] |
|
191 |
+ |
|
192 |
+ # X direction is uniform for both children, but y is only based on range of |
|
193 |
+ # one of the two children (direction) |
|
194 |
+ x <- sp.all.df$x |
|
195 |
+ y <- sp.df$y |
|
196 |
+ #x.n <- n.df$x |
|
197 |
+ |
|
198 |
+ if ("branch.length" %in% colnames(data)) { |
|
199 |
+ xmin <- min(x)-data[i, "branch.length"]/2 |
|
200 |
+ } else { |
|
201 |
+ xmin <- min(sp.df$branch) |
|
202 |
+ } |
|
203 |
+ #xmin <- x.n |
|
204 |
+ data.frame(xmin=xmin, |
|
205 |
+ xmax = max(x), |
|
206 |
+ ymin=min(y)-0.5, |
|
207 |
+ ymax=max(y)+0.5) |
|
208 |
+} |
|
0 | 209 |
\ No newline at end of file |
... | ... |
@@ -31,20 +31,25 @@ mask <- function(tree_object, field, site, mask_site=FALSE) { |
31 | 31 |
} |
32 | 32 |
|
33 | 33 |
field_data <- sapply(field_data, gsub, pattern="\n", replacement="/") |
34 |
+ |
|
35 |
+ x <- field_data[field_data != ""] |
|
36 |
+ x <- x[!is.na(x)] |
|
37 |
+ pos <- strsplit(x, " / ") %>% unlist %>% |
|
38 |
+ gsub("^[a-zA-Z]+", "", . ) %>% |
|
39 |
+ gsub("[a-zA-Z]\\s*$", "", .) %>% |
|
40 |
+ as.numeric |
|
34 | 41 |
|
35 | 42 |
if (mask_site == FALSE) { |
36 |
- x <- field_data[field_data != ""] |
|
37 |
- x <- x[!is.na(x)] |
|
38 |
- pos <- strsplit(x, " / ") %>% unlist %>% |
|
39 |
- gsub("^[a-zA-Z]+", "", . ) %>% |
|
40 |
- gsub("[a-zA-Z]\\s*$", "", .) %>% |
|
41 |
- as.numeric |
|
42 | 43 |
pos2 <- 1:max(pos) |
43 | 44 |
pos2 <- pos2[-site] |
44 | 45 |
site <- pos2 |
45 | 46 |
} |
46 | 47 |
|
48 |
+ site <- site[site %in% pos] |
|
49 |
+ |
|
47 | 50 |
for (i in seq_along(field_data)) { |
51 |
+ if (is.na(field_data[i])) |
|
52 |
+ next |
|
48 | 53 |
for (j in seq_along(site)) { |
49 | 54 |
pattern <- paste0("/*\\s*[a-zA-Z]", site[j], "[a-zA-Z]\\s*") |
50 | 55 |
field_data[i] <- gsub(pattern, "", field_data[i]) |
... | ... |
@@ -27,9 +27,9 @@ Please cite the following article when using `ggtree`: |
27 | 27 |
|
28 | 28 |
``` |
29 | 29 |
G Yu, D Smith, H Zhu, Y Guan, TTY Lam, |
30 |
-ggtree: an R package for visualization and annotation of phylogenetic tree |
|
31 |
- with different types of meta-data. |
|
32 |
-Methods in Ecology and Evolution, submitted |
|
30 |
+ggtree: an R package for visualization and annotation of phylogenetic trees |
|
31 |
+ with their covariates and other associated data. |
|
32 |
+Methods in Ecology and Evolution, revised |
|
33 | 33 |
``` |
34 | 34 |
|
35 | 35 |
## License ## |
... | ... |
@@ -50,7 +50,7 @@ To view the vignette of `ggtree` installed in your system, start `R` and enter: |
50 | 50 |
vignette("ggtree", package = "ggtree") |
51 | 51 |
``` |
52 | 52 |
|
53 |
-More documents can be found in <http://guangchuangyu.github.io/tags/ggtree>. |
|
53 |
+More documents can be found in <https://guangchuangyu.github.io/ggtree>. |
|
54 | 54 |
|
55 | 55 |
|
56 | 56 |
## Bugs/Feature requests ## |
... | ... |
@@ -2,7 +2,7 @@ citHeader("To cite ggtree in publications use:") |
2 | 2 |
|
3 | 3 |
citEntry( |
4 | 4 |
entry = "article", |
5 |
- title = "ggtree: an R package for visualization and annotation of phylogenetic tree with different types of meta-data", |
|
5 |
+ title = "ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data.", |
|
6 | 6 |
author = personList( |
7 | 7 |
as.person("Guangchuang Yu"), |
8 | 8 |
as.person("David Smith"), |
... | ... |
@@ -10,7 +10,7 @@ citEntry( |
10 | 10 |
as.person("Yi Guan"), |
11 | 11 |
as.person("Tommy Tsan-Yuk Lam") |
12 | 12 |
), |
13 |
- year = "submitted", |
|
13 |
+ year = "revised", |
|
14 | 14 |
journal = "Methods in Ecology and Evolution", |
15 | 15 |
volume = "", |
16 | 16 |
issue = "", |
... | ... |
@@ -20,7 +20,7 @@ citEntry( |
20 | 20 |
PMID = "", |
21 | 21 |
url = "", |
22 | 22 |
textVersion = paste("Guangchuang Yu, David Smith, Huachen Zhu, Yi Guan, Tommy Tsan-Yuk Lam.", |
23 |
- "ggtree: an R package for visualization and annotation of phylogenetic tree with different types of meta-data.", |
|
24 |
- "Methods in Ecology and Evolution submitted") |
|
23 |
+ "ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data.", |
|
24 |
+ "Methods in Ecology and Evolution revised") |
|
25 | 25 |
) |
26 | 26 |
|
27 | 27 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,40 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/geom_balance.R |
|
3 |
+\name{geom_balance} |
|
4 |
+\alias{geom_balance} |
|
5 |
+\title{geom_balance} |
|
6 |
+\usage{ |
|
7 |
+geom_balance(node, fill = "steelblue", color = "white", alpha = 0.5, |
|
8 |
+ extend = 0, extendto = NULL) |
|
9 |
+} |
|
10 |
+\arguments{ |
|
11 |
+\item{node}{selected node (balance) to highlight} |
|
12 |
+ |
|
13 |
+\item{fill}{color fill} |
|
14 |
+ |
|
15 |
+\item{color}{color to outline highlights and divide balance} |
|
16 |
+ |
|
17 |
+\item{alpha}{alpha (transparency)} |
|
18 |
+ |
|
19 |
+\item{extend}{extend xmax of the rectangle} |
|
20 |
+ |
|
21 |
+\item{extendto}{extend xmax to extendto} |
|
22 |
+} |
|
23 |
+\value{ |
|
24 |
+ggplot2 |
|
25 |
+} |
|
26 |
+\description{ |
|
27 |
+highlights the two direct descendant clades of an internal node |
|
28 |
+} |
|
29 |
+\details{ |
|
30 |
+Particularly useful when studying neighboring clades. Note that balances that |
|
31 |
+correspond to multichotomies will not be displayed. |
|
32 |
+} |
|
33 |
+\author{ |
|
34 |
+Justin Silverman |
|
35 |
+} |
|
36 |
+\references{ |
|
37 |
+J. Silverman, et al. \emph{A phylogenetic transform enhances |
|
38 |
+ analysis of compositional microbiota data}. (in preparation) |
|
39 |
+} |
|
40 |
+ |
0 | 41 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,25 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/geom_balance.R |
|
3 |
+\name{get_balance_position} |
|
4 |
+\alias{get_balance_position} |
|
5 |
+\title{get_balance_position} |
|
6 |
+\usage{ |
|
7 |
+get_balance_position(treeview, node, direction) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{treeview}{tree view} |
|
11 |
+ |
|
12 |
+\item{node}{selected node} |
|
13 |
+ |
|
14 |
+\item{direction}{either (1 for 'up' or 2 for 'down')} |
|
15 |
+} |
|
16 |
+\value{ |
|
17 |
+data.frame |
|
18 |
+} |
|
19 |
+\description{ |
|
20 |
+get position of balance (xmin, xmax, ymin, ymax) |
|
21 |
+} |
|
22 |
+\author{ |
|
23 |
+Justin Silverman |
|
24 |
+} |
|
25 |
+ |
... | ... |
@@ -1,10 +1,13 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/geom_hilight.R |
|
2 |
+% Please edit documentation in R/geom_balance.R, R/geom_hilight.R |
|
3 | 3 |
\docType{data} |
4 |
-\name{StatHilight} |
|
4 |
+\name{StatBalance} |
|
5 |
+\alias{StatBalance} |
|
5 | 6 |
\alias{StatHilight} |
6 |
-\title{StatHilight} |
|
7 |
+\title{StatBalance} |
|
7 | 8 |
\description{ |
9 |
+StatBalance |
|
10 |
+ |
|
8 | 11 |
StatHilight |
9 | 12 |
} |
10 | 13 |
\keyword{datasets} |
11 | 14 |
deleted file mode 100644 |
... | ... |
@@ -1,39 +0,0 @@ |
1 |
-% Generated by roxygen2: do not edit by hand |
|
2 |
-% Please edit documentation in R/ape.R |
|
3 |
-\name{read.tree} |
|
4 |
-\alias{read.tree} |
|
5 |
-\title{read newick tree} |
|
6 |
-\source{ |
|
7 |
-This is just the imported function |
|
8 |
-from the ape package. The documentation you should |
|
9 |
-read for the read.tree function can be found here: \link[ape]{read.tree} |
|
10 |
-} |
|
11 |
-\usage{ |
|
12 |
-read.tree(file = "", text = NULL, tree.names = NULL, skip = 0, |
|
13 |
- comment.char = "#", keep.multi = FALSE, ...) |
|
14 |
-} |
|
15 |
-\arguments{ |
|
16 |
-\item{file}{file name} |
|
17 |
- |
|
18 |
-\item{text}{alternatively, using newick text} |
|
19 |
- |
|
20 |
-\item{tree.names}{if read several trees, specify their names} |
|
21 |
- |
|
22 |
-\item{skip}{number of lines of the input file to skip} |
|
23 |
- |
|
24 |
-\item{comment.char}{a single character, |
|
25 |
-the remaining of the line after this character is ignored.} |
|
26 |
- |
|
27 |
-\item{keep.multi}{if 'TRUE' and 'tree.names = NULL' |
|
28 |
-then single trees are returned in 'multiPhylo' format |
|
29 |
-with any name that is present. Default is 'FALSE'} |
|
30 |
- |
|
31 |
-\item{...}{further arguments to be passed to 'scan()'.} |
|
32 |
-} |
|
33 |
-\description{ |
|
34 |
-read newick tree |
|
35 |
-} |
|
36 |
-\seealso{ |
|
37 |
-\link[ape]{read.tree} |
|
38 |
-} |
|
39 |
- |
40 | 0 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,16 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/ape.R |
|
3 |
+\docType{import} |
|
4 |
+\name{reexports} |
|
5 |
+\alias{read.tree} |
|
6 |
+\alias{reexports} |
|
7 |
+\title{Objects exported from other packages} |
|
8 |
+\description{ |
|
9 |
+These objects are imported from other packages. Follow the links |
|
10 |
+below to see their documentation. |
|
11 |
+ |
|
12 |
+\describe{ |
|
13 |
+ \item{ape}{\code{\link[ape]{read.tree}}} |
|
14 |
+}} |
|
15 |
+\keyword{internal} |
|
16 |
+ |
0 | 17 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,44 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/geom_balance.R |
|
3 |
+\name{stat_balance} |
|
4 |
+\alias{stat_balance} |
|
5 |
+\title{stat_balance} |
|
6 |
+\usage{ |
|
7 |
+stat_balance(mapping = NULL, data = NULL, geom = "rect", |
|
8 |
+ position = "identity", node, show.legend = NA, inherit.aes = FALSE, |
|
9 |
+ fill, color, alpha, extend = 0, extendto = NULL, ...) |
|
10 |
+} |
|
11 |
+\arguments{ |
|
12 |
+\item{mapping}{aes mapping} |
|
13 |
+ |
|
14 |
+\item{data}{data} |
|
15 |
+ |
|
16 |
+\item{geom}{geometric object} |
|
17 |
+ |
|
18 |
+\item{position}{position} |
|
19 |
+ |
|
20 |
+\item{node}{node number} |
|
21 |
+ |
|
22 |
+\item{show.legend}{show legend} |
|
23 |
+ |
|
24 |
+\item{inherit.aes}{logical} |
|
25 |
+ |
|
26 |
+\item{fill}{fill color} |
|
27 |
+ |
|
28 |
+\item{color}{color to outline highlights and divide balance} |
|
29 |
+ |
|
30 |
+\item{alpha}{transparency} |
|
31 |
+ |
|
32 |
+\item{extend}{extend xmax of the rectangle} |
|
33 |
+ |
|
34 |
+\item{extendto}{extend xmax to extendto} |
|
35 |
+ |
|
36 |
+\item{...}{additional parameter} |
|
37 |
+} |
|
38 |
+\value{ |
|
39 |
+layer |
|
40 |
+} |
|
41 |
+\description{ |
|
42 |
+stat_balance |
|
43 |
+} |
|
44 |
+ |
0 | 45 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,13 @@ |
1 |
+context('geom_balance') |
|
2 |
+ |
|
3 |
+test_that('geom_balance gives proper errors if called on non-binary node', { |
|
4 |
+ tr <- ape::read.tree(text="(t2:0.1280947195,(t4:0.2642134866,(t3:0.9758362926,(t1:0.3494729637,t5:0.189841171,t6:0.189841171):0.7222939907):0.3401968146):0.5143072554);") |
|
5 |
+ |
|
6 |
+ # Note: For some reason while ggplot will give warning and properly does not show |
|
7 |
+ # the problematic geom, the output of the function is not recognized as a warning. |
|
8 |
+ # This is not crutial but it makes adding unit tests more difficult. |
|
9 |
+ #expect_warning(ggtree(tr)+geom_balance(10), '>2 direct child nodes') |
|
10 |
+ #expect_warning(ggtree(tr)+geom_balance(3), 'balance cannot be a tip') |
|
11 |
+ |
|
12 |
+ expect_true(is.ggplot(ggtree(tr)+geom_balance(9))) # should plot appropriately |
|
13 |
+}) |
|
0 | 14 |
\ No newline at end of file |
... | ... |
@@ -45,8 +45,8 @@ If you use `ggtree` in published research, please cite: |
45 | 45 |
|
46 | 46 |
``` |
47 | 47 |
G Yu, D Smith, H Zhu, Y Guan, TTY Lam, |
48 |
-ggtree: an R package for visualization and annotation of phylogenetic tree with different types of meta-data. |
|
49 |
-revised. |
|
48 |
+ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data. |
|
49 |
+Methods in Ecology and Evolution, revised. |
|
50 | 50 |
``` |
51 | 51 |
|
52 | 52 |
# Introduction |
... | ... |
@@ -169,10 +169,19 @@ ggtree(tree, layout="circular") + geom_hilight(node=21, fill="steelblue", alpha= |
169 | 169 |
|
170 | 170 |
Another way to highlight selected clades is setting the clades with different colors and/or line types as demonstrated in [Tree Manipulation](treeManipulation.html#groupclade) vignette. |
171 | 171 |
|
172 |
+# Highlight balances |
|
173 |
+In addition to _`geom_hilight`_, `ggtree` also implements _`geom_balance`_ |
|
174 |
+which is designed to highlight neighboring subclades of a given internal node. |
|
175 |
+ |
|
176 |
+```{r fig.width=4, fig.height=5, fig.align='center', warning=FALSE} |
|
177 |
+ggtree(tree) + |
|
178 |
+ geom_balance(node=16, fill='steelblue', color='white', alpha=0.6, extend=1) + |
|
179 |
+ geom_balance(node=19, fill='darkgreen', color='white', alpha=0.6, extend=1) |
|
180 |
+``` |
|
172 | 181 |
|
173 | 182 |
# labelling associated taxa (Monophyletic, Polyphyletic or Paraphyletic) |
174 | 183 |
|
175 |
-`geom_cladelabel` is designed to labelling Monophyletic (Clade) while there are related taxa that are not form a clade. `ggtree` provides `geom_strip` to add a strip/bar to indicate the association with optional label (see [the issue](https://github.com/GuangchuangYu/ggtree/issues/52)). |
|
184 |
+`geom_cladelabel` is designed for labelling Monophyletic (Clade) while there are related taxa that are not form a clade. `ggtree` provides `geom_strip` to add a strip/bar to indicate the association with optional label (see [the issue](https://github.com/GuangchuangYu/ggtree/issues/52)). |
|
176 | 185 |
|
177 | 186 |
```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE} |
178 | 187 |
ggtree(tree) + geom_tiplab() + geom_strip('E', 'G', barsize=2, color='red') + geom_strip('F', 'L', barsize=2, color='blue') |