Browse code

geom_cladelabel

GuangchuangYu authored on 11/08/2016 06:53:22
Showing 11 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
... ...
@@ -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.
... ...
@@ -14,6 +14,10 @@ build:
14 14
 	cd ..;\
15 15
 	R CMD build $(PKGSRC)
16 16
 
17
+build2:
18
+	cd ..;\
19
+	R CMD build --no-build-vignettes $(PKGSRC)
20
+
17 21
 install:
18 22
 	cd ..;\
19 23
 	R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz
... ...
@@ -22,6 +26,10 @@ check: build
22 26
 	cd ..;\
23 27
 	R CMD check $(PKGNAME)_$(PKGVERS).tar.gz
24 28
 
29
+bioccheck:
30
+	cd ..;\
31
+	Rscript -e 'BiocCheck::BiocCheck("$(PKGNAME)_$(PKGVERS).tar.gz")'
32
+
25 33
 clean:
26 34
 	cd ..;\
27 35
 	$(RM) -r $(PKGNAME).Rcheck/
... ...
@@ -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 {
... ...
@@ -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
+