Browse code

Commit made by the Bioconductor Git-SVN bridge.

Commit id: d69c9b83a09656294071e778f7e2248bd05b5e9b

scaleClade function to zoom in/out selected clade(s)



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

g.yu authored on 13/05/2015 04:05:11
Showing 8 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.4
4
+Version: 1.1.5
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
... ...
@@ -57,6 +57,7 @@ export(read.jplace)
57 57
 export(read.paml_rst)
58 58
 export(read.tree)
59 59
 export(rtree)
60
+export(scaleClade)
60 61
 export(scale_color)
61 62
 export(theme_tree)
62 63
 export(theme_tree2)
... ...
@@ -1,3 +1,7 @@
1
+CHANGES IN VERSION 1.1.5
2
+------------------------
3
+ o implement scaleClade <2015-05-12, Tue>
4
+ 
1 5
 CHANGES IN VERSION 1.1.4
2 6
 ------------------------
3 7
  o better performance of parsing beast tree  <2015-05-11, Mon>
... ...
@@ -295,6 +295,61 @@ hilight <- function(tree_view, node, fill="steelblue", alpha=0.5, ...) {
295 295
                          fill = fill, alpha = alpha, ...)
296 296
 }
297 297
 
298
+##' scale clade
299
+##'
300
+##' 
301
+##' @title scaleClade
302
+##' @param tree_view tree view
303
+##' @param node clade node
304
+##' @param scale scale
305
+##' @return tree view
306
+##' @export
307
+##' @author Guangchuang Yu
308
+scaleClade <- function(tree_view, node, scale=1) {
309
+    if (scale == 1) {
310
+        return(tree_view)
311
+    }
312
+    
313
+    df <- tree_view$data
314
+    sp <- get.offspring.df(df, node)
315
+    sp.df <- df[sp,]
316
+    
317
+    ## sp_nr <- nrow(sp.df)
318
+    ## span <- diff(range(sp.df$y))/sp_nr
319
+    
320
+    ## new_span <- span * scale
321
+    old.sp.df <- sp.df
322
+    sp.df$y <- df[node, "y"] + (sp.df$y - df[node, "y"]) * scale
323
+    sp.df$x <- df[node, "x"] + (sp.df$x - df[node, "x"]) * scale
324
+
325
+    scale_diff.up <- max(sp.df$y) - max(old.sp.df$y)
326
+    scale_diff.lw <- min(sp.df$y) - min(old.sp.df$y)
327
+    
328
+    ii <- df$y > max(old.sp.df$y)
329
+    if (sum(ii) > 0) {
330
+        df[ii, "y"] <- df[ii, "y"] + scale_diff.up
331
+    }
332
+    
333
+    jj <- df$y < min(old.sp.df$y)
334
+    if (sum(jj) > 0) {
335
+        df[jj, "y"] <- df[jj, "y"] + scale_diff.lw
336
+    }
337
+    
338
+    df[sp,] <- sp.df
339
+    
340
+    if (! "scale" %in% colnames(df)) {
341
+        df$scale <- 1
342
+    }
343
+    df[sp, "scale"] <- df[sp, "scale"] * scale
344
+
345
+    ## re-calculate branch mid position
346
+    df <- calculate_branch_mid(df)
347
+    
348
+    tree_view$data <- df
349
+    tree_view
350
+}
351
+
352
+
298 353
 ##' collapse a clade
299 354
 ##'
300 355
 ##' 
... ...
@@ -329,6 +384,9 @@ collapse <- function(tree_view, node) {
329 384
     j <- getChild.df(df, pp)
330 385
     j <- j[j!=pp]
331 386
     df[pp, "y"] <- mean(df[j, "y"])
387
+
388
+    ## re-calculate branch mid position
389
+    df <- calculate_branch_mid(df)
332 390
     
333 391
     tree_view$data <- df
334 392
     clade <- paste0("clade_", node)
... ...
@@ -370,6 +428,9 @@ expand <- function(tree_view, node) {
370 428
     j <- getChild.df(df, pp)
371 429
     j <- j[j!=pp]
372 430
     df[pp, "y"] <- mean(df[j, "y"])
431
+
432
+    ## re-calculate branch mid position
433
+    df <- calculate_branch_mid(df)
373 434
     
374 435
     tree_view$data <- df
375 436
     attr(tree_view, clade) <- NULL
... ...
@@ -800,3 +800,11 @@ add_angle_cladogram <- function(res) {
800 800
     return(res)
801 801
 }
802 802
 
803
+calculate_branch_mid <- function(res) {
804
+    res$branch <- (res[res$parent, "x"] + res[, "x"])/2
805
+    if (!is.null(res$length)) {
806
+        res$length[is.na(res$length)] <- 0
807
+    }
808
+    res$branch[is.na(res$branch)] <- 0
809
+    return(res)
810
+}
... ...
@@ -518,11 +518,9 @@ as.data.frame.phylo_ <- function(x, layout="phylogram",
518 518
     isTip <- rep(FALSE, N)
519 519
     isTip[1:Ntip] <- TRUE
520 520
     res$isTip <- isTip
521
-    res$branch <- (res[res$parent, "x"] + res[, "x"])/2
522
-    if (!is.null(res$length)) {
523
-        res$length[is.na(res$length)] <- 0
524
-    }
525
-    res$branch[is.na(res$branch)] <- 0
521
+
522
+    ## add branch mid position
523
+    res <- calculate_branch_mid(res)
526 524
     
527 525
     if (layout == "fan") {
528 526
         idx <- match(1:N, order(res$y))
529 527
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{scaleClade}
4
+\alias{scaleClade}
5
+\title{scaleClade}
6
+\usage{
7
+scaleClade(tree_view, node, scale = 1)
8
+}
9
+\arguments{
10
+\item{tree_view}{tree view}
11
+
12
+\item{node}{clade node}
13
+
14
+\item{scale}{scale}
15
+}
16
+\value{
17
+tree view
18
+}
19
+\description{
20
+scale clade
21
+}
22
+\author{
23
+Guangchuang Yu
24
+}
25
+
... ...
@@ -717,6 +717,25 @@ lty <- c("solid", "dashed", "dotted")[idx]
717 717
 ggtree(tree, color=cols, linetype=lty)
718 718
 ```
719 719
 
720
+## scale clade
721
+In __[`collapse clade`](#collapse-clade)__, we have illustrated how to collapse selected clades. Another approach is to zoom out clade to a small scale.
722
+
723
+```{r fig.width=12, fig.height=6, warning=F}
724
+grid.arrange(ggtree(tree) %>% hilight(21, "steelblue"),
725
+             ggtree(tree) %>% scaleClade(21, scale=0.3) %>% hilight(21, "steelblue"),
726
+             ncol=2)
727
+```
728
+
729
+Of calse, _`scaleClade`_ can accept `scale` larger than 1 and zoom in the selected portion.
730
+
731
+```{r fig.width=12, fig.height=6, warning=F}
732
+grid.arrange(ggtree(tree) %>% hilight(17, fill="steelblue") %>%
733
+                 hilight(21, fill="darkgreen"),
734
+             ggtree(tree) %>% scaleClade(17, scale=2) %>% scaleClade(21, scale=0.3) %>%
735
+                 hilight(17, "steelblue") %>% hilight(21, fill="darkgreen"),
736
+             ncol=2)
737
+```
738
+
720 739
 
721 740
 ## visualize tree with associated matrix
722 741