Browse code

geom_tiplab enhancement

guangchuang yu authored on 20/11/2017 13:20:02
Showing7 changed files

... ...
@@ -1,5 +1,6 @@
1 1
 CHANGES IN VERSION 1.11.1
2 2
 ------------------------
3
+ o bug fixed in geom_tiplab, now `offset` parameter works with `align=TRUE`. <2017-11-20, Mon>
3 4
  o enable mrsd parameter for treedata object <2017-11-15, Wed>
4 5
  o set_hilight_legend supports alpha parameter <2017-11-15, Wed>
5 6
    + https://github.com/GuangchuangYu/ggtree/issues/149
... ...
@@ -36,6 +36,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
36 36
 ##' @param na.rm logical
37 37
 ##' @param show.legend logical
38 38
 ##' @param inherit.aes logical
39
+##' @param nudge_x horizontal adjustment of x
39 40
 ##' @param ... additional parameter
40 41
 ##' @importFrom ggplot2 layer
41 42
 ##' @export
... ...
@@ -46,6 +47,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
46 47
 geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
47 48
                          position = "identity", arrow = NULL, lineend = "butt",
48 49
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
50
+                         nudge_x = 0,
49 51
                          ...) {
50 52
 
51 53
     default_aes <- aes_(node=~node)
... ...
@@ -67,6 +69,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
67 69
             arrow = arrow,
68 70
             lineend = lineend,
69 71
             na.rm = na.rm,
72
+            nudge_x = nudge_x,
70 73
             ...
71 74
         ),
72 75
         check.aes = FALSE
... ...
@@ -80,21 +83,15 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
80 83
                                  if (is.null(data$subset))
81 84
                                      return(data)
82 85
                                  data[which(data$subset),]
83
-                             }
84
-
85
-                            ## ,
86
-
87
-                            ##  draw_panel = function(data, panel_scales, coord, arrow = NULL,
88
-                            ##                        lineend = "butt", na.rm = FALSE) {
86
+                             },
89 87
 
90
-                            ##      GeomSegment$draw_panel(data, panel_scales, coord, arrow,
91
-                            ##                             lineend, na.rm)
92
-                            ##  },
88
+                             draw_panel = function(data, panel_scales, coord, arrow = NULL,
89
+                                                   lineend = "butt", na.rm = FALSE, nudge_x = 0) {
93 90
 
94
-                            ##  required_aes = c("x", "y", "xend", "yend"),
95
-                            ##  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
96
-
97
-                            ##  draw_key = draw_key_path
91
+                                 data$x <- data$x + nudge_x
92
+                                 GeomSegment$draw_panel(data, panel_scales, coord, arrow,
93
+                                                        lineend, na.rm)
94
+                             }
98 95
                              )
99 96
 
100 97
 
... ...
@@ -18,7 +18,7 @@
18 18
 ##' require(ape)
19 19
 ##' tr <- rtree(10)
20 20
 ##' ggtree(tr) + geom_tiplab()
21
-geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dotted", linesize=1, geom="text",  offset=0, ...) {
21
+geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dotted", linesize=0.5, geom="text",  offset=0, ...) {
22 22
     geom <- match.arg(geom, c("text", "label"))
23 23
     if (geom == "text") {
24 24
         text_geom <- geom_text2
... ...
@@ -58,13 +58,8 @@ geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dot
58 58
         ,
59 59
         if (show_segment)
60 60
             geom_segment2(mapping = segment_mapping,
61
-                          linetype = linetype,
61
+                          linetype = linetype, nudge_x = offset,
62 62
                           size = linesize, stat = StatTreeData, ...)
63
-
64
-            ## geom_tipsegment(mapping = segment_mapping,
65
-            ##                 offset = offset,
66
-            ##                 linetype = linetype,
67
-            ##                 size = linesize, ...)
68 63
     )
69 64
 }
70 65
 
... ...
@@ -99,47 +94,5 @@ geom_tiplab2 <- function(mapping=NULL, hjust=0, ...) {
99 94
          )
100 95
 }
101 96
 
102
-## geom_tipsegment <- function(mapping=NULL, data=NULL,
103
-##                             geom=GeomSegmentGGtree, position = "identity",
104
-##                             offset,  ...,
105
-##                             show.legend=NA, inherit.aes=FALSE,
106
-##                             na.rm=TRUE) {
107
-
108
-##     default_aes <- aes_(x=~x, y=~y)
109
-##     if (is.null(mapping)) {
110
-##         mapping <- default_aes
111
-##     } else {
112
-##         mapping <- modifyList(default_aes, mapping)
113
-##     }
114
-
115
-##     layer(stat=StatTipSegment,
116
-##           data = data,
117
-##           mapping = mapping,
118
-##           geom = geom,
119
-##           position = position,
120
-##           show.legend = show.legend,
121
-##           inherit.aes = inherit.aes,
122
-##           params = list(offset = offset,
123
-##                         na.rm = na.rm,
124
-##                         ...),
125
-##           check.aes = FALSE
126
-##           )
127
-## }
128
-
129
-## StatTipSegment <- ggproto("StatTipSegment", Stat,
130
-##                         compute_group = function(self, data, scales, params, offset) {
131
-##                             get_tipsegment_position(data, offset)
132
-##                         },
133
-##                         required_aes = c("x", "y")
134
-##                         )
135
-
136
-
137
-## get_tipsegment_position <- function(data, offset, adjustRatio=1/200) {
138
-##     adjust <- diff(range(data$x, na.rm=TRUE)) * adjustRatio
139
-##     xend <- data$x + adjust
140
-##     x <- max(data$x, na.rm = TRUE)  + offset
141
-##     y <- data$y
142
-##     data.frame(x=x, xend=xend, y=y, yend=y)
143
-## }
144 97
 
145 98
 
... ...
@@ -7,14 +7,14 @@ ggtree: an R package for visualization and annotation of phylogenetic trees with
7 7
 [![releaseVersion](https://img.shields.io/badge/release%20version-1.10.0-green.svg?style=flat)](https://bioconductor.org/packages/ggtree)
8 8
 [![develVersion](https://img.shields.io/badge/devel%20version-1.11.1-green.svg?style=flat)](https://github.com/guangchuangyu/ggtree)
9 9
 [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since)
10
-[![total](https://img.shields.io/badge/downloads-21262/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
10
+[![total](https://img.shields.io/badge/downloads-21387/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
11 11
 [![month](https://img.shields.io/badge/downloads-1156/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
12 12
 
13 13
 [![Project Status: Active - The project has reached a stable, usable
14 14
 state and is being actively
15 15
 developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active)
16 16
 [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree)
17
-[![Last-changedate](https://img.shields.io/badge/last%20change-2017--11--15-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master)
17
+[![Last-changedate](https://img.shields.io/badge/last%20change-2017--11--20-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master)
18 18
 [![GitHub
19 19
 forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network)
20 20
 [![GitHub
... ...
@@ -60,7 +60,7 @@ Evolution***. 2017, 8(1):28-36.
60 60
 
61 61
 [![doi](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628)
62 62
 [![Altmetric](https://img.shields.io/badge/Altmetric-336-green.svg?style=flat)](https://www.altmetric.com/details/10533079)
63
-[![citation](https://img.shields.io/badge/cited%20by-47-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627)
63
+[![citation](https://img.shields.io/badge/cited%20by-46-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627)
64 64
 
65 65
 ------------------------------------------------------------------------
66 66
 
... ...
@@ -71,7 +71,7 @@ Evolution***. 2017, 8(1):28-36.
71 71
 ### Download stats
72 72
 
73 73
 [![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree)
74
-[![total](https://img.shields.io/badge/downloads-21262/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
74
+[![total](https://img.shields.io/badge/downloads-21387/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
75 75
 [![month](https://img.shields.io/badge/downloads-1156/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
76 76
 
77 77
 <img src="docs/images/dlstats.png" width="890"/>
78 78
Binary files a/docs/images/citation.png and b/docs/images/citation.png differ
... ...
@@ -6,7 +6,7 @@
6 6
 \usage{
7 7
 geom_segment2(mapping = NULL, data = NULL, stat = "identity",
8 8
   position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE,
9
-  show.legend = NA, inherit.aes = TRUE, ...)
9
+  show.legend = NA, inherit.aes = TRUE, nudge_x = 0, ...)
10 10
 }
11 11
 \arguments{
12 12
 \item{mapping}{aes mapping}
... ...
@@ -27,6 +27,8 @@ geom_segment2(mapping = NULL, data = NULL, stat = "identity",
27 27
 
28 28
 \item{inherit.aes}{logical}
29 29
 
30
+\item{nudge_x}{horizontal adjustment of x}
31
+
30 32
 \item{...}{additional parameter}
31 33
 }
32 34
 \value{
... ...
@@ -5,7 +5,7 @@
5 5
 \title{geom_tiplab}
6 6
 \usage{
7 7
 geom_tiplab(mapping = NULL, hjust = 0, align = FALSE,
8
-  linetype = "dotted", linesize = 1, geom = "text", offset = 0, ...)
8
+  linetype = "dotted", linesize = 0.5, geom = "text", offset = 0, ...)
9 9
 }
10 10
 \arguments{
11 11
 \item{mapping}{aes mapping}