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

Document update

Document update

William Lee authored on 22/03/2022 14:46:29
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 3c7f66c8
... ... 
@@ -18,7 +18,7 @@
18 18 
 ##' @param family sans by default, can be any supported font
19 19 
 ##' @param parse logical, whether parse label
20 20 
 ##' @param horizontal logical, whether set label to horizontal,
21 
-##' default is TRUE.
21 
+##' defaults to TRUE.
22 22 
 ##' @param ... additional parameter
23 23 
 ##' @return ggplot layers
24 24 
 ##' @export
Browse code

update adjust_cladelabel_angle

Guangchuang Yu authored on 15/06/2020 09:26:06
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 1a1f9c29
... ... 
@@ -307,18 +307,19 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0, hor
307 307
308 308 
 }
309 309
310 
-adjust_cladelabel_angle <- function(angle, horizontal){
311 
-    if (horizontal){
312 
-        #if (angle >= 90 & angle <= 270){
313 
-        #    angle <- angle + 180
314 
-        #}
315 
-        angle <- angle
316 
-    }else{
317 
-        if(angle > 180){
318 
-            angle <- angle + 90
319 
-        }else{
320 
-            angle <- angle + 270
321 
-        }
310 
+adjust_cladelabel_angle <- function(angle, horizontal) {
311 
+    if (horizontal) {
312 
+        ## if (angle >= 90 & angle <= 270){
313 
+        ##     angle <- angle + 180
314 
+        ## }
315 
+        return(angle)
322 316 
     }
317 
+
318 
+    if (angle > 180) {
319 
+        angle <- angle + 90
320 
+    } else {
321 
+        angle <- angle + 270
322 
+    }
323 
+
323 324 
     return(angle)
324 325 
 }
Browse code

keep original angle when horizontal is TRUE

xiangpin authored on 15/06/2020 08:44:22
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 4ef53e98
... ... 
@@ -309,9 +309,10 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0, hor
309 309
310 310 
 adjust_cladelabel_angle <- function(angle, horizontal){
311 311 
     if (horizontal){
312 
-        if (angle >= 90 & angle <= 270){
313 
-            angle <- angle + 180
314 
-        }
312 
+        #if (angle >= 90 & angle <= 270){
313 
+        #    angle <- angle + 180
314 
+        #}
315 
+        angle <- angle
315 316 
     }else{
316 317 
         if(angle > 180){
317 318 
             angle <- angle + 90
Browse code

modified the angle of clade labels and add horizontal parameter

xiangpin authored on 15/06/2020 05:03:03
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 47e2bd9f
... ... 
@@ -17,6 +17,8 @@
17 17 
 ##' @param fill fill label background, only work with geom='label'
18 18 
 ##' @param family sans by default, can be any supported font
19 19 
 ##' @param parse logical, whether parse label
20 
+##' @param horizontal logical, whether set label to horizontal,
21 
+##' default is TRUE.
20 22 
 ##' @param ... additional parameter
21 23 
 ##' @return ggplot layers
22 24 
 ##' @export
... ... 
@@ -36,6 +38,7 @@ geom_cladelabel <- function(node, label,
36 38 
                             fill        = NA,
37 39 
                             family      = "sans",
38 40 
                             parse       = FALSE,
41 
+                            horizontal  = TRUE,
39 42 
                             ...) {
40 43
41 44 
     structure(list(node = node,
... ... 
@@ -53,6 +56,7 @@ geom_cladelabel <- function(node, label,
53 56 
                    fill = fill,
54 57 
                    family = family,
55 58 
                    parse = parse,
59 
+                   horizontal = horizontal,
56 60 
                    ...),
57 61 
               class = 'cladelabel')
58 62 
 }
... ... 
@@ -72,6 +76,7 @@ geom_cladelabel_rectangular <- function(node, label,
72 76 
                             fill        = NA,
73 77 
                             family      = "sans",
74 78 
                             parse       = FALSE,
79 
+                            horizontal  = TRUE,
75 80 
                             ...) {
76 81 
     mapping <- NULL
77 82 
     data <- NULL
... ... 
@@ -109,7 +114,8 @@ geom_cladelabel_rectangular <- function(node, label,
109 114 
                                         align=align, size=fontsize, angle=angle, family=family,
110 115 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
111 116 
                                         position=position, show.legend = show.legend,
112 
-                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)
117 
+                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse,
118 
+                                        horizontal=horizontal, ...)
113 119
114 120 
         } else {
115 121 
             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
... ... 
@@ -117,7 +123,7 @@ geom_cladelabel_rectangular <- function(node, label,
117 123 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
118 124 
                                         position=position, show.legend = show.legend,
119 125 
                                         inherit.aes = inherit.aes, na.rm=na.rm,
120 
-                                        parse = parse,  ...)
126 
+                                        parse = parse,  horizontal=horizontal, ...)
121 127 
         }
122 128
123 129 
         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
... ... 
@@ -132,7 +138,7 @@ geom_cladelabel_rectangular <- function(node, label,
132 138 
                                         align=align, size=fontsize, angle=angle, color=labelcolor, family=family,
133 139 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
134 140 
                                         position=position, show.legend = show.legend,
135 
-                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse,  ...)
141 
+                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, horizontal=horizontal, ...)
136 142
137 143 
         } else {
138 144 
             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
... ... 
@@ -141,7 +147,7 @@ geom_cladelabel_rectangular <- function(node, label,
141 147 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
142 148 
                                         position=position, show.legend = show.legend,
143 149 
                                         inherit.aes = inherit.aes, na.rm=na.rm,
144 
-                                        parse = parse,  ...)
150 
+                                        parse = parse, horizontal=horizontal, ...)
145 151 
         }
146 152
147 153 
         layer_bar <- stat_cladeBar(node        = node,
... ... 
@@ -171,7 +177,7 @@ stat_cladeText <- function(mapping = NULL, data = NULL,
171 177 
                            geom = "text", position = "identity",
172 178 
                            node, label, offset, align, ..., angle,
173 179 
                            show.legend = NA, inherit.aes = FALSE,
174 
-                           na.rm = FALSE, parse = FALSE) {
180 
+                           na.rm = FALSE, parse = FALSE, horizontal=TRUE) {
175 181
176 182 
     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, angle=~angle)
177 183 
     if (is.null(mapping)) {
... ... 
@@ -194,6 +200,7 @@ stat_cladeText <- function(mapping = NULL, data = NULL,
194 200 
                       na.rm  = na.rm,
195 201 
                       parse  = parse,
196 202 
                       angle_ = angle,
203 
+                      horizontal = horizontal,
197 204 
                       ...),
198 205 
           check.aes = FALSE
199 206 
           )
... ... 
@@ -232,8 +239,9 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,
232 239 
 }
233 240
234 241 
 StatCladeText <- ggproto("StatCladeText", Stat,
235 
-                         compute_group = function(self, data, scales, params, node, label, offset, align, angle_) {
236 
-                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03, angle_)
242 
+                         compute_group = function(self, data, scales, params, node, label, offset, align, angle_, horizontal) {
243 
+                             df <- get_cladelabel_position(data=data, node=node, offset=offset, align=align,
244 
+                                                           adjustRatio = 1.03, angle=angle_, horizontal=horizontal)
237 245 
                              df$y <- mean(c(df$y, df$yend))
238 246 
                              df$label <- label
239 247 
                              return(df)
... ... 
@@ -251,8 +259,8 @@ StatCladeBar <- ggproto("StatCladBar", Stat,
251 259
252 260
253 261 
 get_cladelabel_position <- function(data, node, offset, align,
254 
-                                    adjustRatio, angle="auto", extend=0) {
255 
-    df <- get_cladelabel_position_(data, node, angle, extend)
262 
+                                    adjustRatio, angle="auto", extend=0, horizontal=TRUE) {
263 
+    df <- get_cladelabel_position_(data=data, node=node, angle=angle, extend=extend, horizontal=horizontal)
256 264 
     if (align) {
257 265 
         # Find max x value for all tree nodes so all clade labels align to same position.
258 266 
         mx <- max(data$x, na.rm=TRUE)
... ... 
@@ -271,7 +279,7 @@ get_cladelabel_position <- function(data, node, offset, align,
271 279 
 }
272 280
273 281 
 # get x, y and yend of clade region.
274 
-get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
282 
+get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0, horizontal=TRUE) {
275 283 
     if (length(extend) == 1) {
276 284 
         extend = rep(extend, 2)
277 285 
     }
... ... 
@@ -289,14 +297,27 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
289 297 
     d <- data.frame(x=mx, y=min(y) - extend[2], yend=max(y) + extend[1])
290 298 
     if (missing(angle))
291 299 
         return(d)
292 
-
293 300 
     if (angle == "auto") {
294 301 
         d$angle <- mean(range(sp.df$angle))
302 
+        d$angle <- adjust_cladelabel_angle(angle=d$angle, horizontal=horizontal)
295 303 
     } else {
296 304 
         d$angle <- angle
297 305 
     }
298 
-
299 306 
     return(d)
300 307
301 308 
 }
302 309
310 
+adjust_cladelabel_angle <- function(angle, horizontal){
311 
+    if (horizontal){
312 
+        if (angle >= 90 & angle <= 270){
313 
+            angle <- angle + 180
314 
+        }
315 
+    }else{
316 
+        if(angle > 180){
317 
+            angle <- angle + 90
318 
+        }else{
319 
+            angle <- angle + 270
320 
+        }
321 
+    }
322 
+    return(angle)
323 
+}
Browse code

roxygen2md

Guangchuang Yu authored on 01/11/2019 04:24:00
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 1540db03
... ... 
@@ -21,7 +21,7 @@
21 21 
 ##' @return ggplot layers
22 22 
 ##' @export
23 23 
 ##' @author Guangchuang Yu
24 
-##' @seealso \link{geom_cladelabel2}
24 
+##' @seealso [geom_cladelabel2]
25 25 
 geom_cladelabel <- function(node, label,
26 26 
                             offset      = 0,
27 27 
                             offset.text = 0,
Browse code

offsprint

Guangchuang Yu authored on 06/09/2019 03:37:00
Showing 1 changed files
R/geom_cladelabel.R
History View file @ ef819358
... ... 
@@ -280,7 +280,7 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
280 280 
     ## sp2 <- c(sp, node)
281 281 
     ## sp.df <- data[match(sp2, data$node),]
282 282
283 
-    sp.df <- tidytree:::offspring.tbl_tree(data, node, self_include = TRUE)
283 
+    sp.df <- offspring.tbl_tree(data, node, self_include = TRUE)
284 284
285 285 
     y <- sp.df$y
286 286 
     y <- y[!is.na(y)]
Browse code

geom_strip

Guangchuang Yu authored on 27/08/2019 05:12:46
Showing 1 changed files
R/geom_cladelabel.R
History View file @ ee07f0c3
... ... 
@@ -136,7 +136,8 @@ geom_cladelabel_rectangular <- function(node, label,
136 136
137 137 
         } else {
138 138 
             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
139 
-                                        align=align, size=fontsize, angle=angle, color=labelcolor, fill=fill,family=family,
139 
+                                        align=align, size=fontsize, angle=angle, color=labelcolor,
140 
+                                        fill=fill,family=family,
140 141 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
141 142 
                                         position=position, show.legend = show.legend,
142 143 
                                         inherit.aes = inherit.aes, na.rm=na.rm,
... ... 
@@ -242,13 +243,15 @@ StatCladeText <- ggproto("StatCladeText", Stat,
242 243
243 244 
 StatCladeBar <- ggproto("StatCladBar", Stat,
244 245 
                         compute_group = function(self, data, scales, params, node, offset, align, extend) {
245 
-                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02, angle=0, extend=extend)
246 
+                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02,
247 
+                                                    angle=0, extend=extend)
246 248 
                         },
247 249 
                         required_aes = c("x", "y", "xend", "yend")
248 250 
 )
249 251
250 252
251 
-get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angle="auto", extend=0) {
253 
+get_cladelabel_position <- function(data, node, offset, align,
254 
+                                    adjustRatio, angle="auto", extend=0) {
252 255 
     df <- get_cladelabel_position_(data, node, angle, extend)
253 256 
     if (align) {
254 257 
         # Find max x value for all tree nodes so all clade labels align to same position.
Browse code

geom_cladelabel now supports unrooted tree

Guangchuang Yu authored on 13/08/2019 16:09:40
Showing 1 changed files
R/geom_cladelabel.R
History View file @ aff471e1
... ... 
@@ -37,6 +37,42 @@ geom_cladelabel <- function(node, label,
37 37 
                             family      = "sans",
38 38 
                             parse       = FALSE,
39 39 
                             ...) {
40 
+
41 
+    structure(list(node = node,
42 
+                   label = label,
43 
+                   offset = offset,
44 
+                   offset.text = offset.text,
45 
+                   extend = extend,
46 
+                   align =  align,
47 
+                   barsize = barsize,
48 
+                   fontsize = fontsize,
49 
+                   angle = angle,
50 
+                   geom = geom,
51 
+                   hjust = hjust,
52 
+                   color = color,
53 
+                   fill = fill,
54 
+                   family = family,
55 
+                   parse = parse,
56 
+                   ...),
57 
+              class = 'cladelabel')
58 
+}
59 
+
60 
+
61 
+geom_cladelabel_rectangular <- function(node, label,
62 
+                            offset      = 0,
63 
+                            offset.text = 0,
64 
+                            extend      = 0,
65 
+                            align       = FALSE,
66 
+                            barsize     = 0.5,
67 
+                            fontsize    = 3.88,
68 
+                            angle       = 0,
69 
+                            geom        = "text",
70 
+                            hjust       = 0,
71 
+                            color       = NULL,
72 
+                            fill        = NA,
73 
+                            family      = "sans",
74 
+                            parse       = FALSE,
75 
+                            ...) {
40 76 
     mapping <- NULL
41 77 
     data <- NULL
42 78 
     position <- "identity"
Browse code

Cross link geom_cladelabel and geom_cladelabel2

Hugo Gruson authored on 26/06/2019 12:59:12
Showing 1 changed files
R/geom_cladelabel.R
History View file @ c072cd2e
... ... 
@@ -12,7 +12,7 @@
12 12 
 ##' @param fontsize size of text
13 13 
 ##' @param angle angle of text
14 14 
 ##' @param geom one of 'text' or 'label'
15 
-##' @param hjust hjust
15 
+##' @param hjust justify text horizontally
16 16 
 ##' @param color color for clade & label, of length 1 or 2
17 17 
 ##' @param fill fill label background, only work with geom='label'
18 18 
 ##' @param family sans by default, can be any supported font
... ... 
@@ -21,6 +21,7 @@
21 21 
 ##' @return ggplot layers
22 22 
 ##' @export
23 23 
 ##' @author Guangchuang Yu
24 
+##' @seealso \link{geom_cladelabel2}
24 25 
 geom_cladelabel <- function(node, label,
25 26 
                             offset      = 0,
26 27 
                             offset.text = 0,
Browse code

bug fixed for geom_hilight, in tidytree

Guangchuang Yu authored on 26/02/2019 09:16:33
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 7566a86d
... ... 
@@ -240,7 +240,7 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
240 240 
     ## sp2 <- c(sp, node)
241 241 
     ## sp.df <- data[match(sp2, data$node),]
242 242
243 
-    sp.df <- offspring(data, node, self_include = TRUE)
243 
+    sp.df <- tidytree:::offspring.tbl_tree(data, node, self_include = TRUE)
244 244
245 245 
     y <- sp.df$y
246 246 
     y <- y[!is.na(y)]
Browse code

remove get.offspring.df & get.offspring.tip

Guangchuang Yu authored on 28/01/2019 09:12:15
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 1dd645ce
... ... 
@@ -236,9 +236,11 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
236 236 
         extend = rep(extend, 2)
237 237 
     }
238 238
239 
-    sp <- get.offspring.df(data, node)
240 
-    sp2 <- c(sp, node)
241 
-    sp.df <- data[match(sp2, data$node),]
239 
+    ## sp <- get.offspring.df(data, node)
240 
+    ## sp2 <- c(sp, node)
241 
+    ## sp.df <- data[match(sp2, data$node),]
242 
+
243 
+    sp.df <- offspring(data, node, self_include = TRUE)
242 244
243 245 
     y <- sp.df$y
244 246 
     y <- y[!is.na(y)]
Browse code

extend parameter in geom_cladelabel and geom_strip

guangchuang yu authored on 06/07/2018 07:23:52
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 41c82a6c
... ... 
@@ -232,6 +232,9 @@ get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angl
232 232
233 233 
 # get x, y and yend of clade region.
234 234 
 get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
235 
+    if (length(extend) == 1) {
236 
+        extend = rep(extend, 2)
237 
+    }
235 238
236 239 
     sp <- get.offspring.df(data, node)
237 240 
     sp2 <- c(sp, node)
... ... 
@@ -241,7 +244,7 @@ get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
241 244 
     y <- y[!is.na(y)]
242 245 
     mx <- max(sp.df$x, na.rm=TRUE)
243 246
244 
-    d <- data.frame(x=mx, y=min(y) - extend, yend=max(y) + extend)
247 
+    d <- data.frame(x=mx, y=min(y) - extend[2], yend=max(y) + extend[1])
245 248 
     if (missing(angle))
246 249 
         return(d)
247 250
Browse code

compatible with ggplot2-dev

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

Merged changes from upstream into origin branches.

Merge remote-tracking branch 'upstream/master'

# Conflicts:
# R/geom_cladelabel.R
# R/geom_hilight.R

JustGitting authored on 12/09/2017 01:52:08
Showing 0 changed files
Browse code

add extend parameter in geom_cladelabel

guangchuang yu authored on 26/07/2017 02:13:53
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 353dfa09
... ... 
@@ -6,6 +6,7 @@
6 6 
 ##' @param label clade label
7 7 
 ##' @param offset offset of bar and text from the clade
8 8 
 ##' @param offset.text offset of text from bar
9 
+##' @param extend extend bar height
9 10 
 ##' @param align logical
10 11 
 ##' @param barsize size of bar
11 12 
 ##' @param fontsize size of text
... ... 
@@ -20,11 +21,21 @@
20 21 
 ##' @return ggplot layers
21 22 
 ##' @export
22 23 
 ##' @author Guangchuang Yu
23 
-geom_cladelabel <- function(node, label, offset=0, offset.text=0,
24 
-                            align=FALSE, barsize=0.5, fontsize=3.88,
25 
-                            angle=0, geom="text", hjust = 0,
26 
-                            color = NULL, fill=NA,
27 
-                            family="sans", parse=FALSE, ...) {
24 
+geom_cladelabel <- function(node, label,
25 
+                            offset      = 0,
26 
+                            offset.text = 0,
27 
+                            extend      = 0,
28 
+                            align       = FALSE,
29 
+                            barsize     = 0.5,
30 
+                            fontsize    = 3.88,
31 
+                            angle       = 0,
32 
+                            geom        = "text",
33 
+                            hjust       = 0,
34 
+                            color       = NULL,
35 
+                            fill        = NA,
36 
+                            family      = "sans",
37 
+                            parse       = FALSE,
38 
+                            ...) {
28 39 
     mapping <- NULL
29 40 
     data <- NULL
30 41 
     position <- "identity"
... ... 
@@ -73,7 +84,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
73 84 
         }
74 85
75 86 
         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
76 
-                                   size=barsize,
87 
+                                   size=barsize, extend = extend,
77 88 
                                    mapping=mapping, data=data,
78 89 
                                    position=position, show.legend = show.legend,
79 90 
                                    inherit.aes = inherit.aes, na.rm=na.rm, ...)
... ... 
@@ -95,11 +106,18 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
95 106 
                                         parse = parse,  ...)
96 107 
         }
97 108
98 
-        layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
99 
-                                   size=barsize, color = barcolor,
100 
-                                   mapping=mapping, data=data,
101 
-                                   position=position, show.legend = show.legend,
102 
-                                   inherit.aes = inherit.aes, na.rm=na.rm, ...)
109 
+        layer_bar <- stat_cladeBar(node        = node,
110 
+                                   offset      = offset,
111 
+                                   align       = align,
112 
+                                   size        = barsize,
113 
+                                   color       = barcolor,
114 
+                                   extend      = extend,
115 
+                                   mapping     = mapping,
116 
+                                   data        = data,
117 
+                                   position    = position,
118 
+                                   show.legend = show.legend,
119 
+                                   inherit.aes = inherit.aes,
120 
+                                   na.rm       = na.rm, ...)
103 121
104 122 
     }
105 123
... ... 
@@ -110,11 +128,11 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
110 128 
 }
111 129
112 130
113 
-stat_cladeText <- function(mapping=NULL, data=NULL,
114 
-                           geom="text", position="identity",
131 
+stat_cladeText <- function(mapping = NULL, data = NULL,
132 
+                           geom = "text", position = "identity",
115 133 
                            node, label, offset, align, ..., angle,
116 
-                           show.legend=NA, inherit.aes=FALSE,
117 
-                           na.rm=FALSE, parse=FALSE) {
134 
+                           show.legend = NA, inherit.aes = FALSE,
135 
+                           na.rm = FALSE, parse = FALSE) {
118 136 
     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, angle=~angle)
119 137 
     if (is.null(mapping)) {
120 138 
         mapping <- default_aes
... ... 
@@ -122,14 +140,14 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
122 140 
         mapping <- modifyList(mapping, default_aes)
123 141 
     }
124 142
125 
-    layer(stat=StatCladeText,
126 
-          data=data,
127 
-          mapping=mapping,
128 
-          geom=geom,
129 
-          position=position,
143 
+    layer(stat = StatCladeText,
144 
+          data = data,
145 
+          mapping = mapping,
146 
+          geom = geom,
147 
+          position = position,
130 148 
           show.legend = show.legend,
131 149 
           inherit.aes = inherit.aes,
132 
-          params=list(node=node,
150 
+          params=list(node   = node,
133 151 
                       label  = label,
134 152 
                       offset = offset,
135 153 
                       align  = align,
... ... 
@@ -144,7 +162,7 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
144 162
145 163 
 stat_cladeBar <- function(mapping=NULL, data=NULL,
146 164 
                           geom="segment", position="identity",
147 
-                          node, offset, align,  ...,
165 
+                          node, offset, align, extend,  ...,
148 166 
                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
149 167 
     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)
150 168 
     if (is.null(mapping)) {
... ... 
@@ -153,17 +171,18 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,
153 171 
         mapping <- modifyList(mapping, default_aes)
154 172 
     }
155 173
156 
-    layer(stat=StatCladeBar,
157 
-          data=data,
158 
-          mapping=mapping,
159 
-          geom=geom,
160 
-          position=position,
174 
+    layer(stat = StatCladeBar,
175 
+          data = data,
176 
+          mapping = mapping,
177 
+          geom = geom,
178 
+          position = position,
161 179 
           show.legend = show.legend,
162 180 
           inherit.aes = inherit.aes,
163 
-          params=list(node=node,
164 
-                      offset=offset,
165 
-                      align=align,
166 
-                      na.rm=na.rm,
181 
+          params = list(node = node,
182 
+                      offset = offset,
183 
+                      extend = extend,
184 
+                      align  = align,
185 
+                      na.rm  = na.rm,
167 186 
                       ...),
168 187 
           check.aes = FALSE
169 188 
           )
... ... 
@@ -182,15 +201,15 @@ StatCladeText <- ggproto("StatCladeText", Stat,
182 201
183 202
184 203 
 StatCladeBar <- ggproto("StatCladBar", Stat,
185 
-                        compute_group = function(self, data, scales, params, node, offset, align) {
186 
-                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02, angle=0)
204 
+                        compute_group = function(self, data, scales, params, node, offset, align, extend) {
205 
+                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02, angle=0, extend=extend)
187 206 
                         },
188 207 
                         required_aes = c("x", "y", "xend", "yend")
189 208 
                         )
190 209
191 210
192 
-get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angle="auto") {
193 
-    df <- get_cladelabel_position_(data, node, angle)
211 
+get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angle="auto", extend=0) {
212 
+    df <- get_cladelabel_position_(data, node, angle, extend)
194 213 
     if (align) {
195 214 
         mx <- max(data$x, na.rm=TRUE)
196 215 
     } else {
... ... 
@@ -203,12 +222,12 @@ get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angl
203 222 
     ## }
204 223
205 224 
     mx <- mx * adjustRatio + offset
206 
-
225 
+
207 226 
     data.frame(x=mx, xend=mx, y=df$y, yend=df$yend, angle=angle)
208 227 
 }
209 228
210 229
211 
-get_cladelabel_position_ <- function(data, node, angle="auto") {
230 
+get_cladelabel_position_ <- function(data, node, angle = "auto", extend = 0) {
212 231 
     sp <- get.offspring.df(data, node)
213 232 
     sp2 <- c(sp, node)
214 233 
     sp.df <- data[match(sp2, data$node),]
... ... 
@@ -217,7 +236,7 @@ get_cladelabel_position_ <- function(data, node, angle="auto") {
217 236 
     y <- y[!is.na(y)]
218 237 
     mx <- max(sp.df$x, na.rm=TRUE)
219 238
220 
-    d <- data.frame(x=mx, y=min(y), yend=max(y))
239 
+    d <- data.frame(x=mx, y=min(y) - extend, yend=max(y) + extend)
221 240 
     if (missing(angle))
222 241 
         return(d)
223 242
... ... 
@@ -226,6 +245,7 @@ get_cladelabel_position_ <- function(data, node, angle="auto") {
226 245 
     } else {
227 246 
         d$angle <- angle
228 247 
     }
248 
+
229 249 
     return(d)
230 250 
 }
231 251
Browse code

Pulled from origin (forked ggtree on github) and fixed differences.

Merge branch 'master' of https://github.com/JustGitting/ggtree

# Conflicts:
# R/geom_cladelabel.R
# R/tidytree.R

JustGitting authored on 29/06/2017 04:05:50
Showing 0 changed files
Browse code

Added revised geom_hilight_encircle() function to highlight clades of unrooted trees.

Fixed layoutDaylight ave_change calculation.

Fixed bug in getTreeArcAngles() for cases where the branch root node and origin node are the same.

Added getNodeEuclDistances() function.

Fixed isTip() function to check if nodes has children, instead of checking of the data variable had the isTip field set.

JustGitting authored on 29/06/2017 03:43:04
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 9a1c4d17
... ... 
@@ -94,18 +94,18 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
94 94 
                                         inherit.aes = inherit.aes, na.rm=na.rm,
95 95 
                                         parse = parse, ...)
96 96 
         }
97 
-
98 
-        layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
99 
-                                   size=barsize, color = barcolor,
100 
-                                   mapping=mapping, data=data,
101 
-                                   position=position, show.legend = show.legend,
102 
-                                   inherit.aes = inherit.aes, na.rm=na.rm, ...)
103 
-
97 
+
98 
+      layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
99 
+                                 size=barsize, color = barcolor,
100 
+                                 mapping=mapping, data=data,
101 
+                                 position=position, show.legend = show.legend,
102 
+                                 inherit.aes = inherit.aes, na.rm=na.rm, ...)
103 
+
104 104 
     }
105 
-
105 
+
106 106 
     list(
107 
-       layer_bar,
108 
-       layer_text
107 
+      layer_bar,
108 
+      layer_text
109 109 
     )
110 110 
 }
111 111
... ... 
@@ -115,99 +115,100 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
115 115 
                            node, label, offset, align, ...,
116 116 
                            show.legend=NA, inherit.aes=FALSE,
117 117 
                            na.rm=FALSE, parse=FALSE) {
118 
-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)
119 
-    if (is.null(mapping)) {
120 
-        mapping <- default_aes
121 
-    } else {
122 
-        mapping <- modifyList(mapping, default_aes)
123 
-    }
124 
-
125 
-    layer(stat=StatCladeText,
126 
-          data=data,
127 
-          mapping=mapping,
128 
-          geom=geom,
129 
-          position=position,
130 
-          show.legend = show.legend,
131 
-          inherit.aes = inherit.aes,
132 
-          params=list(node=node,
133 
-                      label  = label,
134 
-                      offset = offset,
135 
-                      align  = align,
136 
-                      na.rm  = na.rm,
137 
-                      parse  = parse,
138 
-                      ...),
139 
-          check.aes = FALSE
140 
-          )
141 
-
118 
+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)
119 
+  if (is.null(mapping)) {
120 
+    mapping <- default_aes
121 
+  } else {
122 
+    mapping <- modifyList(mapping, default_aes)
123 
+  }
124 
+
125 
+  layer(stat=StatCladeText,
126 
+        data=data,
127 
+        mapping=mapping,
128 
+        geom=geom,
129 
+        position=position,
130 
+        show.legend = show.legend,
131 
+        inherit.aes = inherit.aes,
132 
+        params=list(node=node,
133 
+                    label  = label,
134 
+                    offset = offset,
135 
+                    align  = align,
136 
+                    na.rm  = na.rm,
137 
+                    parse  = parse,
138 
+                    ...),
139 
+        check.aes = FALSE
140 
+  )
141 
+
142 142 
 }
143 143
144 144 
 stat_cladeBar <- function(mapping=NULL, data=NULL,
145 145 
                           geom="segment", position="identity",
146 146 
                           node, offset, align,  ...,
147 147 
                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
148 
-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)
149 
-    if (is.null(mapping)) {
150 
-        mapping <- default_aes
151 
-    } else {
152 
-        mapping <- modifyList(mapping, default_aes)
153 
-    }
154 
-
155 
-    layer(stat=StatCladeBar,
156 
-          data=data,
157 
-          mapping=mapping,
158 
-          geom=geom,
159 
-          position=position,
160 
-          show.legend = show.legend,
161 
-          inherit.aes = inherit.aes,
162 
-          params=list(node=node,
163 
-                      offset=offset,
164 
-                      align=align,
165 
-                      na.rm=na.rm,
166 
-                      ...),
167 
-          check.aes = FALSE
168 
-          )
148 
+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)
149 
+  if (is.null(mapping)) {
150 
+    mapping <- default_aes
151 
+  } else {
152 
+    mapping <- modifyList(mapping, default_aes)
153 
+  }
154 
+
155 
+  layer(stat=StatCladeBar,
156 
+        data=data,
157 
+        mapping=mapping,
158 
+        geom=geom,
159 
+        position=position,
160 
+        show.legend = show.legend,
161 
+        inherit.aes = inherit.aes,
162 
+        params=list(node=node,
163 
+                    offset=offset,
164 
+                    align=align,
165 
+                    na.rm=na.rm,
166 
+                    ...),
167 
+        check.aes = FALSE
168 
+  )
169 169 
 }
170 170
171 171 
 StatCladeText <- ggproto("StatCladeText", Stat,
172 172 
                          compute_group = function(self, data, scales, params, node, label, offset, align) {
173 
-                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03)
174 
-                             df$y <- mean(c(df$y, df$yend))
175 
-                             df$label <- label
176 
-                             return(df)
173 
+                           df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03)
174 
+                           df$y <- mean(c(df$y, df$yend))
175 
+                           df$label <- label
176 
+                           return(df)
177 177 
                          },
178 178 
                          required_aes = c("x", "y", "label")
179 
-                         )
179 
+)
180 180
181 181
182 182
183 183 
 StatCladeBar <- ggproto("StatCladBar", Stat,
184 184 
                         compute_group = function(self, data, scales, params, node, offset, align) {
185 
-                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)
185 
+                          get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)
186 186 
                         },
187 187 
                         required_aes = c("x", "y", "xend", "yend")
188 
-                        )
188 
+)
189 189
190 190
191 191 
 get_cladelabel_position <- function(data, node, offset, align, adjustRatio) {
192 
-    df <- get_cladelabel_position_(data, node)
193 
-    if (align) {
194 
-        mx <- max(data$x, na.rm=TRUE)
195 
-    } else {
196 
-        mx <- df$x
197 
-    }
198 
-    mx <- mx * adjustRatio + offset
199 
-    data.frame(x=mx, xend=mx, y=df$y, yend=df$yend)
192 
+  df <- get_cladelabel_position_(data, node)
193 
+  if (align) {
194 
+    # Find max x value for all tree nodes so all clade labels align to same position.
195 
+    mx <- max(data$x, na.rm=TRUE)
196 
+  } else {
197 
+    mx <- df$x
198 
+  }
199 
+  mx <- mx * adjustRatio + offset
200 
+  data.frame(x=mx, xend=mx, y=df$y, yend=df$yend)
200 201 
 }
201 202
202 
-
203 
+# get x, y and yend of clade region.
203 204 
 get_cladelabel_position_ <- function(data, node) {
204 
-    sp <- get.offspring.df(data, node)
205 
-    sp2 <- c(sp, node)
206 
-    sp.df <- data[match(sp2, data$node),]
207 
-
208 
-    y <- sp.df$y
209 
-    y <- y[!is.na(y)]
210 
-    mx <- max(sp.df$x, na.rm=TRUE)
211 
-    data.frame(x=mx, y=min(y), yend=max(y))
205 
+  sp <- get.offspring.df(data, node)
206 
+  sp2 <- c(sp, node)
207 
+  sp.df <- data[match(sp2, data$node),]
208 
+
209 
+  y <- sp.df$y
210 
+  y <- y[!is.na(y)]
211 
+  mx <- max(sp.df$x, na.rm=TRUE)
212 
+  data.frame(x=mx, y=min(y), yend=max(y))
212 213 
 }
213 214
Browse code

geom_cladelabel now support `angle="auto"`

GuangchuangYu authored on 05/05/2017 21:01:50
Showing 1 changed files
R/geom_cladelabel.R
History View file @ 7c29b848
... ... 
@@ -69,7 +69,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
69 69 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
70 70 
                                         position=position, show.legend = show.legend,
71 71 
                                         inherit.aes = inherit.aes, na.rm=na.rm,
72 
-                                        parse = parse, ...)
72 
+                                        parse = parse,  ...)
73 73 
         }
74 74
75 75 
         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
... ... 
@@ -84,7 +84,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
84 84 
                                         align=align, size=fontsize, angle=angle, color=labelcolor, family=family,
85 85 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
86 86 
                                         position=position, show.legend = show.legend,
87 
-                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)
87 
+                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse,  ...)
88 88
89 89 
         } else {
90 90 
             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
... ... 
@@ -92,7 +92,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
92 92 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
93 93 
                                         position=position, show.legend = show.legend,
94 94 
                                         inherit.aes = inherit.aes, na.rm=na.rm,
95 
-                                        parse = parse, ...)
95 
+                                        parse = parse,  ...)
96 96 
         }
97 97
98 98 
         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
... ... 
@@ -112,10 +112,10 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
112 112
113 113 
 stat_cladeText <- function(mapping=NULL, data=NULL,
114 114 
                            geom="text", position="identity",
115 
-                           node, label, offset, align, ...,
115 
+                           node, label, offset, align, ..., angle,
116 116 
                            show.legend=NA, inherit.aes=FALSE,
117 117 
                            na.rm=FALSE, parse=FALSE) {
118 
-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)
118 
+    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, angle=~angle)
119 119 
     if (is.null(mapping)) {
120 120 
         mapping <- default_aes
121 121 
     } else {
... ... 
@@ -135,6 +135,7 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
135 135 
                       align  = align,
136 136 
                       na.rm  = na.rm,
137 137 
                       parse  = parse,
138 
+                      angle_ = angle,
138 139 
                       ...),
139 140 
           check.aes = FALSE
140 141 
           )
... ... 
@@ -169,38 +170,45 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,
169 170 
 }
170 171
171 172 
 StatCladeText <- ggproto("StatCladeText", Stat,
172 
-                         compute_group = function(self, data, scales, params, node, label, offset, align) {
173 
-                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03)
173 
+                         compute_group = function(self, data, scales, params, node, label, offset, align, angle_) {
174 
+                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03, angle_)
174 175 
                              df$y <- mean(c(df$y, df$yend))
175 176 
                              df$label <- label
176 177 
                              return(df)
177 178 
                          },
178 
-                         required_aes = c("x", "y", "label")
179 
+                         required_aes = c("x", "y", "label", "angle")
179 180 
                          )
180 181
181 182
182 183
183 184 
 StatCladeBar <- ggproto("StatCladBar", Stat,
184 185 
                         compute_group = function(self, data, scales, params, node, offset, align) {
185 
-                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)
186 
+                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02, angle=0)
186 187 
                         },
187 188 
                         required_aes = c("x", "y", "xend", "yend")
188 189 
                         )
189 190
190 191
191 
-get_cladelabel_position <- function(data, node, offset, align, adjustRatio) {
192 
-    df <- get_cladelabel_position_(data, node)
192 
+get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angle="auto") {
193 
+    df <- get_cladelabel_position_(data, node, angle)
193 194 
     if (align) {
194 195 
         mx <- max(data$x, na.rm=TRUE)
195 196 
     } else {
196 197 
         mx <- df$x
197 198 
     }
199 
+
200 
+    angle <- df$angle
201 
+    ## if (angle >= 90 & angle <=270) {
202 
+    ##     angle <- angle + 180
203 
+    ## }
204 
+
198 205 
     mx <- mx * adjustRatio + offset
199 
-    data.frame(x=mx, xend=mx, y=df$y, yend=df$yend)
206 
+
207 
+    data.frame(x=mx, xend=mx, y=df$y, yend=df$yend, angle=angle)
200 208 
 }
201 209
202 210
203 
-get_cladelabel_position_ <- function(data, node) {
211 
+get_cladelabel_position_ <- function(data, node, angle="auto") {
204 212 
     sp <- get.offspring.df(data, node)
205 213 
     sp2 <- c(sp, node)
206 214 
     sp.df <- data[match(sp2, data$node),]
... ... 
@@ -208,6 +216,16 @@ get_cladelabel_position_ <- function(data, node) {
208 216 
     y <- sp.df$y
209 217 
     y <- y[!is.na(y)]
210 218 
     mx <- max(sp.df$x, na.rm=TRUE)
211 
-    data.frame(x=mx, y=min(y), yend=max(y))
219 
+
220 
+    d <- data.frame(x=mx, y=min(y), yend=max(y))
221 
+    if (missing(angle))
222 
+        return(d)
223 
+
224 
+    if (angle == "auto") {
225 
+        d$angle <- mean(range(sp.df$angle))
226 
+    } else {
227 
+        d$angle <- angle
228 
+    }
229 
+    return(d)
212 230 
 }
213 231
Browse code

use EmojiOne font

guangchuang yu authored on 17/02/2017 05:00:22
Showing 1 changed files
R/geom_cladelabel.R
History View file @ bf32bdf6
... ... 
@@ -51,7 +51,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
51 51 
         emoji <- get_fun_from_pkg("emojifont", "emoji")
52 52 
         label <- emoji(label)
53 53 
         parse <- FALSE
54 
-        family <- "OpenSansEmoji"
54 
+        family <- "EmojiOne"
55 55 
     }
56