1. ggtree
  2. R
  3. geom_segment.R
Browse code

rename size aesthetic according to ggplot2 (3.4.0)

xiangpin authored on 07/07/2022 12:57:13
Showing 1 changed files
R/geom_segment.R
History View file @ 69f2dbbf
... ... 
@@ -7,12 +7,12 @@
7 7 
 ##' @title geom_aline
8 8 
 ##' @param mapping aes mapping
9 9 
 ##' @param linetype set line type of the line, defaults to "dotted"
10 
-##' @param size set line size of the line, defaults to 1
10 
+##' @param linewidth set width of the line, defaults to 1
11 11 
 ##' @param ... additional parameter
12 12 
 ##' @return aline layer
13 13 
 ##' @export
14 14 
 ##' @author Yu Guangchuang
15 
-geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
15 
+geom_aline <- function(mapping=NULL, linetype="dotted", linewidth = 1, ...) {
16 16 
     x <- y <- isTip <- NULL
17 17 
     dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y, subset=isTip)
18 18 
     if (!is.null(mapping)) {
... ... 
@@ -21,7 +21,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
21 21
22 22 
     geom_segment2(dot_mapping,
23 23 
                   linetype=linetype,
24 
-                  size=size, stat = StatTreeData, ...)
24 
+                  linewidth = linewidth, stat = StatTreeData, ...)
25 25 
 }
26 26
27 27
... ... 
@@ -98,7 +98,7 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
98 98 
                                  data$x <- data$x + nudge_x
99 99
100 100 
                                  data <- ggplot2::remove_missing(data, na.rm = na.rm, c("x", "y", "xend",
101 
-                                                        "yend", "linetype", "size", "shape"), name = "geom_segment")
101 
+                                                        "yend", "linetype", "linewidth", "shape"), name = "geom_segment")
102 102 
                                  if (empty(data))
103 103 
                                      return(zeroGrob())
104 104 
                                  if (!coord$is_linear()) {
... ... 
@@ -123,7 +123,7 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
123 123 
                                  return(grid::segmentsGrob(data$x, data$y, data$xend, data$yend,
124 124 
                                                            default.units = "native", gp = gpar(col = alpha(data$colour,
125 125 
                                                            data$alpha), fill = alpha(arrow.fill, data$alpha),
126 
-                                                           lwd = data$size * ggplot2::.pt, lty = data$linetype,
126 
+                                                           lwd = data$linewidth * ggplot2::.pt, lty = data$linetype,
127 127 
                                                            lineend = lineend, linejoin = linejoin), arrow = arrow)
128 128 
                                        )
129 129
Browse code

Document update

Document update

William Lee authored on 22/03/2022 14:46:29
Showing 1 changed files
R/geom_segment.R
History View file @ 3c7f66c8
... ... 
@@ -1,10 +1,13 @@
1 
-##' add horizontal align lines
1 
+##' add horizontal align lines layer to a tree
2 
+##'
3 
+##' 'geom_aline'align all tips to the longest one by adding
4 
+##' padding characters to the right side of the tip.
2 5 
 ##'
3 6 
 ##'
4 7 
 ##' @title geom_aline
5 8 
 ##' @param mapping aes mapping
6 
-##' @param linetype line type
7 
-##' @param size line size
9 
+##' @param linetype set line type of the line, defaults to "dotted"
10 
+##' @param size set line size of the line, defaults to 1
8 11 
 ##' @param ... additional parameter
9 12 
 ##' @return aline layer
10 13 
 ##' @export
... ... 
@@ -25,17 +28,19 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
25 28
26 29 
 ##' geom_segment2 support aes(subset) via setup_data
27 30 
 ##'
31 
+##' 'geom_segment2' is a modified version of geom_segment, with subset aesthetic supported
28 32 
 ##'
29 33 
 ##' @title geom_segment2
30 
-##' @param mapping aes mapping
31 
-##' @param data data
32 
-##' @param stat Name of stat to modify data
33 
-##' @param position position
34 
-##' @param lineend lineend
35 
-##' @param na.rm logical
36 
-##' @param show.legend logical
37 
-##' @param inherit.aes logical
38 
-##' @param nudge_x horizontal adjustment of x
34 
+##' @param mapping Set of aesthetic mappings, defaults to NULL
35 
+##' @param data A layer specific dataset -
36 
+##'             only needed if you want to override the plot defaults.
37 
+##' @param stat Name of stat to modify data.
38 
+##' @param position The position adjustment to use for overlapping points on this layer.
39 
+##' @param lineend Line end style, one of butt (default), round and square.
40 
+##' @param na.rm If "FALSE" (default), missing values are removed with a warning. If "TRUE", missing values are silently removed, logical.
41 
+##' @param show.legend Whether to show legend, logical.
42 
+##' @param inherit.aes Whether to inherit aesthetic mappings, logical, defaults to "TRUE".
43 
+##' @param nudge_x adjust the horizontal position of the segments.
39 44 
 ##' @param arrow specification for arrow heads, as created by arrow().
40 45 
 ##' @param arrow.fill fill color to usse for the arrow head (if closed). `NULL` means use `colour` aesthetic.
41 46 
 ##' @param ... additional parameter
Browse code

fix the nudge_x of geom_segment2

xiangpin authored on 03/09/2021 07:36:38
Showing 1 changed files
R/geom_segment.R
History View file @ d745cd6a
... ... 
@@ -89,6 +89,9 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
89 89
90 90 
                              draw_panel = function(data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
91 91 
                                                    lineend = "butt", linejoin = "round", na.rm = FALSE, nudge_x = 0) {
92 
+
93 
+                                 data$x <- data$x + nudge_x
94 
+
92 95 
                                  data <- ggplot2::remove_missing(data, na.rm = na.rm, c("x", "y", "xend",
93 96 
                                                         "yend", "linetype", "size", "shape"), name = "geom_segment")
94 97 
                                  if (empty(data))
... ... 
@@ -110,7 +113,6 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
110 113 
                                  }else{
111 114 
                                      data <- coord$transform(data, panel_params)
112 115 
                                  }
113 
-                                 data$x <- data$x + nudge_x
114 116
115 117 
                                  arrow.fill <- arrow.fill %||% data$colour
116 118 
                                  return(grid::segmentsGrob(data$x, data$y, data$xend, data$yend,
Browse code

straight line in radial layout

xiangpin authored on 28/07/2021 05:24:47
Showing 1 changed files
R/geom_segment.R
History View file @ 920a057c
... ... 
@@ -89,16 +89,45 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
89 89
90 90 
                              draw_panel = function(data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
91 91 
                                                    lineend = "butt", linejoin = "round", na.rm = FALSE, nudge_x = 0) {
92 
+                                 data <- ggplot2::remove_missing(data, na.rm = na.rm, c("x", "y", "xend",
93 
+                                                        "yend", "linetype", "size", "shape"), name = "geom_segment")
94 
+                                 if (empty(data))
95 
+                                     return(zeroGrob())
96 
+                                 if (!coord$is_linear()) {
97 
+                                     tmpgroup <- data$group
98 
+                                     starts <- subset(data, select = c(-xend, -yend))
99 
+                                     starts$group <- 1
100 
+                                     ends <- rename(subset(data, select = c(-x, -y)), c("x" = "xend", "y" = "yend"))
101 
+                                     ends$group <- 2
102 
+                                     pieces <- rbind(starts, ends)
92 103
104 
+                                     trans <- coord$transform(pieces, panel_params)
105 
+                                     starts <- trans[trans$group==1, ,drop=FALSE]
106 
+                                     ends <- trans[trans$group==2, ,drop=FALSE]
107 
+                                     ends <- rename(subset(ends, select=c(x, y)), c("xend"="x", "yend"="y"))
108 
+                                     data <- cbind(starts, ends)
109 
+                                     data$group <- tmpgroup
110 
+                                 }else{
111 
+                                     data <- coord$transform(data, panel_params)
112 
+                                 }
93 113 
                                  data$x <- data$x + nudge_x
94 114
115 
+                                 arrow.fill <- arrow.fill %||% data$colour
116 
+                                 return(grid::segmentsGrob(data$x, data$y, data$xend, data$yend,
117 
+                                                           default.units = "native", gp = gpar(col = alpha(data$colour,
118 
+                                                           data$alpha), fill = alpha(arrow.fill, data$alpha),
119 
+                                                           lwd = data$size * ggplot2::.pt, lty = data$linetype,
120 
+                                                           lineend = lineend, linejoin = linejoin), arrow = arrow)
121 
+                                       )
122 
+
123 
+
95 124 
                                  ## data$x <- data$x - sapply(data$label, function(x) convertWidth(grobWidth(textGrob(x, gp=gpar(fontsize=.04* .pt))), "native", TRUE))
96 
-                                 GeomSegment$draw_panel(data = data, panel_params = panel_params, coord = coord,
97 
-                                                        arrow = arrow, arrow.fill = arrow.fill,
98 
-                                                        lineend = lineend, linejoin = linejoin, na.rm = na.rm)
125 
+                                 ##GeomSegment$draw_panel(data = data, panel_params = panel_params, coord = coord,
126 
+                                 ##                       arrow = arrow, arrow.fill = arrow.fill,
127 
+                                 ##                       lineend = lineend, linejoin = linejoin, na.rm = na.rm)
99 128 
                              }
100 129 
                              )
101 130
102 131
103 
-
104 
-
132 
+empty <- getFromNamespace("empty", "ggplot2")
133 
+`%||%` <- getFromNamespace("%||%", "ggplot2")
Browse code

roxygen2md

Guangchuang Yu authored on 01/11/2019 04:24:00
Showing 1 changed files
R/geom_segment.R
History View file @ 1540db03
... ... 
@@ -42,7 +42,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
42 42 
 ##' @importFrom ggplot2 layer
43 43 
 ##' @export
44 44 
 ##' @seealso
45 
-##' \link[ggplot2]{geom_segment}
45 
+##' [geom_segment][ggplot2::geom_segment]
46 46 
 ##' @return add segment layer
47 47 
 ##' @author Guangchuang Yu
48 48 
 geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
Browse code

continuous color for normal geom_segment, WIP

Guangchuang Yu authored on 28/06/2019 03:49:46
Showing 1 changed files
R/geom_segment.R
History View file @ 206570ed
... ... 
@@ -77,6 +77,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
77 77 
     )
78 78 
 }
79 79
80 
+
80 81 
 ##' @importFrom ggplot2 GeomSegment
81 82 
 ##' @importFrom ggplot2 draw_key_path
82 83 
 GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
... ... 
@@ -90,6 +91,7 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
90 91 
                                                    lineend = "butt", linejoin = "round", na.rm = FALSE, nudge_x = 0) {
91 92
92 93 
                                  data$x <- data$x + nudge_x
94 
+
93 95 
                                  ## data$x <- data$x - sapply(data$label, function(x) convertWidth(grobWidth(textGrob(x, gp=gpar(fontsize=.04* .pt))), "native", TRUE))
94 96 
                                  GeomSegment$draw_panel(data = data, panel_params = panel_params, coord = coord,
95 97 
                                                         arrow = arrow, arrow.fill = arrow.fill,
Browse code

compatible with ggplot2-dev

guangchuang yu authored on 02/05/2018 03:48:18
Showing 1 changed files
R/geom_segment.R
History View file @ 50b227f1
... ... 
@@ -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
Browse code

test

guangchuang yu authored on 24/11/2017 07:03:01
Showing 1 changed files
R/geom_segment.R
History View file @ c4387283
... ... 
@@ -89,6 +89,7 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
89 89 
                                                    lineend = "butt", na.rm = FALSE, nudge_x = 0) {
90 90
91 91 
                                  data$x <- data$x + nudge_x
92 
+                                 ## data$x <- data$x - sapply(data$label, function(x) convertWidth(grobWidth(textGrob(x, gp=gpar(fontsize=.04* .pt))), "native", TRUE))
92 93 
                                  GeomSegment$draw_panel(data, panel_scales, coord, arrow,
93 94 
                                                         lineend, na.rm)
94 95 
                              }
Browse code

geom_tiplab enhancement

guangchuang yu authored on 20/11/2017 13:20:02
Showing 1 changed files
R/geom_segment.R
History View file @ d50bc7b6
... ... 
@@ -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
Browse code

now geom_text2, geom_label2, geom_point2 and geom_segment2 work with ggplot2

guangchuang yu authored on 01/08/2017 12:22:46
Showing 1 changed files
R/geom_segment.R
History View file @ 6d2ced4f
... ... 
@@ -18,7 +18,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
18 18
19 19 
     geom_segment2(dot_mapping,
20 20 
                   linetype=linetype,
21 
-                  size=size, ...)
21 
+                  size=size, stat = StatTreeData, ...)
22 22 
 }
23 23
24 24
... ... 
@@ -29,6 +29,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
29 29 
 ##' @title geom_segment2
30 30 
 ##' @param mapping aes mapping
31 31 
 ##' @param data data
32 
+##' @param stat Name of stat to modify data
32 33 
 ##' @param position position
33 34 
 ##' @param arrow arrow
34 35 
 ##' @param lineend lineend
... ... 
@@ -42,7 +43,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
42 43 
 ##' \link[ggplot2]{geom_segment}
43 44 
 ##' @return add segment layer
44 45 
 ##' @author Guangchuang Yu
45 
-geom_segment2 <- function(mapping = NULL, data = NULL,
46 
+geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
46 47 
                          position = "identity", arrow = NULL, lineend = "butt",
47 48 
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
48 49 
                          ...) {
... ... 
@@ -57,7 +58,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL,
57 58 
     layer(
58 59 
         data = data,
59 60 
         mapping = mapping,
60 
-        stat = StatTreeData,
61 
+        stat = stat,
61 62 
         geom = GeomSegmentGGtree,
62 63 
         position = position,
63 64 
         show.legend = show.legend,
... ... 
@@ -79,19 +80,21 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
79 80 
                                  if (is.null(data$subset))
80 81 
                                      return(data)
81 82 
                                  data[which(data$subset),]
82 
-                             },
83 
+                             }
83 84
84 
-                             draw_panel = function(data, panel_scales, coord, arrow = NULL,
85 
-                                                   lineend = "butt", na.rm = FALSE) {
85 
+                            ## ,
86 86
87 
-                                 GeomSegment$draw_panel(data, panel_scales, coord, arrow,
88 
-                                                        lineend, na.rm)
89 
-                             },
87 
+                            ##  draw_panel = function(data, panel_scales, coord, arrow = NULL,
88 
+                            ##                        lineend = "butt", na.rm = FALSE) {
90 89
91 
-                             required_aes = c("x", "y", "xend", "yend"),
92 
-                             default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
90 
+                            ##      GeomSegment$draw_panel(data, panel_scales, coord, arrow,
91 
+                            ##                             lineend, na.rm)
92 
+                            ##  },
93 93
94 
-                             draw_key = draw_key_path
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
95 98 
                              )
96 99
97 100
Browse code

subset supports logical vector contains NA, and geom_cladelabel supports parsing emoji

guangchuang yu authored on 16/02/2017 06:10:17
Showing 1 changed files
R/geom_segment.R
History View file @ 9cbaf87b
... ... 
@@ -78,7 +78,7 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
78 78 
                              setup_data = function(data, params) {
79 79 
                                  if (is.null(data$subset))
80 80 
                                      return(data)
81 
-                                 data[data$subset,]
81 
+                                 data[which(data$subset),]
82 82 
                              },
83 83
84 84 
                              draw_panel = function(data, panel_scales, coord, arrow = NULL,
Browse code

ggplot2 2.2.0

guangchuang yu authored on 14/11/2016 04:41:23
Showing 1 changed files
R/geom_segment.R
History View file @ fad06b2b
... ... 
@@ -1,6 +1,6 @@
1 1 
 ##' add horizontal align lines
2 2 
 ##'
3 
-##'
3 
+##'
4 4 
 ##' @title geom_aline
5 5 
 ##' @param mapping aes mapping
6 6 
 ##' @param linetype line type
... ... 
@@ -15,7 +15,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
15 15 
     if (!is.null(mapping)) {
16 16 
         dot_mapping <- modifyList(dot_mapping, mapping)
17 17 
     }
18 
-
18 
+
19 19 
     geom_segment2(dot_mapping,
20 20 
                   linetype=linetype,
21 21 
                   size=size, ...)
... ... 
@@ -25,9 +25,9 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
25 25
26 26 
 ##' geom_segment2 support aes(subset) via setup_data
27 27 
 ##'
28 
-##'
28 
+##'
29 29 
 ##' @title geom_segment2
30 
-##' @param mapping aes mapping
30 
+##' @param mapping aes mapping
31 31 
 ##' @param data data
32 32 
 ##' @param position position
33 33 
 ##' @param arrow arrow
... ... 
@@ -42,7 +42,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
42 42 
 ##' \link[ggplot2]{geom_segment}
43 43 
 ##' @return add segment layer
44 44 
 ##' @author Guangchuang Yu
45 
-geom_segment2 <- function(mapping = NULL, data = NULL,
45 
+geom_segment2 <- function(mapping = NULL, data = NULL,
46 46 
                          position = "identity", arrow = NULL, lineend = "butt",
47 47 
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
48 48 
                          ...) {
... ... 
@@ -53,7 +53,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL,
53 53 
     } else {
54 54 
         mapping <- modifyList(mapping, default_aes)
55 55 
     }
56 
-
56 
+
57 57 
     layer(
58 58 
         data = data,
59 59 
         mapping = mapping,
... ... 
@@ -68,7 +68,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL,
68 68 
             na.rm = na.rm,
69 69 
             ...
70 70 
         ),
71 
-        if (packageVersion('ggplot2') > '2.1.0') check.aes = FALSE
71 
+        check.aes = FALSE
72 72 
     )
73 73 
 }
74 74
... ... 
@@ -80,17 +80,17 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
80 80 
                                      return(data)
81 81 
                                  data[data$subset,]
82 82 
                              },
83 
-
83 
+
84 84 
                              draw_panel = function(data, panel_scales, coord, arrow = NULL,
85 85 
                                                    lineend = "butt", na.rm = FALSE) {
86 
-
86 
+
87 87 
                                  GeomSegment$draw_panel(data, panel_scales, coord, arrow,
88 88 
                                                         lineend, na.rm)
89 89 
                              },
90 
-
90 
+
91 91 
                              required_aes = c("x", "y", "xend", "yend"),
92 92 
                              default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
93 
-
93 
+
94 94 
                              draw_key = draw_key_path
95 95 
                              )
96 96
Browse code

fixed R check

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

g.yu authored on 11/10/2016 01:31:56
Showing 1 changed files
R/geom_segment.R
History View file @ 7ca12fe1
... ... 
@@ -68,7 +68,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL,
68 68 
             na.rm = na.rm,
69 69 
             ...
70 70 
         ),
71 
-        check.aes = FALSE
71 
+        if (packageVersion('ggplot2') > '2.1.0') check.aes = FALSE
72 72 
     )
73 73 
 }
74 74
Browse code

version 1.5.15

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

g.yu authored on 07/10/2016 05:18:29
Showing 1 changed files
R/geom_segment.R
History View file @ a92aaed1
... ... 
@@ -67,7 +67,8 @@ geom_segment2 <- function(mapping = NULL, data = NULL,
67 67 
             lineend = lineend,
68 68 
             na.rm = na.rm,
69 69 
             ...
70 
-        )
70 
+        ),
71 
+        check.aes = FALSE
71 72 
     )
72 73 
 }
73 74
Browse code

geom_label2

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

g.yu authored on 07/04/2016 04:02:44
Showing 1 changed files
R/geom_segment.R
History View file @ f35d40fd
... ... 
@@ -29,7 +29,6 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
29 29 
 ##' @title geom_segment2
30 30 
 ##' @param mapping aes mapping
31 31 
 ##' @param data data
32 
-##' @param stat stat
33 32 
 ##' @param position position
34 33 
 ##' @param arrow arrow
35 34 
 ##' @param lineend lineend
... ... 
@@ -43,7 +42,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
43 42 
 ##' \link[ggplot2]{geom_segment}
44 43 
 ##' @return add segment layer
45 44 
 ##' @author Guangchuang Yu
46 
-geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
45 
+geom_segment2 <- function(mapping = NULL, data = NULL,
47 46 
                          position = "identity", arrow = NULL, lineend = "butt",
48 47 
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
49 48 
                          ...) {
... ... 
@@ -58,7 +57,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
58 57 
     layer(
59 58 
         data = data,
60 59 
         mapping = mapping,
61 
-        stat = StatTreeSegment,
60 
+        stat = StatTreeData,
62 61 
         geom = GeomSegmentGGtree,
63 62 
         position = position,
64 63 
         show.legend = show.legend,
... ... 
@@ -95,11 +94,5 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
95 94 
                              )
96 95
97 96
98 
-StatTreeSegment <-  ggproto("StatTreeSegment", Stat,
99 
-                          required_aes = "node",
100 
-                          compute_group = function(data, scales) {
101 
-                              setup_tree_data(data)
102 
-                          }
103 
-                          )
104 97
105 98
Browse code

new features

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

g.yu authored on 16/02/2016 04:04:44
Showing 1 changed files
R/geom_segment.R
History View file @ 90df068e
... ... 
@@ -47,39 +47,59 @@ geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
47 47 
                          position = "identity", arrow = NULL, lineend = "butt",
48 48 
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
49 49 
                          ...) {
50 
-  layer(
51 
-    data = data,
52 
-    mapping = mapping,
53 
-    stat = stat,
54 
-    geom = GeomSegmentGGtree,
55 
-    position = position,
56 
-    show.legend = show.legend,
57 
-    inherit.aes = inherit.aes,
58 
-    params = list(
59 
-      arrow = arrow,
60 
-      lineend = lineend,
61 
-      na.rm = na.rm,
62 
-      ...
50 
+
51 
+    default_aes <- aes_(node=~node)
52 
+    if (is.null(mapping)) {
53 
+        mapping <- default_aes
54 
+    } else {
55 
+        mapping <- modifyList(mapping, default_aes)
56 
+    }
57 
+
58 
+    layer(
59 
+        data = data,
60 
+        mapping = mapping,
61 
+        stat = StatTreeSegment,
62 
+        geom = GeomSegmentGGtree,
63 
+        position = position,
64 
+        show.legend = show.legend,
65 
+        inherit.aes = inherit.aes,
66 
+        params = list(
67 
+            arrow = arrow,
68 
+            lineend = lineend,
69 
+            na.rm = na.rm,
70 
+            ...
71 
+        )
63 72 
     )
64 
-  )
65 73 
 }
66 74
67 75 
 ##' @importFrom ggplot2 GeomSegment
68 76 
 ##' @importFrom ggplot2 draw_key_path
69 77 
 GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
70 
-                          setup_data = function(data, params) {
71 
-                              data[data$subset,]
72 
-                          },
73 
-
74 
-                          draw_panel = function(data, panel_scales, coord, arrow = NULL,
75 
-                              lineend = "butt", na.rm = FALSE) {
78 
+                             setup_data = function(data, params) {
79 
+                                 if (is.null(data$subset))
80 
+                                     return(data)
81 
+                                 data[data$subset,]
82 
+                             },
83 
+
84 
+                             draw_panel = function(data, panel_scales, coord, arrow = NULL,
85 
+                                                   lineend = "butt", na.rm = FALSE) {
86 
+
87 
+                                 GeomSegment$draw_panel(data, panel_scales, coord, arrow,
88 
+                                                        lineend, na.rm)
89 
+                             },
90 
+
91 
+                             required_aes = c("x", "y", "xend", "yend"),
92 
+                             default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
93 
+
94 
+                             draw_key = draw_key_path
95 
+                             )
76 96
77 
-                              GeomSegment$draw_panel(data, panel_scales, coord, arrow,
78 
-                                                     lineend, na.rm)
79 
-                          },
80 
-
81 
-                          required_aes = c("x", "y", "xend", "yend"),
82 
-                          default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
83 
-
84 
-                          draw_key = draw_key_path
97 
+
98 
+StatTreeSegment <-  ggproto("StatTreeSegment", Stat,
99 
+                          required_aes = "node",
100 
+                          compute_group = function(data, scales) {
101 
+                              setup_tree_data(data)
102 
+                          }
85 103 
                           )
104 
+
105 
+
Browse code

lots updates

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

g.yu authored on 22/12/2015 04:08:02
Showing 1 changed files
R/geom_segment.R
History View file @ f1f0d8d2
... ... 
@@ -11,14 +11,75 @@
11 11 
 ##' @author Yu Guangchuang
12 12 
 geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
13 13 
     x <- y <- isTip <- NULL
14 
-    dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y)
14 
+    dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y, subset=isTip)
15 15 
     if (!is.null(mapping)) {
16 16 
         dot_mapping <- modifyList(dot_mapping, mapping)
17 17 
     }
18 18
19 
-    geom_segment(mapping,
20 
-                 subset=.(isTip),
21 
-                 linetype=linetype,
22 
-                 size=size, ...)
19 
+    geom_segment2(dot_mapping,
20 
+                  linetype=linetype,
21 
+                  size=size, ...)
23 22 
 }
24 23
24 
+
25 
+
26 
+##' geom_segment2 support aes(subset) via setup_data
27 
+##'
28 
+##'
29 
+##' @title geom_segment2
30 
+##' @param mapping aes mapping
31 
+##' @param data data
32 
+##' @param stat stat
33 
+##' @param position position
34 
+##' @param arrow arrow
35 
+##' @param lineend lineend
36 
+##' @param na.rm logical
37 
+##' @param show.legend logical
38 
+##' @param inherit.aes logical
39 
+##' @param ... additional parameter
40 
+##' @importFrom ggplot2 layer
41 
+##' @export
42 
+##' @seealso
43 
+##' \link[ggplot2]{geom_segment}
44 
+##' @return add segment layer
45 
+##' @author Guangchuang Yu
46 
+geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
47 
+                         position = "identity", arrow = NULL, lineend = "butt",
48 
+                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
49 
+                         ...) {
50 
+  layer(
51 
+    data = data,
52 
+    mapping = mapping,
53 
+    stat = stat,
54 
+    geom = GeomSegmentGGtree,
55 
+    position = position,
56 
+    show.legend = show.legend,
57 
+    inherit.aes = inherit.aes,
58 
+    params = list(
59 
+      arrow = arrow,
60 
+      lineend = lineend,
61 
+      na.rm = na.rm,
62 
+      ...
63 
+    )
64 
+  )
65 
+}
66 
+
67 
+##' @importFrom ggplot2 GeomSegment
68 
+##' @importFrom ggplot2 draw_key_path
69 
+GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
70 
+                          setup_data = function(data, params) {
71 
+                              data[data$subset,]
72 
+                          },
73 
+
74 
+                          draw_panel = function(data, panel_scales, coord, arrow = NULL,
75 
+                              lineend = "butt", na.rm = FALSE) {
76 
+
77 
+                              GeomSegment$draw_panel(data, panel_scales, coord, arrow,
78 
+                                                     lineend, na.rm)
79 
+                          },
80 
+
81 
+                          required_aes = c("x", "y", "xend", "yend"),
82 
+                          default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
83 
+
84 
+                          draw_key = draw_key_path
85 
+                          )
Browse code

revert to previous version for compatible with CRAN version of ggplot2

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

g.yu authored on 31/08/2015 03:34:32
Showing 1 changed files
R/geom_segment.R
History View file @ 45bd540d
... ... 
@@ -11,75 +11,14 @@
11 11 
 ##' @author Yu Guangchuang
12 12 
 geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
13 13 
     x <- y <- isTip <- NULL
14 
-    dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y, subset=isTip)
14 
+    dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y)
15 15 
     if (!is.null(mapping)) {
16 16 
         dot_mapping <- modifyList(dot_mapping, mapping)
17 17 
     }
18 18
19 
-    geom_segment2(dot_mapping,
20 
-                  linetype=linetype,
21 
-                  size=size, ...)
19 
+    geom_segment(mapping,
20 
+                 subset=.(isTip),
21 
+                 linetype=linetype,
22 
+                 size=size, ...)
22 23 
 }
23 24
24 
-
25 
-
26 
-##' geom_segment2 support aes(subset) via setup_data
27 
-##'
28 
-##'
29 
-##' @title geom_segment2
30 
-##' @param mapping aes mapping
31 
-##' @param data data
32 
-##' @param stat stat
33 
-##' @param position position
34 
-##' @param arrow arrow
35 
-##' @param lineend lineend
36 
-##' @param na.rm logical
37 
-##' @param show.legend logical
38 
-##' @param inherit.aes logical
39 
-##' @param ... additional parameter
40 
-##' @importFrom ggplot2 layer
41 
-##' @export
42 
-##' @seealso
43 
-##' \link[ggplot2]{geom_segment}
44 
-##' @return add segment layer
45 
-##' @author Guangchuang Yu
46 
-geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
47 
-                         position = "identity", arrow = NULL, lineend = "butt",
48 
-                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
49 
-                         ...) {
50 
-  layer(
51 
-    data = data,
52 
-    mapping = mapping,
53 
-    stat = stat,
54 
-    geom = GeomSegmentGGtree,
55 
-    position = position,
56 
-    show.legend = show.legend,
57 
-    inherit.aes = inherit.aes,
58 
-    params = list(
59 
-      arrow = arrow,
60 
-      lineend = lineend,
61 
-      na.rm = na.rm,
62 
-      ...
63 
-    )
64 
-  )
65 
-}
66 
-
67 
-##' @importFrom ggplot2 GeomSegment
68 
-##' @importFrom ggplot2 draw_key_path
69 
-GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
70 
-                          setup_data = function(data, params) {
71 
-                              data[data$subset,]
72 
-                          },
73 
-
74 
-                          draw_panel = function(data, panel_scales, coord, arrow = NULL,
75 
-                              lineend = "butt", na.rm = FALSE) {
76 
-
77 
-                              GeomSegment$draw_panel(data, panel_scales, coord, arrow,
78 
-                                                     lineend, na.rm)
79 
-                          },
80 
-
81 
-                          required_aes = c("x", "y", "xend", "yend"),
82 
-                          default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
83 
-
84 
-                          draw_key = draw_key_path
85 
-                          )
Browse code

update according to changes of ggplot2

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

g.yu authored on 28/08/2015 13:39:22
Showing 1 changed files
R/geom_segment.R
History View file @ 14435e79
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,85 @@
1 
+##' add horizontal align lines
2 
+##'
3 
+##'
4 
+##' @title geom_aline
5 
+##' @param mapping aes mapping
6 
+##' @param linetype line type
7 
+##' @param size line size
8 
+##' @param ... additional parameter
9 
+##' @return aline layer
10 
+##' @export
11 
+##' @author Yu Guangchuang
12 
+geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
13 
+    x <- y <- isTip <- NULL
14 
+    dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y, subset=isTip)
15 
+    if (!is.null(mapping)) {
16 
+        dot_mapping <- modifyList(dot_mapping, mapping)
17 
+    }
18 
+
19 
+    geom_segment2(dot_mapping,
20 
+                  linetype=linetype,
21 
+                  size=size, ...)
22 
+}
23 
+
24 
+
25 
+
26 
+##' geom_segment2 support aes(subset) via setup_data
27 
+##'
28 
+##'
29 
+##' @title geom_segment2
30 
+##' @param mapping aes mapping
31 
+##' @param data data
32 
+##' @param stat stat
33 
+##' @param position position
34 
+##' @param arrow arrow
35 
+##' @param lineend lineend
36 
+##' @param na.rm logical
37 
+##' @param show.legend logical
38 
+##' @param inherit.aes logical
39 
+##' @param ... additional parameter
40 
+##' @importFrom ggplot2 layer
41 
+##' @export
42 
+##' @seealso
43 
+##' \link[ggplot2]{geom_segment}
44 
+##' @return add segment layer
45 
+##' @author Guangchuang Yu
46 
+geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
47 
+                         position = "identity", arrow = NULL, lineend = "butt",
48 
+                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
49 
+                         ...) {
50 
+  layer(
51 
+    data = data,
52 
+    mapping = mapping,
53 
+    stat = stat,
54 
+    geom = GeomSegmentGGtree,
55 
+    position = position,
56 
+    show.legend = show.legend,
57 
+    inherit.aes = inherit.aes,
58 
+    params = list(
59 
+      arrow = arrow,
60 
+      lineend = lineend,
61 
+      na.rm = na.rm,
62 
+      ...
63 
+    )
64 
+  )
65 
+}
66 
+
67 
+##' @importFrom ggplot2 GeomSegment
68 
+##' @importFrom ggplot2 draw_key_path
69 
+GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
70 
+                          setup_data = function(data, params) {
71 
+                              data[data$subset,]
72 
+                          },
73 
+
74 
+                          draw_panel = function(data, panel_scales, coord, arrow = NULL,
75 
+                              lineend = "butt", na.rm = FALSE) {
76 
+
77 
+                              GeomSegment$draw_panel(data, panel_scales, coord, arrow,
78 
+                                                     lineend, na.rm)
79 
+                          },
80 
+
81 
+                          required_aes = c("x", "y", "xend", "yend"),
82 
+                          default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
83 
+
84 
+                          draw_key = draw_key_path
85 
+                          )