Browse code

viewClade, scaleClade, collapse, expand, rotate, flip, get_taxa_name and scale_x_ggtree accepts input tree_view=NULL.

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@112503 bc3139a8-67e5-0310-9ffc-ced21a209358

g.yu authored on 13/01/2016 07:47:55
Showing 18 changed files

... ...
@@ -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.