Browse code

geom_cladelabel

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

Guangchuang Yu authored on 11/08/2016 06:54:44
Showing 12 changed files

... ...
@@ -1,8 +1,9 @@
1
-TODO.md
2 1
 .travis.yml
3
-appveyor.yml
4 2
 .gitignore
5 3
 .svnignore
6
-Makefile
7 4
 ^appveyor\.yml$
5
+^.*\.DS_Store
6
+TODO.md
7
+appveyor.yml
8
+Makefile
8 9
 README.Rmd
... ...
@@ -3,7 +3,6 @@
3 3
 R/.Rhistory
4 4
 Makefile
5 5
 TODO.md
6
-README.md
7 6
 appveyor.yml
8 7
 .travis.yml
9 8
 README.Rmd
... ...
@@ -1,7 +1,7 @@
1 1
 Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
4
-Version: 1.5.7
4
+Version: 1.5.8
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 grammar of graphics.
... ...
@@ -1,3 +1,8 @@
1
+CHANGES IN VERSION 1.5.8
2
+------------------------
3
+ o add color parameter in geom_cladelabel, color should be of length 1 or 2 <2016-08-11, Thu>
4
+ o geom_cladelabel support parsing expression <2016-08-11, Thu>
5
+ 
1 6
 CHANGES IN VERSION 1.5.7
2 7
 ------------------------
3 8
  o geom_strip can accept taxa name as input but labeling strip will not supported.
... ...
@@ -12,15 +12,19 @@
12 12
 ##' @param angle angle of text
13 13
 ##' @param geom one of 'text' or 'label'
14 14
 ##' @param hjust hjust
15
+##' @param color color for clade & label, of length 1 or 2
15 16
 ##' @param fill fill label background, only work with geom='label'
16 17
 ##' @param family sans by default, can be any supported font
18
+##' @param parse logical, whether parse label
17 19
 ##' @param ... additional parameter
18 20
 ##' @return ggplot layers
19 21
 ##' @export
20 22
 ##' @author Guangchuang Yu
21 23
 geom_cladelabel <- function(node, label, offset=0, offset.text=0,
22 24
                             align=FALSE, barsize=0.5, fontsize=3.88,
23
-                            angle=0, geom="text", hjust = 0, fill=NA, family="sans", ...) {
25
+                            angle=0, geom="text", hjust = 0,
26
+                            color = NULL, fill=NA,
27
+                            family="sans", parse=FALSE, ...) {
24 28
     mapping <- NULL
25 29
     data <- NULL
26 30
     position <- "identity"
... ...
@@ -28,30 +32,73 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
28 32
     na.rm <- TRUE
29 33
     inherit.aes <- FALSE
30 34
 
31
-    if (geom == "text") {
32
-        ## no fill parameter
33
-        layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
34
-                                    align=align, size=fontsize, angle=angle, family=family,
35
-                                    mapping=mapping, data=data, geom=geom, hjust=hjust,
36
-                                    position=position, show.legend = show.legend,
37
-                                    inherit.aes = inherit.aes, na.rm=na.rm, ...)
38
-        
35
+    if (!is.null(color)) {
36
+        if (length(color) > 2) {
37
+            stop("color should be of length 1 or 2")
38
+        }
39
+        if (length(color) == 0) {
40
+            color = NULL
41
+        } else if (length(color) == 1) {
42
+            barcolor <- color
43
+            labelcolor <- color
44
+        } else {
45
+            barcolor <- color[1]
46
+            labelcolor <- color[2]
47
+        }
48
+    }
49
+
50
+    if (is.null(color)) {
51
+        if (geom == "text") {
52
+            ## no fill parameter
53
+            layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
54
+                                        align=align, size=fontsize, angle=angle, family=family,
55
+                                        mapping=mapping, data=data, geom=geom, hjust=hjust,
56
+                                        position=position, show.legend = show.legend,
57
+                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)
58
+            
59
+        } else {
60
+            layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
61
+                                        align=align, size=fontsize, angle=angle, fill=fill,family=family,
62
+                                        mapping=mapping, data=data, geom=geom, hjust=hjust,
63
+                                        position=position, show.legend = show.legend,
64
+                                        inherit.aes = inherit.aes, na.rm=na.rm,
65
+                                        parse = parse, ...)
66
+        }
67
+
68
+        layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
69
+                                   size=barsize,
70
+                                   mapping=mapping, data=data, 
71
+                                   position=position, show.legend = show.legend,
72
+                                   inherit.aes = inherit.aes, na.rm=na.rm, ...)
39 73
     } else {
40
-        layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
41
-                                    align=align, size=fontsize, angle=angle, fill=fill,family=family,
42
-                                    mapping=mapping, data=data, geom=geom, hjust=hjust,
43
-                                    position=position, show.legend = show.legend,
44
-                                    inherit.aes = inherit.aes, na.rm=na.rm, ...)
74
+        if (geom == "text") {
75
+            ## no fill parameter
76
+            layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
77
+                                        align=align, size=fontsize, angle=angle, color=labelcolor, family=family,
78
+                                        mapping=mapping, data=data, geom=geom, hjust=hjust,
79
+                                        position=position, show.legend = show.legend,
80
+                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)
81
+            
82
+        } else {
83
+            layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
84
+                                        align=align, size=fontsize, angle=angle, color=labelcolor, fill=fill,family=family,
85
+                                        mapping=mapping, data=data, geom=geom, hjust=hjust,
86
+                                        position=position, show.legend = show.legend,
87
+                                        inherit.aes = inherit.aes, na.rm=na.rm,
88
+                                        parse = parse, ...)
89
+        }
90
+
91
+        layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
92
+                                   size=barsize, color = barcolor,
93
+                                   mapping=mapping, data=data, 
94
+                                   position=position, show.legend = show.legend,
95
+                                   inherit.aes = inherit.aes, na.rm=na.rm, ...)
96
+        
45 97
     }
46 98
     
47 99
     list(
48
-        stat_cladeBar(node=node, offset=offset, align=align,
49
-                      size=barsize,
50
-                      mapping=mapping, data=data, 
51
-                      position=position, show.legend = show.legend,
52
-                      inherit.aes = inherit.aes, na.rm=na.rm, ...),
53
-        
54
-        layer_text
100
+       layer_bar,
101
+       layer_text
55 102
     )
56 103
 }
57 104
 
... ...
@@ -59,7 +106,8 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
59 106
 stat_cladeText <- function(mapping=NULL, data=NULL,
60 107
                            geom="text", position="identity",
61 108
                            node, label, offset, align, ...,
62
-                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
109
+                           show.legend=NA, inherit.aes=FALSE,
110
+                           na.rm=FALSE, parse=FALSE) {
63 111
     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)
64 112
     if (is.null(mapping)) {
65 113
         mapping <- default_aes
... ...
@@ -75,10 +123,11 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
75 123
           show.legend = show.legend,
76 124
           inherit.aes = inherit.aes,
77 125
           params=list(node=node,
78
-                      label=label,
79
-                      offset=offset,
80
-                      align=align,
81
-                      na.rm=na.rm,
126
+                      label  = label,
127
+                      offset = offset,
128
+                      align  = align,
129
+                      na.rm  = na.rm,
130
+                      parse  = parse,
82 131
                       ...)
83 132
           )
84 133
     
... ...
@@ -88,7 +137,7 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,
88 137
                           geom="segment", position="identity",
89 138
                           node, offset, align,  ...,
90 139
                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
91
-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)
140
+    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)
92 141
     if (is.null(mapping)) {
93 142
         mapping <- default_aes
94 143
     } else {
... ...
@@ -14,7 +14,7 @@ geom_range <- function(range="height_0.95_HPD", ...) {
14 14
     na.rm = TRUE
15 15
     inherit.aes = FALSE    
16 16
 
17
-    default_aes <- aes_(x=~x, y=~y)
17
+    default_aes <- aes_(x=~x, y=~y, xend=~x, yend=~y)
18 18
     
19 19
     mapping <- modifyList(default_aes, aes_string(branch.length="branch.length", label=range))
20 20
         
... ...
@@ -105,7 +105,7 @@ stat_stripBar <- function(mapping=NULL, data=NULL,
105 105
                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
106 106
 
107 107
     if (is.null(label) || is.na(label)) {
108
-        default_aes <- aes_(x=~x, y=~y, node=~node, label=~label)
108
+        default_aes <- aes_(x=~x, y=~y, node=~node, label=~label, xend=~x, yend=~y)
109 109
     } else {
110 110
         default_aes <- aes_(x=~x, y=~y, node=~node)
111 111
     }
... ...
@@ -18,10 +18,10 @@ geom_taxalink <- function(taxa1, taxa2, curvature=0.5, ...) {
18 18
     na.rm = TRUE
19 19
     inherit.aes = FALSE    
20 20
 
21
-    mapping <- aes_(x=~x, y=~y, node=~node, label=~label)
21
+    mapping <- aes_(x=~x, y=~y, node=~node, label=~label, xend=~x, yend=~y)
22 22
 
23 23
     layer(stat=StatTaxalink,
24
-          mapping=aes_(x=~x, y=~y, node=~node, label=~label),
24
+          mapping=mapping,
25 25
           geom=GeomCurve,
26 26
           position='identity',
27 27
           show.legend=show.legend,
... ...
@@ -45,7 +45,7 @@ stat_treeScaleLine <- function(mapping=NULL, data=NULL,
45 45
                            xx, yy, width, offset, color, ..., 
46 46
                            show.legend=NA, inherit.aes=FALSE, na.rm=FALSE){
47 47
     
48
-    default_aes <- aes_(x=~x, y=~y)
48
+    default_aes <- aes_(x=~x, y=~y, xend=~x, yend=~y)
49 49
     if (is.null(mapping)) {
50 50
         mapping <- default_aes
51 51
     } else {
... ...
@@ -74,7 +74,7 @@ stat_treeScaleText <- function(mapping=NULL, data=NULL,
74 74
                                xx, yy, width, offset, color, ...,
75 75
                                show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
76 76
 
77
-    default_aes <- aes_(x=~x, y=~y)
77
+    default_aes <- aes_(x=~x, y=~y, label=~label)
78 78
     if (is.null(mapping)) {
79 79
         mapping <- default_aes
80 80
     } else {
81 81
new file mode 100644
... ...
@@ -0,0 +1,59 @@
1
+ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
2
+===========================================================================================================================
3
+
4
+[![platform](http://www.bioconductor.org/shields/availability/devel/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/) [![Linux/Mac Travis Build Status](https://img.shields.io/travis/GuangchuangYu/ggtree/master.svg?label=Mac%20OSX%20%26%20Linux)](https://travis-ci.org/GuangchuangYu/ggtree) [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/Guangchuangyu/ggtree/master.svg?label=Windows)](https://ci.appveyor.com/project/GuangchuangYu/ggtree) [![install with bioconda](https://img.shields.io/badge/install%20with-bioconda-green.svg?style=flat)](http://bioconda.github.io/recipes/bioconductor-ggtree/README.html)
5
+
6
+[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg) [![Last-changedate](https://img.shields.io/badge/last%20change-2016--08--10-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![commit](http://www.bioconductor.org/shields/commits/bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#svn_source) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers)
7
+
8
+[![releaseVersion](https://img.shields.io/badge/release%20version-1.4.14-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.5.7-green.svg?style=flat)](https://github.com/GuangchuangYu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![post](http://www.bioconductor.org/shields/posts/ggtree.svg)](https://support.bioconductor.org/t/ggtree/) [![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree/)
9
+
10
+The `ggtree` package extending the `ggplot2` package. It based on grammar of graphics and takes all the good parts of `ggplot2`. `ggtree` is designed for not only viewing phylogenetic tree but also displaying annotation data on the tree.
11
+
12
+------------------------------------------------------------------------
13
+
14
+Please cite the following article when using `ggtree`:
15
+
16
+**G Yu**, DK Smith, H Zhu, Y Guan, TTY Lam<sup>\*</sup>. ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data. ***Methods in Ecology and Evolution***. *accepted*
17
+
18
+[![Twitter](https://img.shields.io/twitter/url/https/github.com/GuangchuangYu/ggtree.svg?style=social)](https://twitter.com/intent/tweet?hashtags=ggtree&url=https://guangchuangyu.github.io/ggtree)
19
+
20
+------------------------------------------------------------------------
21
+
22
+For details, please visit our project website, <https://guangchuangyu.github.io/ggtree>.
23
+
24
+-   [Documentation](https://guangchuangyu.github.io/ggtree/documentation/)
25
+-   [FAQ](https://guangchuangyu.github.io/ggtree/faq/)
26
+-   [Featured Articles](https://guangchuangyu.github.io/ggtree/featuredArticles/)
27
+-   [Feedback](https://guangchuangyu.github.io/ggtree/#feedback)
28
+
29
+### Example
30
+
31
+[![](https://guangchuangyu.github.io/ggtree/featured_img/2015_peiyu_1-s2.0-S1567134815300721-gr1.jpg)](https://guangchuangyu.github.io/ggtree/featuredArticles/)
32
+
33
+### Download stats
34
+
35
+         +---------------------------+---------------------------+----------------------------+--------+
36
+         |                                                                                    *        |
37
+    1200 +                                                                                             +
38
+         |                                                                      *                      |
39
+         |                                                                                         *   |
40
+    1000 +                                                                          *    *             +
41
+         |                                                                                             |
42
+         |                                                                                             |
43
+         |                                                                                             |
44
+     800 +                                                  *         *                                +
45
+         |                                                                 *                           |
46
+         |                                              *        *                                     |
47
+     600 +                                         *                                                   +
48
+         |                                                                                             |
49
+         |                                                                                             |
50
+         |                                    *                                                        |
51
+     400 +                           *   *                                                             +
52
+         |                      *                                                                      |
53
+         |                                                                                             |
54
+     200 +                 *                                                                           +
55
+         |                                                                                             |
56
+         |                                                                                             |
57
+         |   *    *   *                                                                                |
58
+       0 +---------------------------+---------------------------+----------------------------+--------+
59
+                                  2015.5                       2016                        2016.5
... ...
@@ -6,7 +6,7 @@
6 6
 \usage{
7 7
 geom_cladelabel(node, label, offset = 0, offset.text = 0, align = FALSE,
8 8
   barsize = 0.5, fontsize = 3.88, angle = 0, geom = "text", hjust = 0,
9
-  fill = NA, family = "sans", ...)
9
+  color = NULL, fill = NA, family = "sans", parse = FALSE, ...)
10 10
 }
11 11
 \arguments{
12 12
 \item{node}{selected node}
... ...
@@ -29,10 +29,14 @@ geom_cladelabel(node, label, offset = 0, offset.text = 0, align = FALSE,
29 29
 
30 30
 \item{hjust}{hjust}
31 31
 
32
+\item{color}{color for clade & label, of length 1 or 2}
33
+
32 34
 \item{fill}{fill label background, only work with geom='label'}
33 35
 
34 36
 \item{family}{sans by default, can be any supported font}
35 37
 
38
+\item{parse}{logical, whether parse label}
39
+
36 40
 \item{...}{additional parameter}
37 41
 }
38 42
 \value{
39 43
new file mode 100644
... ...
@@ -0,0 +1,9 @@
1
+context('geom_cladelabel')
2
+
3
+
4
+test_that('geom_cladelabel support parsing expression', {
5
+    p <- ggtree(rtree(30)) + geom_cladelabel(node=40, label='paste(italic("species name"), "accession number")', parse=T)
6
+    expect_true(is.ggplot(p))
7
+})
8
+
9
+