Browse code

compatible with ggplot2-dev

guangchuang yu authored on 02/05/2018 03:48:18
Showing 8 changed files

... ...
@@ -2,7 +2,7 @@ Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with
4 4
     their covariates and other associated data
5
-Version: 1.13.0
5
+Version: 1.13.0.001
6 6
 Authors@R: c(
7 7
 	   person("Guangchuang", "Yu",     email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6485-8781")),
8 8
 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com",   role = c("aut", "ths")),
... ...
@@ -1,3 +1,12 @@
1
+# ggtree 1.13.0.001
2
+
3
++ compatible with ggplot2 2.2.1.9000 (2018-05-02, Wed)
4
+  - incorporate newly introduce parameter `linejoin` and `arrow.fill` in `geom_segment`
5
+
6
+# ggtree 1.12.0
7
+
8
++ Bioconductor 3.7 release (2018-05-01, Tue)
9
+
1 10
 # ggtree 1.11.6
2 11
 
3 12
 + reexport `treeio::read.iqtree` & `treeio::read.astral`(2018-04-17, Tue)
... ...
@@ -121,7 +121,7 @@ geom_cladelabel <- function(node, label,
121 121
 
122 122
 
123 123
     }
124
-    
124
+
125 125
     list(
126 126
       layer_bar,
127 127
       layer_text
... ...
@@ -168,7 +168,7 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,
168 168
                           node, offset, align, extend,  ...,
169 169
                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
170 170
 
171
-  
171
+
172 172
     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)
173 173
     if (is.null(mapping)) {
174 174
         mapping <- default_aes
... ...
@@ -69,7 +69,7 @@ geom_cladelabel2 <- function(node, label, offset=0, offset.text=0, offset.bar=0,
69 69
                              "alpha", "angle", "fontface", "group", "lineheight", "size", "vjust")
70 70
 
71 71
     # ignore angle
72
-    arg_list_geom_curve <- c( "curvature", "ncp", "arrow", "lineend",
72
+    arg_list_geom_curve <- c( "curvature", "ncp", "arrow", "arrow.fill", "lineend",
73 73
                               "alpha", "group", "linetype")
74 74
 
75 75
 
... ...
@@ -121,7 +121,6 @@ geom_cladelabel2 <- function(node, label, offset=0, offset.text=0, offset.bar=0,
121 121
     args_stat_cladeBar2$inherit.aes <- inherit.aes
122 122
     args_stat_cladeBar2$na.rm       <- na.rm
123 123
 
124
-
125 124
     if (!is.null(color)) {
126 125
         if (length(color) > 2) {
127 126
           stop("color should be of length 1 or 2")
... ...
@@ -189,7 +188,8 @@ stat_cladeText2 <- function(mapping=NULL, data=NULL,
189 188
 stat_cladeBar2 <- function(mapping=NULL, data=NULL,
190 189
                            geom="curve", position="identity",
191 190
                            node, offset, align, ...,
192
-                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
191
+                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE,
192
+                           arrow=NULL, arrow.fill=NULL) {
193 193
   default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)
194 194
   if (is.null(mapping)) {
195 195
     mapping <- default_aes
... ...
@@ -209,6 +209,8 @@ stat_cladeBar2 <- function(mapping=NULL, data=NULL,
209 209
                     offset=offset,
210 210
                     align=align,
211 211
                     na.rm=na.rm,
212
+                    arrow = arrow,
213
+                    arrow.fill = arrow.fill,
212 214
                     ...)
213 215
 
214 216
   )
... ...
@@ -31,12 +31,13 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
31 31
 ##' @param data data
32 32
 ##' @param stat Name of stat to modify data
33 33
 ##' @param position position
34
-##' @param arrow arrow
35 34
 ##' @param lineend lineend
36 35
 ##' @param na.rm logical
37 36
 ##' @param show.legend logical
38 37
 ##' @param inherit.aes logical
39 38
 ##' @param nudge_x horizontal adjustment of x
39
+##' @param arrow specification for arrow heads, as created by arrow().
40
+##' @param arrow.fill fill color to usse for the arrow head (if closed). `NULL` means use `colour` aesthetic.
40 41
 ##' @param ... additional parameter
41 42
 ##' @importFrom ggplot2 layer
42 43
 ##' @export
... ...
@@ -45,9 +46,9 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
45 46
 ##' @return add segment layer
46 47
 ##' @author Guangchuang Yu
47 48
 geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
48
-                         position = "identity", arrow = NULL, lineend = "butt",
49
+                         position = "identity", lineend = "butt",
49 50
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
50
-                         nudge_x = 0,
51
+                         nudge_x = 0, arrow = NULL, arrow.fill = NULL,
51 52
                          ...) {
52 53
 
53 54
     default_aes <- aes_(node=~node)
... ...
@@ -85,13 +86,14 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
85 86
                                  data[which(data$subset),]
86 87
                              },
87 88
 
88
-                             draw_panel = function(data, panel_scales, coord, arrow = NULL,
89
-                                                   lineend = "butt", na.rm = FALSE, nudge_x = 0) {
89
+                             draw_panel = function(data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
90
+                                                   lineend = "butt", linejoin = "round", na.rm = FALSE, nudge_x = 0) {
90 91
 
91 92
                                  data$x <- data$x + nudge_x
92 93
                                  ## data$x <- data$x - sapply(data$label, function(x) convertWidth(grobWidth(textGrob(x, gp=gpar(fontsize=.04* .pt))), "native", TRUE))
93
-                                 GeomSegment$draw_panel(data, panel_scales, coord, arrow,
94
-                                                        lineend, na.rm)
94
+                                 GeomSegment$draw_panel(data = data, panel_params = panel_params, coord = coord,
95
+                                                        arrow = arrow, arrow.fill = arrow.fill,
96
+                                                        lineend = lineend, linejoin = linejoin, na.rm = na.rm)
95 97
                              }
96 98
                              )
97 99
 
... ...
@@ -7,12 +7,14 @@
7 7
 ##' @param curvature A numeric value giving the amount of curvature.
8 8
 ##' Negative values produce left-hand curves,
9 9
 ##' positive values produce right-hand curves, and zero produces a straight line.
10
+##' @param arrow specification for arrow heads, as created by arrow().
11
+##' @param arrow.fill fill color to usse for the arrow head (if closed). `NULL` means use `colour` aesthetic.
10 12
 ##' @param ... additional parameter
11 13
 ##' @return ggplot layer
12 14
 ##' @export
13 15
 ##' @importFrom ggplot2 GeomCurve
14 16
 ##' @author Guangchuang Yu
15
-geom_taxalink <- function(taxa1, taxa2, curvature=0.5, ...) {
17
+geom_taxalink <- function(taxa1, taxa2, curvature=0.5, arrow = NULL, arrow.fill = NULL, ...) {
16 18
     position = "identity"
17 19
     show.legend = NA
18 20
     na.rm = TRUE
... ...
@@ -31,6 +33,8 @@ geom_taxalink <- function(taxa1, taxa2, curvature=0.5, ...) {
31 33
                         taxa2 = taxa2,
32 34
                         curvature = curvature,
33 35
                         na.rm = na.rm,
36
+                        arrow = arrow,
37
+                        arrow.fill = arrow.fill,
34 38
                         ...),
35 39
           check.aes = FALSE
36 40
           )
... ...
@@ -5,8 +5,9 @@
5 5
 \title{geom_segment2}
6 6
 \usage{
7 7
 geom_segment2(mapping = NULL, data = NULL, stat = "identity",
8
-  position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE,
9
-  show.legend = NA, inherit.aes = TRUE, nudge_x = 0, ...)
8
+  position = "identity", lineend = "butt", na.rm = FALSE,
9
+  show.legend = NA, inherit.aes = TRUE, nudge_x = 0, arrow = NULL,
10
+  arrow.fill = NULL, ...)
10 11
 }
11 12
 \arguments{
12 13
 \item{mapping}{aes mapping}
... ...
@@ -17,8 +18,6 @@ geom_segment2(mapping = NULL, data = NULL, stat = "identity",
17 18
 
18 19
 \item{position}{position}
19 20
 
20
-\item{arrow}{arrow}
21
-
22 21
 \item{lineend}{lineend}
23 22
 
24 23
 \item{na.rm}{logical}
... ...
@@ -29,6 +28,10 @@ geom_segment2(mapping = NULL, data = NULL, stat = "identity",
29 28
 
30 29
 \item{nudge_x}{horizontal adjustment of x}
31 30
 
31
+\item{arrow}{specification for arrow heads, as created by arrow().}
32
+
33
+\item{arrow.fill}{fill color to usse for the arrow head (if closed). `NULL` means use `colour` aesthetic.}
34
+
32 35
 \item{...}{additional parameter}
33 36
 }
34 37
 \value{
... ...
@@ -4,7 +4,8 @@
4 4
 \alias{geom_taxalink}
5 5
 \title{geom_taxalink}
6 6
 \usage{
7
-geom_taxalink(taxa1, taxa2, curvature = 0.5, ...)
7
+geom_taxalink(taxa1, taxa2, curvature = 0.5, arrow = NULL,
8
+  arrow.fill = NULL, ...)
8 9
 }
9 10
 \arguments{
10 11
 \item{taxa1}{taxa1, can be label or node number}
... ...
@@ -15,6 +16,10 @@ geom_taxalink(taxa1, taxa2, curvature = 0.5, ...)
15 16
 Negative values produce left-hand curves,
16 17
 positive values produce right-hand curves, and zero produces a straight line.}
17 18
 
19
+\item{arrow}{specification for arrow heads, as created by arrow().}
20
+
21
+\item{arrow.fill}{fill color to usse for the arrow head (if closed). `NULL` means use `colour` aesthetic.}
22
+
18 23
 \item{...}{additional parameter}
19 24
 }
20 25
 \value{