Browse code

geom_range

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

Guangchuang Yu authored on 01/04/2016 08:12:07
Showing 7 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.3.14
4
+Version: 1.3.15
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
... ...
@@ -40,6 +40,7 @@ export(geom_cladelabel)
40 40
 export(geom_hilight)
41 41
 export(geom_nodepoint)
42 42
 export(geom_point2)
43
+export(geom_range)
43 44
 export(geom_rootpoint)
44 45
 export(geom_segment2)
45 46
 export(geom_text2)
... ...
@@ -1,3 +1,7 @@
1
+CHANGES IN VERSION 1.3.15
2
+------------------------
3
+ o geom_range for adding range of HPD to present uncertainty of evolutionary inference <2016-04-01, Fri>
4
+ 
1 5
 CHANGES IN VERSION 1.3.14
2 6
 ------------------------
3 7
  o geom_tiplab works with NA values, compatible with collapse <2016-03-05, Sat>
... ...
@@ -108,9 +112,9 @@ CHANGES IN VERSION 1.3.1
108 112
    + see https://github.com/hadley/ggplot2/issues/1380
109 113
  o matching beast stats with tree using internal node number instead of label <2015-10-20, Tue>
110 114
  
111
-CHANGES IN VERSION 1.3.0
115
+CHANGES IN VERSION 1.2.0
112 116
 ------------------------
113
- o BioC 3.3 branch
117
+ o BioC 3.2 released
114 118
  
115 119
 CHANGES IN VERSION 1.1.21
116 120
 ------------------------
... ...
@@ -1,30 +1,2 @@
1
-add_range <- function(p, ...) {
2
-    df <- p$data
3
-    rr <- gsub("\\[", "", df$height_range)
4
-    rr <- gsub("\\]", "", rr)
5
-    rr2 <- strsplit(rr, split=',') %>% do.call('rbind', .)
6
-    rr2 <- matrix(as.numeric(rr2), ncol=2, byrow=FALSE)
7
-    ## if (!is.null(mrsd)) {
8
-    ##     mrsd %<>% as.Date
9
-    ##     date <- Date2decimal(mrsd)
10
-    ##     rr2 <- rr2 + date - max(rr2)
11
-    ##     if (asDate) {
12
-    ##         rr2 <- decimal2Date(rr2)
13
-    ##     }
14
-    ## }
15
-    rr2 <- rr2 + df$x - df$height
16
-    p + geom_segment2(x=rr2[,1], xend=rr2[,2], y=df$y, yend=df$y, ...)
17
-}
18 1
 
19
-## add range of height, only work with beast and only for height
20
-## when I have an idea of implementing such feature for all range
21
-## I will export it and make it usable for all users.
22
-##
23
-##
24
-## file <- system.file("extdata/BEAST", "beast_mcc.tree", package="ggtree")
25
-## beast <- read.beast(file)
26
-## p <- ggtree(beast)
27
-## add_range(p, color='firebrick', size=2, alpha=.3)
28
-##
29
-## p <- ggtree(beast, mrsd='2013-01-01') + theme_tree2()
30
-## add_range(p, color='firebrick', size=2, alpha=.3)
2
+
... ...
@@ -17,7 +17,7 @@ geom_hilight <- function(node, fill="steelblue", alpha=.5) {
17 17
     stat = "hilight"
18 18
     position = "identity"
19 19
     show.legend = NA
20
-    na.rm = FALSE
20
+    na.rm = TRUE
21 21
     inherit.aes = FALSE
22 22
     
23 23
     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)
24 24
new file mode 100644
... ...
@@ -0,0 +1,58 @@
1
+##' bar of range (HPD, range etc) to present uncertainty of evolutionary inference
2
+##'
3
+##' 
4
+##' @title geom_range
5
+##' @param range range, e.g. "height_0.95_HPD"
6
+##' @param ... additional parameter, e.g. color, size, alpha
7
+##' @return ggplot layer
8
+##' @importFrom ggplot2 aes_string
9
+##' @export
10
+##' @author Guangchuang Yu
11
+geom_range <- function(range="height_0.95_HPD", ...) {
12
+
13
+    stat = "range"
14
+    position = "identity"
15
+    show.legend = NA
16
+    na.rm = TRUE
17
+    inherit.aes = FALSE    
18
+
19
+    if (range == "height_0.95_HPD") {
20
+        branch.length = "height"
21
+    } else {
22
+        branch.length = "branch.length"
23
+    }
24
+    default_aes <- aes_(x=~x, y=~y)
25
+    mapping <- modifyList(default_aes, aes_string(branch.length=branch.length, label=range))
26
+        
27
+    layer(
28
+        stat = StatRange,
29
+        mapping = mapping,
30
+        data = NULL,
31
+        geom = GeomSegment,
32
+        position = position,
33
+        show.legend=show.legend,
34
+        inherit.aes = inherit.aes,
35
+        params = list(na.rm = na.rm, ...)
36
+    )
37
+    
38
+}
39
+
40
+StatRange <- ggproto("StatRange", Stat,
41
+                     compute_group = function(self, data, scales, params) {
42
+                         ## label is actually the range
43
+                         
44
+                         df <- data[!is.na(data[,"label"]),]
45
+                         rr <- gsub("\\[", "", df[,"label"])
46
+                         rr <- gsub("\\]", "", rr)
47
+                         rr2 <- strsplit(rr, split=',') %>% do.call('rbind', .)
48
+                         rr2 <- matrix(as.numeric(rr2), ncol=2, byrow=FALSE)
49
+                         rr2 <- rr2 + df$x - df$branch
50
+                         data.frame(x = rr2[,1],
51
+                                    xend = rr2[,2],
52
+                                    y = df$y,
53
+                                    yend = df$y)
54
+                     },
55
+                     required_aes = c("x", "y", "xend", "yend")
56
+                     )
57
+
58
+
0 59
new file mode 100644
... ...
@@ -0,0 +1,23 @@
1
+% Generated by roxygen2: do not edit by hand
2
+% Please edit documentation in R/geom_range.R
3
+\name{geom_range}
4
+\alias{geom_range}
5
+\title{geom_range}
6
+\usage{
7
+geom_range(range = "height_0.95_HPD", ...)
8
+}
9
+\arguments{
10
+\item{range}{range, e.g. "height_0.95_HPD"}
11
+
12
+\item{...}{additional parameter, e.g. color, size, alpha}
13
+}
14
+\value{
15
+ggplot layer
16
+}
17
+\description{
18
+bar of range (HPD, range etc) to present uncertainty of evolutionary inference
19
+}
20
+\author{
21
+Guangchuang Yu
22
+}
23
+