Browse code

flip and rotate

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

g.yu authored on 19/07/2015 12:49:14
Showing 11 changed files

... ...
@@ -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.1.8
4
+Version: 1.1.9
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
... ...
@@ -33,4 +33,5 @@ License: Artistic-2.0
33 33
 URL: https://github.com/GuangchuangYu/ggtree
34 34
 BugReports: https://github.com/GuangchuangYu/ggtree/issues
35 35
 Packaged: 2014-12-03 08:16:14 UTC; root
36
-biocViews: Software, Annotation, Clustering, DataImport, Visualization 
36
+biocViews: Alignment, Annotation, Clustering, DataImport, MultipleSequenceAlignment,
37
+	   ReproducibleResearch, Software, Visualization 
... ...
@@ -21,6 +21,7 @@ export(as.binary)
21 21
 export(collapse)
22 22
 export(download.phylopic)
23 23
 export(expand)
24
+export(flip)
24 25
 export(geom_aline)
25 26
 export(geom_hilight)
26 27
 export(geom_text)
... ...
@@ -39,6 +40,7 @@ export(get.treeinfo)
39 40
 export(get.treetext)
40 41
 export(getNodeNum)
41 42
 export(getRoot)
43
+export(get_taxa_name)
42 44
 export(ggplotGrob)
43 45
 export(ggtree)
44 46
 export(gheatmap)
... ...
@@ -60,6 +62,7 @@ export(read.hyphy)
60 62
 export(read.jplace)
61 63
 export(read.paml_rst)
62 64
 export(read.tree)
65
+export(rotate)
63 66
 export(rtree)
64 67
 export(scaleClade)
65 68
 export(scale_color)
... ...
@@ -1,3 +1,12 @@
1
+CHANGES IN VERSION 1.1.9
2
+------------------------
3
+ o update add_legend to align legend text <2015-07-06, Mon>
4
+ o bug fixed in internal function, getChild.df, which should not include root node if selected node is root <2015-07-01, Wed>
5
+ o rotate function for ratating a clade by 180 degree and update vignette <2015-07-01, Wed>
6
+ o get_taxa_name function will return taxa name vector of a selected clade <2015-06-30, Tue>
7
+ o add example of flip function in vignette <2015-06-30, Tue>
8
+ o flip function for exchanging positions of two selected branches <2015-06-30, Tue>
9
+ 
1 10
 CHANGES IN VERSION 1.1.8
2 11
 ------------------------
3 12
  o update get.placement <2015-06-05, Fri>
... ...
@@ -355,6 +355,110 @@ scaleClade <- function(tree_view, node, scale=1, vertical_only=TRUE) {
355 355
 }
356 356
 
357 357
 
358
+##' flip position of two selected branches
359
+##'
360
+##' 
361
+##' @title flip
362
+##' @param tree_view tree view 
363
+##' @param node1 node number of branch 1
364
+##' @param node2 node number of branch 2
365
+##' @return ggplot2 object
366
+##' @export
367
+##' @author Guangchuang Yu
368
+flip <- function(tree_view, node1, node2) {
369
+    df <- tree_view$data
370
+    p1 <- with(df, parent[node == node1])
371
+    p2 <- with(df, parent[node == node2])
372
+
373
+    if (p1 != p2) {
374
+        stop("node1 and node2 should share a same parent node...")
375
+    }
376
+
377
+    sp1 <- c(node1, get.offspring.df(df, node1))
378
+    sp2 <- c(node2, get.offspring.df(df, node2))
379
+
380
+    sp1.df <- df[sp1,]
381
+    sp2.df <- df[sp2,]
382
+
383
+    min_y1 <- min(sp1.df$y)
384
+    min_y2 <- min(sp2.df$y)
385
+
386
+    if (min_y1 < min_y2) {
387
+        tmp <- sp1.df
388
+        sp1.df <- sp2.df
389
+        sp2.df <- tmp
390
+        tmp <- sp1
391
+        sp1 <- sp2
392
+        sp2 <- tmp
393
+    }
394
+
395
+    min_y1 <- min(sp1.df$y)
396
+    min_y2 <- min(sp2.df$y)
397
+
398
+    space <- min(sp1.df$y) - max(sp2.df$y)
399
+    sp1.df$y <- sp1.df$y - abs(min_y1 - min_y2)
400
+    sp2.df$y <- sp2.df$y + max(sp1.df$y) + space - min(sp2.df$y)
401
+
402
+    df[sp1, "y"] <- sp1.df$y
403
+    df[sp2, "y"] <- sp2.df$y
404
+
405
+    anc <- getAncestor.df(df, node1)
406
+    ii <- match(anc, df$node)
407
+    df[ii, "y"] <- NA
408
+    currentNode <- as.vector(sapply(anc, getChild.df, df=df))
409
+    currentNode <- currentNode[!currentNode %in% anc]
410
+    
411
+    tree_view$data <- re_assign_ycoord_df(df, currentNode)
412
+    tree_view
413
+}
414
+
415
+##' rotate 180 degree of a selected branch
416
+##'
417
+##' 
418
+##' @title rotate
419
+##' @param tree_view tree view 
420
+##' @param node selected node
421
+##' @return ggplot2 object
422
+##' @export
423
+##' @author Guangchuang Yu
424
+rotate <- function(tree_view, node) {
425
+    df <- tree_view$data
426
+    sp <- get.offspring.df(df, node)
427
+    sp_idx <- with(df, match(sp, node))
428
+    tip <- sp[df$isTip[sp_idx]]
429
+    sp.df <- df[sp_idx,]
430
+    ii <- with(sp.df, match(tip, node))
431
+    jj <- ii[order(sp.df[ii, "y"])]
432
+    sp.df[jj,"y"] <- rev(sp.df[jj, "y"])
433
+    sp.df[-jj, "y"] <- NA
434
+    sp.df <- re_assign_ycoord_df(sp.df, tip)
435
+
436
+    df[sp_idx, "y"] <- sp.df$y
437
+    df[df$node == node, "y"] <- mean(df[df$parent == node, "y"])
438
+    pnode <- df$parent[df$node == node]
439
+    if (pnode != node && !is.na(pnode)) {
440
+        df[df$node == pnode, "y"] <- mean(df[df$parent == pnode, "y"])
441
+    }
442
+    tree_view$data <- df
443
+    tree_view
444
+}
445
+
446
+re_assign_ycoord_df <- function(df, currentNode) {
447
+    while(any(is.na(df$y))) {
448
+        pNode <- with(df, parent[match(currentNode, node)]) %>% unique
449
+        idx <- sapply(pNode, function(i) with(df, all(node[parent == i & parent != node] %in% currentNode)))
450
+        newNode <- pNode[idx]
451
+        ## newNode <- newNode[is.na(df[match(newNode, df$node), "y"])]
452
+        
453
+        df[match(newNode, df$node), "y"] <- sapply(newNode, function(i) {
454
+            with(df, mean(y[parent == i], na.rm = TRUE))
455
+        })
456
+        traced_node <- as.vector(sapply(newNode, function(i) with(df, node[parent == i])))
457
+        currentNode <- c(currentNode[! currentNode %in% traced_node], newNode)
458
+    }
459
+    return(df)
460
+}
461
+
358 462
 ##' collapse a clade
359 463
 ##'
360 464
 ##' 
... ...
@@ -490,7 +594,7 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) {
490 594
     offset <- diff(range(p$data$x))/40
491 595
     barwidth <- offset/5
492 596
     
493
-    p + annotate("text", x=x+offset*2, y=y[i], label=legend[i,1], size=font.size) +
597
+    p + annotate("text", x=x+offset*1.5, y=y[i], label=legend[i,1], size=font.size, hjust=0) +
494 598
         annotate("rect", xmin=x, xmax=x+offset, ymin=ymin,
495 599
                  ymax = ymax, fill=legend[,2], color=legend[,2]) +
496 600
                      annotate("segment", x=x, xend=x+barwidth, y=y[i], yend=y[i], color="white") +
... ...
@@ -537,3 +641,19 @@ add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
537 641
                 geom_segment(x=x+d, y=y-offset/2, xend=x+d, yend=y+offset/2, ...)
538 642
     return(p)
539 643
 }
644
+
645
+##' get taxa name of a selected node
646
+##'
647
+##' 
648
+##' @title get_taxa_name
649
+##' @param tree_view tree view
650
+##' @param node node
651
+##' @return taxa name vector
652
+##' @export
653
+##' @author Guangchuang Yu
654
+get_taxa_name <- function(tree_view, node) {
655
+    df <- tree_view$data
656
+    sp <- get.offspring.df(df, node)
657
+    res <- df[sp, "label"]
658
+    return(res[df[sp, "isTip"]])
659
+}
... ...
@@ -234,13 +234,39 @@ layout.unrooted <- function(tree) {
234 234
     return(df)
235 235
 }
236 236
 
237
+getParent.df <- function(df, node) {
238
+    i <- which(df$node == node)
239
+    res <- df$parent[i]
240
+    if (res == node) {
241
+        ## root node
242
+        return(0) 
243
+    }
244
+    return(res)
245
+}
246
+
247
+getAncestor.df <- function(df, node) {
248
+    anc <- getParent.df(df, node)
249
+    anc <- anc[anc != 0]
250
+    if (length(anc) == 0) {
251
+        stop("selected node is root...")
252
+    }
253
+    i <- 1
254
+    while(i<= length(anc)) {
255
+        anc <- c(anc, getParent.df(df, anc[i]))
256
+        anc <- anc[anc != 0]
257
+        i <- i+1
258
+    }
259
+    return(anc)
260
+}
261
+
262
+
237 263
 getChild.df <- function(df, node) {
238 264
     i <- which(df$parent == node)
239 265
     if (length(i) == 0) {
240 266
         return(0)
241 267
     }
242
-    
243 268
     res <- df[i, "node"]
269
+    res <- res[res != node] ## node may root
244 270
     return(res)
245 271
 }
246 272
 
... ...
@@ -532,4 +532,3 @@ as.data.frame.phylo_ <- function(x, layout="phylogram",
532 532
     return(res)
533 533
 }
534 534
 
535
-
536 535
new file mode 100644
... ...
@@ -0,0 +1,25 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/ggtree.R
3
+\name{flip}
4
+\alias{flip}
5
+\title{flip}
6
+\usage{
7
+flip(tree_view, node1, node2)
8
+}
9
+\arguments{
10
+\item{tree_view}{tree view}
11
+
12
+\item{node1}{node number of branch 1}
13
+
14
+\item{node2}{node number of branch 2}
15
+}
16
+\value{
17
+ggplot2 object
18
+}
19
+\description{
20
+flip position of two selected branches
21
+}
22
+\author{
23
+Guangchuang Yu
24
+}
25
+
0 26
new file mode 100644
... ...
@@ -0,0 +1,23 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/ggtree.R
3
+\name{get_taxa_name}
4
+\alias{get_taxa_name}
5
+\title{get_taxa_name}
6
+\usage{
7
+get_taxa_name(tree_view, node)
8
+}
9
+\arguments{
10
+\item{tree_view}{tree view}
11
+
12
+\item{node}{node}
13
+}
14
+\value{
15
+taxa name vector
16
+}
17
+\description{
18
+get taxa name of a selected node
19
+}
20
+\author{
21
+Guangchuang Yu
22
+}
23
+
0 24
new file mode 100644
... ...
@@ -0,0 +1,23 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/ggtree.R
3
+\name{rotate}
4
+\alias{rotate}
5
+\title{rotate}
6
+\usage{
7
+rotate(tree_view, node)
8
+}
9
+\arguments{
10
+\item{tree_view}{tree view}
11
+
12
+\item{node}{selected node}
13
+}
14
+\value{
15
+ggplot2 object
16
+}
17
+\description{
18
+rotate 180 degree of a selected branch
19
+}
20
+\author{
21
+Guangchuang Yu
22
+}
23
+
... ...
@@ -16,3 +16,10 @@ bt <- as.binary(polytomy)
16 16
 test_that("convert polytomy to binary tree", {
17 17
     expect_equal(is.binary.tree(bt), TRUE)
18 18
 })
19
+
20
+df <- ggtree:::fortify.phylo(rtree(10))
21
+child <- ggtree:::getChild.df(df, 11)
22
+test_that("root node should not be included in its ancestor node list", {
23
+    expect_equal(11 %in% child, FALSE)
24
+})
25
+
... ...
@@ -579,6 +579,30 @@ The collapsed clade can be expanded via _`expand`_ function.
579 579
 cp %>% expand(node=21)
580 580
 ```
581 581
 
582
+## flip clades
583
+
584
+The positions of two selected branches can be flip over using __*flip*__ function.
585
+
586
+```{r fig.width=20, fig.height=7, warning=FALSE}
587
+set.seed(2015-06-30)
588
+p1 <- ggtree(rtree(30)) + geom_text(aes(label=node))
589
+p2 <- flip(p1, node1=45, node2=33)
590
+p3 <- flip(p2, 32, 58)
591
+grid.arrange(p1, p2, p3, ncol=3)
592
+```
593
+
594
+## rotate clade
595
+
596
+A selected clade can be rotated by 180 degree using __*rotate*__ function.
597
+
598
+```{r fig.width=16, fig.height=8, warning=FALSE}
599
+set.seed(2015-07-01)
600
+p1 <- ggtree(rtree(30)) + geom_text(aes(label=node))
601
+p1 <- hilight(p1, 33)
602
+p2 <- rotate(p1, 33)
603
+grid.arrange(p1, p2, ncol=2)
604
+```
605
+
582 606
 ## phylopic
583 607
 
584 608
 [PhyloPic](http://phylopic.org/) is a database that stores reusable silhouette images of organisms. `r Githubpkg("GuangchuangYu/ggtree")` supports downloading images from [PhyloPic](http://phylopic.org/) and annotating phylogenetic tree with the downloaded images.
... ...
@@ -788,6 +812,7 @@ A specific slice of the alignment can also be displayed by specific _window_ par
788 812
 + [viewing and annotating phylogenetic tree with ggtree](http://ygc.name/2014/12/21/ggtree/)
789 813
 + [updating a tree view using %<% operator](http://ygc.name/2015/02/10/ggtree-updating-a-tree-view/)
790 814
 + [an example of drawing beast tree using ggtree](http://ygc.name/2015/04/01/an-example-of-drawing-beast-tree-using-ggtree/)
815
++ [flip and rotate branches in ggtree](http://ygc.name/2015/07/01/flip-and-rotate-branches-in-ggtree/)
791 816
 
792 817
 # Bugs/Feature requests
793 818