git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@112503 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -1,5 +1,12 @@ |
1 |
+CHANGES IN VERSION 1.3.9 |
|
2 |
+------------------------ |
|
3 |
+ o viewClade, scaleClade, collapse, expand, rotate, flip, get_taxa_name and scale_x_ggtree accepts input tree_view=NULL. |
|
4 |
+ these function will access the last plot if tree_view=NULL. <2016-01-13, Wed> |
|
5 |
+ + > ggtree(rtree(30)); viewClade(node=35) works. no need to pipe. |
|
6 |
+ |
|
1 | 7 |
CHANGES IN VERSION 1.3.8 |
2 | 8 |
------------------------ |
9 |
+ o add example of viewClade in 'Tree Manipulation' vignette <2016-01-13, Wed> |
|
3 | 10 |
o add viewClade function <2016-01-12, Tue> |
4 | 11 |
o support obkData object defined by OutbreakTools <2016-01-12, Tue> |
5 | 12 |
o update vignettes <2016-01-07, Thu> |
... | ... |
@@ -13,7 +20,7 @@ CHANGES IN VERSION 1.3.7 |
13 | 20 |
+ 00 ggtree <2015-12-29, Tue> |
14 | 21 |
+ 01 tree data import <2015-12-28, Mon> |
15 | 22 |
+ 02 tree visualization <2015-12-28, Mon> |
16 |
- + 03 tree view manipulation <2015-12-28, Mon> |
|
23 |
+ + 03 tree manipulation <2015-12-28, Mon> |
|
17 | 24 |
+ 04 tree annotation <2015-12-29, Tue> |
18 | 25 |
|
19 | 26 |
CHANGES IN VERSION 1.3.6 |
20 | 27 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,285 @@ |
1 |
+##' get taxa name of a selected node |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title get_taxa_name |
|
5 |
+##' @param tree_view tree view |
|
6 |
+##' @param node node |
|
7 |
+##' @return taxa name vector |
|
8 |
+##' @export |
|
9 |
+##' @author Guangchuang Yu |
|
10 |
+get_taxa_name <- function(tree_view=NULL, node) { |
|
11 |
+ tree_view %<>% get_tree_view |
|
12 |
+ |
|
13 |
+ df <- tree_view$data |
|
14 |
+ sp <- get.offspring.df(df, node) |
|
15 |
+ res <- df[sp, "label"] |
|
16 |
+ return(res[df[sp, "isTip"]]) |
|
17 |
+} |
|
18 |
+ |
|
19 |
+ |
|
20 |
+ |
|
21 |
+ |
|
22 |
+##' view a clade of tree |
|
23 |
+##' |
|
24 |
+##' |
|
25 |
+##' @title viewClade |
|
26 |
+##' @param tree_view full tree view |
|
27 |
+##' @param node internal node number |
|
28 |
+##' @param xmax_adjust adjust xmax |
|
29 |
+##' @return clade plot |
|
30 |
+##' @export |
|
31 |
+##' @author Guangchuang Yu |
|
32 |
+viewClade <- function(tree_view=NULL, node, xmax_adjust=0) { |
|
33 |
+ tree_view %<>% get_tree_view |
|
34 |
+ |
|
35 |
+ cpos <- get_clade_position(tree_view, node=node) |
|
36 |
+ with(cpos, tree_view+xlim(xmin, xmax*1.01 + xmax_adjust) + ylim(ymin, ymax)) |
|
37 |
+} |
|
38 |
+ |
|
39 |
+ |
|
40 |
+##' collapse a clade |
|
41 |
+##' |
|
42 |
+##' |
|
43 |
+##' @title collapse |
|
44 |
+##' @param tree_view tree view |
|
45 |
+##' @param node clade node |
|
46 |
+##' @return tree view |
|
47 |
+##' @export |
|
48 |
+##' @seealso expand |
|
49 |
+##' @author Guangchuang Yu |
|
50 |
+collapse <- function(tree_view=NULL, node) { |
|
51 |
+ tree_view %<>% get_tree_view |
|
52 |
+ |
|
53 |
+ df <- tree_view$data |
|
54 |
+ sp <- get.offspring.df(df, node) |
|
55 |
+ sp.df <- df[sp,] |
|
56 |
+ df[node, "isTip"] <- TRUE |
|
57 |
+ sp_y <- range(sp.df$y) |
|
58 |
+ ii <- which(df$y > max(sp_y)) |
|
59 |
+ if (length(ii)) { |
|
60 |
+ df$y[ii] <- df$y[ii] - diff(sp_y) |
|
61 |
+ } |
|
62 |
+ df$y[node] <- min(sp_y) |
|
63 |
+ |
|
64 |
+ df[sp, "x"] <- NA |
|
65 |
+ df[sp, "y"] <- NA |
|
66 |
+ |
|
67 |
+ root <- which(df$node == df$parent) |
|
68 |
+ pp <- df[node, "parent"] |
|
69 |
+ while(any(pp != root)) { |
|
70 |
+ df[pp, "y"] <- mean(df[getChild.df(df, pp), "y"]) |
|
71 |
+ pp <- df[pp, "parent"] |
|
72 |
+ } |
|
73 |
+ j <- getChild.df(df, pp) |
|
74 |
+ j <- j[j!=pp] |
|
75 |
+ df[pp, "y"] <- mean(df[j, "y"]) |
|
76 |
+ |
|
77 |
+ ## re-calculate branch mid position |
|
78 |
+ df <- calculate_branch_mid(df) |
|
79 |
+ |
|
80 |
+ tree_view$data <- df |
|
81 |
+ clade <- paste0("clade_", node) |
|
82 |
+ attr(tree_view, clade) <- sp.df |
|
83 |
+ tree_view |
|
84 |
+} |
|
85 |
+ |
|
86 |
+##' expand collased clade |
|
87 |
+##' |
|
88 |
+##' |
|
89 |
+##' @title expand |
|
90 |
+##' @param tree_view tree view |
|
91 |
+##' @param node clade node |
|
92 |
+##' @return tree view |
|
93 |
+##' @export |
|
94 |
+##' @seealso collapse |
|
95 |
+##' @author Guangchuang Yu |
|
96 |
+expand <- function(tree_view=NULL, node) { |
|
97 |
+ tree_view %<>% get_tree_view |
|
98 |
+ |
|
99 |
+ clade <- paste0("clade_", node) |
|
100 |
+ sp.df <- attr(tree_view, clade) |
|
101 |
+ if (is.null(sp.df)) { |
|
102 |
+ return(tree_view) |
|
103 |
+ } |
|
104 |
+ df <- tree_view$data |
|
105 |
+ df[node, "isTip"] <- FALSE |
|
106 |
+ sp_y <- range(sp.df$y) |
|
107 |
+ ii <- which(df$y > df$y[node]) |
|
108 |
+ df[ii, "y"] <- df[ii, "y"] + diff(sp_y) |
|
109 |
+ |
|
110 |
+ sp.df$y <- sp.df$y - min(sp.df$y) + df$y[node] |
|
111 |
+ df[sp.df$node,] <- sp.df |
|
112 |
+ |
|
113 |
+ root <- which(df$node == df$parent) |
|
114 |
+ pp <- node |
|
115 |
+ while(any(pp != root)) { |
|
116 |
+ df[pp, "y"] <- mean(df[getChild.df(df, pp), "y"]) |
|
117 |
+ pp <- df[pp, "parent"] |
|
118 |
+ } |
|
119 |
+ j <- getChild.df(df, pp) |
|
120 |
+ j <- j[j!=pp] |
|
121 |
+ df[pp, "y"] <- mean(df[j, "y"]) |
|
122 |
+ |
|
123 |
+ ## re-calculate branch mid position |
|
124 |
+ df <- calculate_branch_mid(df) |
|
125 |
+ |
|
126 |
+ tree_view$data <- df |
|
127 |
+ attr(tree_view, clade) <- NULL |
|
128 |
+ tree_view |
|
129 |
+} |
|
130 |
+ |
|
131 |
+##' rotate 180 degree of a selected branch |
|
132 |
+##' |
|
133 |
+##' |
|
134 |
+##' @title rotate |
|
135 |
+##' @param tree_view tree view |
|
136 |
+##' @param node selected node |
|
137 |
+##' @return ggplot2 object |
|
138 |
+##' @export |
|
139 |
+##' @author Guangchuang Yu |
|
140 |
+rotate <- function(tree_view=NULL, node) { |
|
141 |
+ tree_view %<>% get_tree_view |
|
142 |
+ |
|
143 |
+ df <- tree_view$data |
|
144 |
+ sp <- get.offspring.df(df, node) |
|
145 |
+ sp_idx <- with(df, match(sp, node)) |
|
146 |
+ tip <- sp[df$isTip[sp_idx]] |
|
147 |
+ sp.df <- df[sp_idx,] |
|
148 |
+ ii <- with(sp.df, match(tip, node)) |
|
149 |
+ jj <- ii[order(sp.df[ii, "y"])] |
|
150 |
+ sp.df[jj,"y"] <- rev(sp.df[jj, "y"]) |
|
151 |
+ sp.df[-jj, "y"] <- NA |
|
152 |
+ sp.df <- re_assign_ycoord_df(sp.df, tip) |
|
153 |
+ |
|
154 |
+ df[sp_idx, "y"] <- sp.df$y |
|
155 |
+ df[df$node == node, "y"] <- mean(df[df$parent == node, "y"]) |
|
156 |
+ pnode <- df$parent[df$node == node] |
|
157 |
+ if (pnode != node && !is.na(pnode)) { |
|
158 |
+ df[df$node == pnode, "y"] <- mean(df[df$parent == pnode, "y"]) |
|
159 |
+ } |
|
160 |
+ tree_view$data <- df |
|
161 |
+ tree_view |
|
162 |
+} |
|
163 |
+ |
|
164 |
+ |
|
165 |
+ |
|
166 |
+##' flip position of two selected branches |
|
167 |
+##' |
|
168 |
+##' |
|
169 |
+##' @title flip |
|
170 |
+##' @param tree_view tree view |
|
171 |
+##' @param node1 node number of branch 1 |
|
172 |
+##' @param node2 node number of branch 2 |
|
173 |
+##' @return ggplot2 object |
|
174 |
+##' @export |
|
175 |
+##' @author Guangchuang Yu |
|
176 |
+flip <- function(tree_view=NULL, node1, node2) { |
|
177 |
+ tree_view %<>% get_tree_view |
|
178 |
+ |
|
179 |
+ df <- tree_view$data |
|
180 |
+ p1 <- with(df, parent[node == node1]) |
|
181 |
+ p2 <- with(df, parent[node == node2]) |
|
182 |
+ |
|
183 |
+ if (p1 != p2) { |
|
184 |
+ stop("node1 and node2 should share a same parent node...") |
|
185 |
+ } |
|
186 |
+ |
|
187 |
+ sp1 <- c(node1, get.offspring.df(df, node1)) |
|
188 |
+ sp2 <- c(node2, get.offspring.df(df, node2)) |
|
189 |
+ |
|
190 |
+ sp1.df <- df[sp1,] |
|
191 |
+ sp2.df <- df[sp2,] |
|
192 |
+ |
|
193 |
+ min_y1 <- min(sp1.df$y) |
|
194 |
+ min_y2 <- min(sp2.df$y) |
|
195 |
+ |
|
196 |
+ if (min_y1 < min_y2) { |
|
197 |
+ tmp <- sp1.df |
|
198 |
+ sp1.df <- sp2.df |
|
199 |
+ sp2.df <- tmp |
|
200 |
+ tmp <- sp1 |
|
201 |
+ sp1 <- sp2 |
|
202 |
+ sp2 <- tmp |
|
203 |
+ } |
|
204 |
+ |
|
205 |
+ min_y1 <- min(sp1.df$y) |
|
206 |
+ min_y2 <- min(sp2.df$y) |
|
207 |
+ |
|
208 |
+ space <- min(sp1.df$y) - max(sp2.df$y) |
|
209 |
+ sp1.df$y <- sp1.df$y - abs(min_y1 - min_y2) |
|
210 |
+ sp2.df$y <- sp2.df$y + max(sp1.df$y) + space - min(sp2.df$y) |
|
211 |
+ |
|
212 |
+ df[sp1, "y"] <- sp1.df$y |
|
213 |
+ df[sp2, "y"] <- sp2.df$y |
|
214 |
+ |
|
215 |
+ anc <- getAncestor.df(df, node1) |
|
216 |
+ ii <- match(anc, df$node) |
|
217 |
+ df[ii, "y"] <- NA |
|
218 |
+ currentNode <- unlist(as.vector(sapply(anc, getChild.df, df=df))) |
|
219 |
+ currentNode <- currentNode[!currentNode %in% anc] |
|
220 |
+ |
|
221 |
+ tree_view$data <- re_assign_ycoord_df(df, currentNode) |
|
222 |
+ tree_view |
|
223 |
+} |
|
224 |
+ |
|
225 |
+ |
|
226 |
+##' scale clade |
|
227 |
+##' |
|
228 |
+##' |
|
229 |
+##' @title scaleClade |
|
230 |
+##' @param tree_view tree view |
|
231 |
+##' @param node clade node |
|
232 |
+##' @param scale scale |
|
233 |
+##' @param vertical_only logical. If TRUE, only vertical will be scaled. |
|
234 |
+##' If FALSE, the clade will be scaled vertical and horizontally. |
|
235 |
+##' TRUE by default. |
|
236 |
+##' @return tree view |
|
237 |
+##' @export |
|
238 |
+##' @author Guangchuang Yu |
|
239 |
+scaleClade <- function(tree_view=NULL, node, scale=1, vertical_only=TRUE) { |
|
240 |
+ tree_view %<>% get_tree_view |
|
241 |
+ |
|
242 |
+ if (scale == 1) { |
|
243 |
+ return(tree_view) |
|
244 |
+ } |
|
245 |
+ |
|
246 |
+ df <- tree_view$data |
|
247 |
+ sp <- get.offspring.df(df, node) |
|
248 |
+ sp.df <- df[sp,] |
|
249 |
+ |
|
250 |
+ ## sp_nr <- nrow(sp.df) |
|
251 |
+ ## span <- diff(range(sp.df$y))/sp_nr |
|
252 |
+ |
|
253 |
+ ## new_span <- span * scale |
|
254 |
+ old.sp.df <- sp.df |
|
255 |
+ sp.df$y <- df[node, "y"] + (sp.df$y - df[node, "y"]) * scale |
|
256 |
+ if (vertical_only == FALSE) { |
|
257 |
+ sp.df$x <- df[node, "x"] + (sp.df$x - df[node, "x"]) * scale |
|
258 |
+ } |
|
259 |
+ |
|
260 |
+ scale_diff.up <- max(sp.df$y) - max(old.sp.df$y) |
|
261 |
+ scale_diff.lw <- min(sp.df$y) - min(old.sp.df$y) |
|
262 |
+ |
|
263 |
+ ii <- df$y > max(old.sp.df$y) |
|
264 |
+ if (sum(ii) > 0) { |
|
265 |
+ df[ii, "y"] <- df[ii, "y"] + scale_diff.up |
|
266 |
+ } |
|
267 |
+ |
|
268 |
+ jj <- df$y < min(old.sp.df$y) |
|
269 |
+ if (sum(jj) > 0) { |
|
270 |
+ df[jj, "y"] <- df[jj, "y"] + scale_diff.lw |
|
271 |
+ } |
|
272 |
+ |
|
273 |
+ df[sp,] <- sp.df |
|
274 |
+ |
|
275 |
+ if (! "scale" %in% colnames(df)) { |
|
276 |
+ df$scale <- 1 |
|
277 |
+ } |
|
278 |
+ df[sp, "scale"] <- df[sp, "scale"] * scale |
|
279 |
+ |
|
280 |
+ ## re-calculate branch mid position |
|
281 |
+ df <- calculate_branch_mid(df) |
|
282 |
+ |
|
283 |
+ tree_view$data <- df |
|
284 |
+ tree_view |
|
285 |
+} |
... | ... |
@@ -143,256 +143,8 @@ geom_tree <- function(layout="rectangular", ...) { |
143 | 143 |
|
144 | 144 |
|
145 | 145 |
|
146 |
-##' scale clade |
|
147 |
-##' |
|
148 |
-##' |
|
149 |
-##' @title scaleClade |
|
150 |
-##' @param tree_view tree view |
|
151 |
-##' @param node clade node |
|
152 |
-##' @param scale scale |
|
153 |
-##' @param vertical_only logical. If TRUE, only vertical will be scaled. |
|
154 |
-##' If FALSE, the clade will be scaled vertical and horizontally. |
|
155 |
-##' TRUE by default. |
|
156 |
-##' @return tree view |
|
157 |
-##' @export |
|
158 |
-##' @author Guangchuang Yu |
|
159 |
-scaleClade <- function(tree_view, node, scale=1, vertical_only=TRUE) { |
|
160 |
- if (scale == 1) { |
|
161 |
- return(tree_view) |
|
162 |
- } |
|
163 |
- |
|
164 |
- df <- tree_view$data |
|
165 |
- sp <- get.offspring.df(df, node) |
|
166 |
- sp.df <- df[sp,] |
|
167 |
- |
|
168 |
- ## sp_nr <- nrow(sp.df) |
|
169 |
- ## span <- diff(range(sp.df$y))/sp_nr |
|
170 |
- |
|
171 |
- ## new_span <- span * scale |
|
172 |
- old.sp.df <- sp.df |
|
173 |
- sp.df$y <- df[node, "y"] + (sp.df$y - df[node, "y"]) * scale |
|
174 |
- if (vertical_only == FALSE) { |
|
175 |
- sp.df$x <- df[node, "x"] + (sp.df$x - df[node, "x"]) * scale |
|
176 |
- } |
|
177 |
- |
|
178 |
- scale_diff.up <- max(sp.df$y) - max(old.sp.df$y) |
|
179 |
- scale_diff.lw <- min(sp.df$y) - min(old.sp.df$y) |
|
180 |
- |
|
181 |
- ii <- df$y > max(old.sp.df$y) |
|
182 |
- if (sum(ii) > 0) { |
|
183 |
- df[ii, "y"] <- df[ii, "y"] + scale_diff.up |
|
184 |
- } |
|
185 |
- |
|
186 |
- jj <- df$y < min(old.sp.df$y) |
|
187 |
- if (sum(jj) > 0) { |
|
188 |
- df[jj, "y"] <- df[jj, "y"] + scale_diff.lw |
|
189 |
- } |
|
190 |
- |
|
191 |
- df[sp,] <- sp.df |
|
192 |
- |
|
193 |
- if (! "scale" %in% colnames(df)) { |
|
194 |
- df$scale <- 1 |
|
195 |
- } |
|
196 |
- df[sp, "scale"] <- df[sp, "scale"] * scale |
|
197 |
- |
|
198 |
- ## re-calculate branch mid position |
|
199 |
- df <- calculate_branch_mid(df) |
|
200 |
- |
|
201 |
- tree_view$data <- df |
|
202 |
- tree_view |
|
203 |
-} |
|
204 |
- |
|
205 |
- |
|
206 |
-##' flip position of two selected branches |
|
207 |
-##' |
|
208 |
-##' |
|
209 |
-##' @title flip |
|
210 |
-##' @param tree_view tree view |
|
211 |
-##' @param node1 node number of branch 1 |
|
212 |
-##' @param node2 node number of branch 2 |
|
213 |
-##' @return ggplot2 object |
|
214 |
-##' @export |
|
215 |
-##' @author Guangchuang Yu |
|
216 |
-flip <- function(tree_view, node1, node2) { |
|
217 |
- df <- tree_view$data |
|
218 |
- p1 <- with(df, parent[node == node1]) |
|
219 |
- p2 <- with(df, parent[node == node2]) |
|
220 |
- |
|
221 |
- if (p1 != p2) { |
|
222 |
- stop("node1 and node2 should share a same parent node...") |
|
223 |
- } |
|
224 |
- |
|
225 |
- sp1 <- c(node1, get.offspring.df(df, node1)) |
|
226 |
- sp2 <- c(node2, get.offspring.df(df, node2)) |
|
227 |
- |
|
228 |
- sp1.df <- df[sp1,] |
|
229 |
- sp2.df <- df[sp2,] |
|
230 |
- |
|
231 |
- min_y1 <- min(sp1.df$y) |
|
232 |
- min_y2 <- min(sp2.df$y) |
|
233 |
- |
|
234 |
- if (min_y1 < min_y2) { |
|
235 |
- tmp <- sp1.df |
|
236 |
- sp1.df <- sp2.df |
|
237 |
- sp2.df <- tmp |
|
238 |
- tmp <- sp1 |
|
239 |
- sp1 <- sp2 |
|
240 |
- sp2 <- tmp |
|
241 |
- } |
|
242 |
- |
|
243 |
- min_y1 <- min(sp1.df$y) |
|
244 |
- min_y2 <- min(sp2.df$y) |
|
245 |
- |
|
246 |
- space <- min(sp1.df$y) - max(sp2.df$y) |
|
247 |
- sp1.df$y <- sp1.df$y - abs(min_y1 - min_y2) |
|
248 |
- sp2.df$y <- sp2.df$y + max(sp1.df$y) + space - min(sp2.df$y) |
|
249 |
- |
|
250 |
- df[sp1, "y"] <- sp1.df$y |
|
251 |
- df[sp2, "y"] <- sp2.df$y |
|
252 |
- |
|
253 |
- anc <- getAncestor.df(df, node1) |
|
254 |
- ii <- match(anc, df$node) |
|
255 |
- df[ii, "y"] <- NA |
|
256 |
- currentNode <- unlist(as.vector(sapply(anc, getChild.df, df=df))) |
|
257 |
- currentNode <- currentNode[!currentNode %in% anc] |
|
258 |
- |
|
259 |
- tree_view$data <- re_assign_ycoord_df(df, currentNode) |
|
260 |
- tree_view |
|
261 |
-} |
|
262 |
- |
|
263 |
-##' rotate 180 degree of a selected branch |
|
264 |
-##' |
|
265 |
-##' |
|
266 |
-##' @title rotate |
|
267 |
-##' @param tree_view tree view |
|
268 |
-##' @param node selected node |
|
269 |
-##' @return ggplot2 object |
|
270 |
-##' @export |
|
271 |
-##' @author Guangchuang Yu |
|
272 |
-rotate <- function(tree_view, node) { |
|
273 |
- df <- tree_view$data |
|
274 |
- sp <- get.offspring.df(df, node) |
|
275 |
- sp_idx <- with(df, match(sp, node)) |
|
276 |
- tip <- sp[df$isTip[sp_idx]] |
|
277 |
- sp.df <- df[sp_idx,] |
|
278 |
- ii <- with(sp.df, match(tip, node)) |
|
279 |
- jj <- ii[order(sp.df[ii, "y"])] |
|
280 |
- sp.df[jj,"y"] <- rev(sp.df[jj, "y"]) |
|
281 |
- sp.df[-jj, "y"] <- NA |
|
282 |
- sp.df <- re_assign_ycoord_df(sp.df, tip) |
|
283 | 146 |
|
284 |
- df[sp_idx, "y"] <- sp.df$y |
|
285 |
- df[df$node == node, "y"] <- mean(df[df$parent == node, "y"]) |
|
286 |
- pnode <- df$parent[df$node == node] |
|
287 |
- if (pnode != node && !is.na(pnode)) { |
|
288 |
- df[df$node == pnode, "y"] <- mean(df[df$parent == pnode, "y"]) |
|
289 |
- } |
|
290 |
- tree_view$data <- df |
|
291 |
- tree_view |
|
292 |
-} |
|
293 | 147 |
|
294 |
-re_assign_ycoord_df <- function(df, currentNode) { |
|
295 |
- while(any(is.na(df$y))) { |
|
296 |
- pNode <- with(df, parent[match(currentNode, node)]) %>% unique |
|
297 |
- idx <- sapply(pNode, function(i) with(df, all(node[parent == i & parent != node] %in% currentNode))) |
|
298 |
- newNode <- pNode[idx] |
|
299 |
- ## newNode <- newNode[is.na(df[match(newNode, df$node), "y"])] |
|
300 |
- |
|
301 |
- df[match(newNode, df$node), "y"] <- sapply(newNode, function(i) { |
|
302 |
- with(df, mean(y[parent == i], na.rm = TRUE)) |
|
303 |
- }) |
|
304 |
- traced_node <- as.vector(sapply(newNode, function(i) with(df, node[parent == i]))) |
|
305 |
- currentNode <- c(currentNode[! currentNode %in% traced_node], newNode) |
|
306 |
- } |
|
307 |
- return(df) |
|
308 |
-} |
|
309 |
- |
|
310 |
-##' collapse a clade |
|
311 |
-##' |
|
312 |
-##' |
|
313 |
-##' @title collapse |
|
314 |
-##' @param tree_view tree view |
|
315 |
-##' @param node clade node |
|
316 |
-##' @return tree view |
|
317 |
-##' @export |
|
318 |
-##' @seealso expand |
|
319 |
-##' @author Guangchuang Yu |
|
320 |
-collapse <- function(tree_view, node) { |
|
321 |
- df <- tree_view$data |
|
322 |
- sp <- get.offspring.df(df, node) |
|
323 |
- sp.df <- df[sp,] |
|
324 |
- df[node, "isTip"] <- TRUE |
|
325 |
- sp_y <- range(sp.df$y) |
|
326 |
- ii <- which(df$y > max(sp_y)) |
|
327 |
- if (length(ii)) { |
|
328 |
- df$y[ii] <- df$y[ii] - diff(sp_y) |
|
329 |
- } |
|
330 |
- df$y[node] <- min(sp_y) |
|
331 |
- |
|
332 |
- df[sp, "x"] <- NA |
|
333 |
- df[sp, "y"] <- NA |
|
334 |
- |
|
335 |
- root <- which(df$node == df$parent) |
|
336 |
- pp <- df[node, "parent"] |
|
337 |
- while(any(pp != root)) { |
|
338 |
- df[pp, "y"] <- mean(df[getChild.df(df, pp), "y"]) |
|
339 |
- pp <- df[pp, "parent"] |
|
340 |
- } |
|
341 |
- j <- getChild.df(df, pp) |
|
342 |
- j <- j[j!=pp] |
|
343 |
- df[pp, "y"] <- mean(df[j, "y"]) |
|
344 |
- |
|
345 |
- ## re-calculate branch mid position |
|
346 |
- df <- calculate_branch_mid(df) |
|
347 |
- |
|
348 |
- tree_view$data <- df |
|
349 |
- clade <- paste0("clade_", node) |
|
350 |
- attr(tree_view, clade) <- sp.df |
|
351 |
- tree_view |
|
352 |
-} |
|
353 |
- |
|
354 |
-##' expand collased clade |
|
355 |
-##' |
|
356 |
-##' |
|
357 |
-##' @title expand |
|
358 |
-##' @param tree_view tree view |
|
359 |
-##' @param node clade node |
|
360 |
-##' @return tree view |
|
361 |
-##' @export |
|
362 |
-##' @seealso collapse |
|
363 |
-##' @author Guangchuang Yu |
|
364 |
-expand <- function(tree_view, node) { |
|
365 |
- clade <- paste0("clade_", node) |
|
366 |
- sp.df <- attr(tree_view, clade) |
|
367 |
- if (is.null(sp.df)) { |
|
368 |
- return(tree_view) |
|
369 |
- } |
|
370 |
- df <- tree_view$data |
|
371 |
- df[node, "isTip"] <- FALSE |
|
372 |
- sp_y <- range(sp.df$y) |
|
373 |
- ii <- which(df$y > df$y[node]) |
|
374 |
- df[ii, "y"] <- df[ii, "y"] + diff(sp_y) |
|
375 |
- |
|
376 |
- sp.df$y <- sp.df$y - min(sp.df$y) + df$y[node] |
|
377 |
- df[sp.df$node,] <- sp.df |
|
378 |
- |
|
379 |
- root <- which(df$node == df$parent) |
|
380 |
- pp <- node |
|
381 |
- while(any(pp != root)) { |
|
382 |
- df[pp, "y"] <- mean(df[getChild.df(df, pp), "y"]) |
|
383 |
- pp <- df[pp, "parent"] |
|
384 |
- } |
|
385 |
- j <- getChild.df(df, pp) |
|
386 |
- j <- j[j!=pp] |
|
387 |
- df[pp, "y"] <- mean(df[j, "y"]) |
|
388 |
- |
|
389 |
- ## re-calculate branch mid position |
|
390 |
- df <- calculate_branch_mid(df) |
|
391 |
- |
|
392 |
- tree_view$data <- df |
|
393 |
- attr(tree_view, clade) <- NULL |
|
394 |
- tree_view |
|
395 |
-} |
|
396 | 148 |
|
397 | 149 |
##' add colorbar legend |
398 | 150 |
##' |
... | ... |
@@ -460,23 +212,6 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) { |
460 | 212 |
} |
461 | 213 |
|
462 | 214 |
|
463 |
-##' get taxa name of a selected node |
|
464 |
-##' |
|
465 |
-##' |
|
466 |
-##' @title get_taxa_name |
|
467 |
-##' @param tree_view tree view |
|
468 |
-##' @param node node |
|
469 |
-##' @return taxa name vector |
|
470 |
-##' @export |
|
471 |
-##' @author Guangchuang Yu |
|
472 |
-get_taxa_name <- function(tree_view, node) { |
|
473 |
- df <- tree_view$data |
|
474 |
- sp <- get.offspring.df(df, node) |
|
475 |
- res <- df[sp, "label"] |
|
476 |
- return(res[df[sp, "isTip"]]) |
|
477 |
-} |
|
478 |
- |
|
479 |
- |
|
480 | 215 |
|
481 | 216 |
|
482 | 217 |
|
... | ... |
@@ -213,7 +213,7 @@ msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL){ |
213 | 213 |
##' |
214 | 214 |
##' |
215 | 215 |
##' @title scale_x_ggtree |
216 |
-##' @param p tree view |
|
216 |
+##' @param tree_view tree view |
|
217 | 217 |
##' @param breaks breaks for tree |
218 | 218 |
##' @param labels lables for corresponding breaks |
219 | 219 |
##' @return tree view |
... | ... |
@@ -221,7 +221,9 @@ msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL){ |
221 | 221 |
##' @importFrom ggplot2 scale_x_date |
222 | 222 |
##' @export |
223 | 223 |
##' @author Guangchuang Yu |
224 |
-scale_x_ggtree <- function(p, breaks=NULL, labels=NULL) { |
|
224 |
+scale_x_ggtree <- function(tree_view, breaks=NULL, labels=NULL) { |
|
225 |
+ p <- get_tree_view(tree_view) |
|
226 |
+ |
|
225 | 227 |
mrsd <- attr(p, "mrsd") |
226 | 228 |
if (!is.null(mrsd) && class(p$data$x) == "Date") { |
227 | 229 |
x <- Date2decimal(p$data$x) |
228 | 230 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,19 @@ |
1 |
+`%add%` <- function(p, data) { |
|
2 |
+ p$data <- p$data %add2% data |
|
3 |
+ return(p) |
|
4 |
+} |
|
5 |
+ |
|
6 |
+`%add2%` <- function(d1, d2) { |
|
7 |
+ if ("node" %in% colnames(d2)) { |
|
8 |
+ cn <- colnames(d2) |
|
9 |
+ ii <- which(cn %in% c("node", cn[!cn %in% colnames(d1)])) |
|
10 |
+ d2 <- d2[, ii] |
|
11 |
+ dd <- merge(d1, d2, by.x="node", by.y="node", all.x=TRUE) |
|
12 |
+ } else { |
|
13 |
+ d2[,1] <- as.character(d2[,1]) |
|
14 |
+ dd <- merge(d1, d2, by.x="label", by.y=1, all.x=TRUE) |
|
15 |
+ } |
|
16 |
+ dd <- dd[match(d1$node, dd$node),] |
|
17 |
+ return(dd) |
|
18 |
+} |
|
19 |
+ |
... | ... |
@@ -870,3 +870,20 @@ set_branch_length <- function(tree_object, branch.length) { |
870 | 870 |
return(phylo) |
871 | 871 |
} |
872 | 872 |
|
873 |
+ |
|
874 |
+re_assign_ycoord_df <- function(df, currentNode) { |
|
875 |
+ while(any(is.na(df$y))) { |
|
876 |
+ pNode <- with(df, parent[match(currentNode, node)]) %>% unique |
|
877 |
+ idx <- sapply(pNode, function(i) with(df, all(node[parent == i & parent != node] %in% currentNode))) |
|
878 |
+ newNode <- pNode[idx] |
|
879 |
+ ## newNode <- newNode[is.na(df[match(newNode, df$node), "y"])] |
|
880 |
+ |
|
881 |
+ df[match(newNode, df$node), "y"] <- sapply(newNode, function(i) { |
|
882 |
+ with(df, mean(y[parent == i], na.rm = TRUE)) |
|
883 |
+ }) |
|
884 |
+ traced_node <- as.vector(sapply(newNode, function(i) with(df, node[parent == i]))) |
|
885 |
+ currentNode <- c(currentNode[! currentNode %in% traced_node], newNode) |
|
886 |
+ } |
|
887 |
+ return(df) |
|
888 |
+} |
|
889 |
+ |
... | ... |
@@ -1,3 +1,11 @@ |
1 |
+get_tree_view <- function(tree_view) { |
|
2 |
+ if (is.null(tree_view)) |
|
3 |
+ tree_view <- last_plot() |
|
4 |
+ |
|
5 |
+ return(tree_view) |
|
6 |
+} |
|
7 |
+ |
|
8 |
+ |
|
1 | 9 |
has.slot <- function(object, slotName) { |
2 | 10 |
if (!isS4(object)) { |
3 | 11 |
return(FALSE) |
... | ... |
@@ -407,23 +415,6 @@ is.tree_attribute_ <- function(p, var) { |
407 | 415 |
} |
408 | 416 |
|
409 | 417 |
|
410 |
-`%add%` <- function(p, data) { |
|
411 |
- p$data <- p$data %add2% data |
|
412 |
- return(p) |
|
413 |
-} |
|
414 |
- |
|
415 |
-`%add2%` <- function(d1, d2) { |
|
416 |
- if ("node" %in% colnames(d2)) { |
|
417 |
- d2 <- d2[,-1] ## drop label column |
|
418 |
- dd <- merge(d1, d2, by.x="node", by.y="node", all.x=TRUE) |
|
419 |
- } else { |
|
420 |
- d2[,1] <- as.character(d2[,1]) |
|
421 |
- dd <- merge(d1, d2, by.x="label", by.y=1, all.x=TRUE) |
|
422 |
- } |
|
423 |
- dd <- dd[match(d1$node, dd$node),] |
|
424 |
- return(dd) |
|
425 |
-} |
|
426 |
- |
|
427 | 418 |
`%place%` <- function(pg, tree) { |
428 | 419 |
param <- attr(pg, "param") |
429 | 420 |
pg$data <- fortify(tree, |
430 | 421 |
deleted file mode 100644 |
... | ... |
@@ -1,13 +0,0 @@ |
1 |
-##' view a clade of tree |
|
2 |
-##' |
|
3 |
-##' |
|
4 |
-##' @title viewClade |
|
5 |
-##' @param tree_view full tree view |
|
6 |
-##' @param node internal node number |
|
7 |
-##' @return clade plot |
|
8 |
-##' @export |
|
9 |
-##' @author Guangchuang Yu |
|
10 |
-viewClade <- function(tree_view, node) { |
|
11 |
- cpos <- get_clade_position(tree_view, node=node) |
|
12 |
- with(cpos, p+xlim(xmin, xmax*1.01)+ylim(ymin, ymax)) |
|
13 |
-} |
... | ... |
@@ -1,10 +1,10 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/ggtree.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{collapse} |
4 | 4 |
\alias{collapse} |
5 | 5 |
\title{collapse} |
6 | 6 |
\usage{ |
7 |
-collapse(tree_view, node) |
|
7 |
+collapse(tree_view = NULL, node) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{tree view} |
... | ... |
@@ -1,10 +1,10 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/ggtree.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{expand} |
4 | 4 |
\alias{expand} |
5 | 5 |
\title{expand} |
6 | 6 |
\usage{ |
7 |
-expand(tree_view, node) |
|
7 |
+expand(tree_view = NULL, node) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{tree view} |
... | ... |
@@ -1,10 +1,10 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/ggtree.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{flip} |
4 | 4 |
\alias{flip} |
5 | 5 |
\title{flip} |
6 | 6 |
\usage{ |
7 |
-flip(tree_view, node1, node2) |
|
7 |
+flip(tree_view = NULL, node1, node2) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{tree view} |
... | ... |
@@ -1,10 +1,10 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/ggtree.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{get_taxa_name} |
4 | 4 |
\alias{get_taxa_name} |
5 | 5 |
\title{get_taxa_name} |
6 | 6 |
\usage{ |
7 |
-get_taxa_name(tree_view, node) |
|
7 |
+get_taxa_name(tree_view = NULL, node) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{tree view} |
... | ... |
@@ -1,10 +1,10 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/ggtree.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{rotate} |
4 | 4 |
\alias{rotate} |
5 | 5 |
\title{rotate} |
6 | 6 |
\usage{ |
7 |
-rotate(tree_view, node) |
|
7 |
+rotate(tree_view = NULL, node) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{tree view} |
... | ... |
@@ -1,10 +1,10 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/ggtree.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{scaleClade} |
4 | 4 |
\alias{scaleClade} |
5 | 5 |
\title{scaleClade} |
6 | 6 |
\usage{ |
7 |
-scaleClade(tree_view, node, scale = 1, vertical_only = TRUE) |
|
7 |
+scaleClade(tree_view = NULL, node, scale = 1, vertical_only = TRUE) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{tree view} |
... | ... |
@@ -4,10 +4,10 @@ |
4 | 4 |
\alias{scale_x_ggtree} |
5 | 5 |
\title{scale_x_ggtree} |
6 | 6 |
\usage{ |
7 |
-scale_x_ggtree(p, breaks = NULL, labels = NULL) |
|
7 |
+scale_x_ggtree(tree_view, breaks = NULL, labels = NULL) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 |
-\item{p}{tree view} |
|
10 |
+\item{tree_view}{tree view} |
|
11 | 11 |
|
12 | 12 |
\item{breaks}{breaks for tree} |
13 | 13 |
|
... | ... |
@@ -1,15 +1,17 @@ |
1 | 1 |
% Generated by roxygen2: do not edit by hand |
2 |
-% Please edit documentation in R/viewClade.R |
|
2 |
+% Please edit documentation in R/clade-functions.R |
|
3 | 3 |
\name{viewClade} |
4 | 4 |
\alias{viewClade} |
5 | 5 |
\title{viewClade} |
6 | 6 |
\usage{ |
7 |
-viewClade(tree_view, node) |
|
7 |
+viewClade(tree_view = NULL, node, xmax_adjust = 0) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{tree_view}{full tree view} |
11 | 11 |
|
12 | 12 |
\item{node}{internal node number} |
13 |
+ |
|
14 |
+\item{xmax_adjust}{adjust xmax} |
|
13 | 15 |
} |
14 | 16 |
\value{ |
15 | 17 |
clade plot |
... | ... |
@@ -109,6 +109,9 @@ The _`groupOTU`_ method is used for clustering related OTUs (from tips to their |
109 | 109 |
|
110 | 110 |
The _`fortify`_ method is used to convert tree object to a `data.frame` which is familiar by `R` users and easy to manipulate. The output `data.frame` contains tree information and all evolutionary evidences (if available, e.g. _*dN/dS*_ in `codeml` object). |
111 | 111 |
|
112 |
+Detail descriptions of `slots` defined in each class are documented in class man pages. Users can use `class?className` (e.g. `class?beast`) to access man page of a class. |
|
113 |
+ |
|
114 |
+ |
|
112 | 115 |
# Getting Tree Data into R |
113 | 116 |
|
114 | 117 |
## Parsing BEAST output |
... | ... |
@@ -56,6 +56,15 @@ p <- ggtree(tree) |
56 | 56 |
MRCA(p, tip=c('A', 'E')) |
57 | 57 |
``` |
58 | 58 |
|
59 |
+# view Clade |
|
60 |
+ |
|
61 |
+`ggtree` provides a function `viewClade` to visualize a clade of a phylogenetic tree. |
|
62 |
+ |
|
63 |
+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE} |
|
64 |
+viewClade(p+geom_tiplab(), node=21) |
|
65 |
+``` |
|
66 |
+ |
|
67 |
+ |
|
59 | 68 |
# group Clades |
60 | 69 |
|
61 | 70 |
The `ggtree` package defined several functions to manipulate tree view. _`groupClade`_ and _`groupOTU`_ methods for clustering clades or related OTUs. _`groupClade`_ accepts an internal node or a vector of internal nodes to cluster clade/clades. |