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

Document update

Document update

William Lee authored on 22/03/2022 14:46:29
Showing 1 changed files
R/geom_treescale.R
History View file @ 3c7f66c8
... ... 
@@ -1,20 +1,26 @@
1 
-##' add tree scale
1 
+##' add tree scale to a tree
2 
+##'
3 
+##' 'geom_treescale' automatically adds a scale bar for evolutionary distance
2 4 
 ##'
3 5 
 ##'
4 6 
 ##' @title geom_treescale
5 
-##' @param x x position
6 
-##' @param y y position
7 
-##' @param width width of scale
8 
-##' @param offset offset of text to line
9 
-##' @param label the title of tree scale, default is NULL.
10 
-##' @param offset.label offset of scale title to line.
11 
-##' @param color color
12 
-##' @param linesize size of line
13 
-##' @param fontsize size of text
14 
-##' @param family sans by default, can be any supported font
7 
+##' @param x set x position of the scale
8 
+##' @param y set y position of the scale
9 
+##' @param width set the length of the tree scale
10 
+##' @param offset set offset of text to line, defaults to NULL
11 
+##' @param label set the title of tree scale, defaults to NULL.
12 
+##' @param offset.label set offset of the scale title to line.
13 
+##' @param color set color of the scale
14 
+##' @param linesize set size of line
15 
+##' @param fontsize set size of text
16 
+##' @param family 'sans' by default, can be any supported font
15 17 
 ##' @return ggplot layers
16 18 
 ##' @export
17 19 
 ##' @author Guangchuang Yu
20 
+##' @references
21 
+##' For demonstration of this function, please refer to chapter 4.3.1 of
22 
+##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees*
23 
+##' <http://yulab-smu.top/treedata-book/index.html> by Guangchuang Yu.
18 24 
 geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL,
19 25 
                            offset.label=NULL, label=NULL, color="black",
20 26 
                            linesize=0.5, fontsize=3.88, family="sans") {
Browse code

Merge branch 'utemp'

xiangpin authored on 29/12/2020 07:33:18
Showing 0 changed files
Browse code

default vjust of label to 1

xiangpin authored on 29/12/2020 07:33:12
Showing 1 changed files
R/geom_treescale.R
History View file @ 3a0e6df3
... ... 
@@ -154,7 +154,7 @@ stat_treeScaleLabel <- function(mapping=NULL, data=NULL,
154 154 
                      offset.label = offset.label,
155 155 
                      labelname=labelname,
156 156 
                      na.rm = na.rm,
157 
-                     vjust = 0,
157 
+                     vjust = 1,
158 158 
                      ...
159 159 
                       )
160 160
Browse code

Update geom_treescale.R

remove duplicated lines.

Guangchuang Yu authored on 23/12/2020 01:10:19 • GitHub committed on 23/12/2020 01:10:19
Showing 1 changed files
R/geom_treescale.R
History View file @ ebe98365
... ... 
@@ -27,8 +27,8 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL,
27 27
28 28 
     default_aes <- aes_(x=~x, y=~y)
29 29 
     mapping <- default_aes
30 
-    if (is.null(label)){
31 
-        list(
30 
+
31 
+    ly <- list(
32 32 
             stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
33 33 
                                offset.label=offset.label, labelname=label,
34 34 
                                mapping=mapping, data=data,
... ... 
@@ -41,26 +41,14 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL,
41 41 
                                position=position, show.legend = show.legend,
42 42 
                                inherit.aes = inherit.aes, na.rm=na.rm)
43 43 
          )
44 
-    }else{
45 
-        list(
46 
-            stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
47 
-                               offset.label=offset.label, labelname=label,
48 
-                               mapping=mapping, data=data,
49 
-                               position=position, show.legend = show.legend,
50 
-                               inherit.aes = inherit.aes, na.rm=na.rm),
51 
-            stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
52 
-                               offset.label=offset.label, labelname=label,
53 
-                               size=fontsize, family = family,
54 
-                               mapping=mapping, data=data,
55 
-                               position=position, show.legend = show.legend,
56 
-                               inherit.aes = inherit.aes, na.rm=na.rm),
57 
-            stat_treeScaleLabel(xx=x, yy=y, width=width, color=color, offset=offset,
44 
+    if (!is.null(label)){
45 
+        ly[[3]] <- stat_treeScaleLabel(xx=x, yy=y, width=width, color=color, offset=offset,
58 46 
                                 offset.label=offset.label, labelname=label,
59 47 
                                 size=fontsize, family=family, mapping=mapping, data=data,
60 48 
                                 position=position, show.legend=show.legend,
61 49 
                                 inherit.aes = inherit.aes, na.rm=na.rm)
62 
-        )
63 50 
     }
51 
+    return(ly)
64 52 
 }
65 53
66 54
... ... 
@@ -213,24 +201,21 @@ get_treescale_position <- function(data, xx, yy, width, offset=NULL, offset.labe
213 201 
     } else {
214 202 
         d <- width
215 203 
     }
216 
-
217 
-    if (!is.null(offset.label)){
218 
-        offset.label <- offset.label
219 
-    }
220 204
221 205 
     if (is.null(offset)) {
222 206 
         offset <- 0.4
223 
-        if (is.null(offset.label)){
224 
-            offset.label <- -0.4
225 
-        }
226 207 
     }
227 
-
228 
-    if (is.null(label) || is.null(offset.label)){
229 
-        list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
230 
-             TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
231 
-    }else{
232 
-        list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
233 
-             TextPosition=data.frame(x=x+d/2, y=y+offset, label=d),
234 
-             LabelPosition=data.frame(x=x+d/2, y=y+offset.label, label=label))
208 
+    if (is.null(offset.label)){
209 
+        offset.label <- -0.4
210 
+    }
211 
+
212 
+    res <-  list(LinePosition = data.frame(x=x, xend=x+d, y=y, yend=y),
213 
+                 TextPosition = data.frame(x=x+d/2, y=y+offset, label=d)
214 
+                )
215 
+
216 
+    if (!is.null(label)){
217 
+        res[["LabelPosition"]] <- data.frame(x=x+d/2, y=y+offset.label, label=label)
235 218 
     }
219 
+
220 
+    return(res)
236 221 
 }
Browse code

add offset.label and label to geom_treescale

xiangpin authored on 22/12/2020 09:54:27
Showing 1 changed files
R/geom_treescale.R
History View file @ 4248a321
... ... 
@@ -6,6 +6,8 @@
6 6 
 ##' @param y y position
7 7 
 ##' @param width width of scale
8 8 
 ##' @param offset offset of text to line
9 
+##' @param label the title of tree scale, default is NULL.
10 
+##' @param offset.label offset of scale title to line.
9 11 
 ##' @param color color
10 12 
 ##' @param linesize size of line
11 13 
 ##' @param fontsize size of text
... ... 
@@ -13,7 +15,8 @@
13 15 
 ##' @return ggplot layers
14 16 
 ##' @export
15 17 
 ##' @author Guangchuang Yu
16 
-geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black",
18 
+geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL,
19 
+                           offset.label=NULL, label=NULL, color="black",
17 20 
                            linesize=0.5, fontsize=3.88, family="sans") {
18 21
19 22 
     data=NULL
... ... 
@@ -24,25 +27,47 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black
24 27
25 28 
     default_aes <- aes_(x=~x, y=~y)
26 29 
     mapping <- default_aes
27 
-
28 
-    list(
29 
-        stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
30 
-                           mapping=mapping, data=data,
31 
-                           position=position, show.legend = show.legend,
32 
-                           inherit.aes = inherit.aes, na.rm=na.rm),
33 
-        stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
34 
-                           size=fontsize, family = family,
35 
-                           mapping=mapping, data=data,
36 
-                           position=position, show.legend = show.legend,
37 
-                           inherit.aes = inherit.aes, na.rm=na.rm)
38 
-    )
30 
+    if (is.null(label)){
31 
+        list(
32 
+            stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
33 
+                               offset.label=offset.label, labelname=label,
34 
+                               mapping=mapping, data=data,
35 
+                               position=position, show.legend = show.legend,
36 
+                               inherit.aes = inherit.aes, na.rm=na.rm),
37 
+            stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
38 
+                               offset.label=offset.label, labelname=label,
39 
+                               size=fontsize, family = family,
40 
+                               mapping=mapping, data=data,
41 
+                               position=position, show.legend = show.legend,
42 
+                               inherit.aes = inherit.aes, na.rm=na.rm)
43 
+         )
44 
+    }else{
45 
+        list(
46 
+            stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
47 
+                               offset.label=offset.label, labelname=label,
48 
+                               mapping=mapping, data=data,
49 
+                               position=position, show.legend = show.legend,
50 
+                               inherit.aes = inherit.aes, na.rm=na.rm),
51 
+            stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
52 
+                               offset.label=offset.label, labelname=label,
53 
+                               size=fontsize, family = family,
54 
+                               mapping=mapping, data=data,
55 
+                               position=position, show.legend = show.legend,
56 
+                               inherit.aes = inherit.aes, na.rm=na.rm),
57 
+            stat_treeScaleLabel(xx=x, yy=y, width=width, color=color, offset=offset,
58 
+                                offset.label=offset.label, labelname=label,
59 
+                                size=fontsize, family=family, mapping=mapping, data=data,
60 
+                                position=position, show.legend=show.legend,
61 
+                                inherit.aes = inherit.aes, na.rm=na.rm)
62 
+        )
63 
+    }
39 64 
 }
40 65
41 66
42 67
43 68 
 stat_treeScaleLine <- function(mapping=NULL, data=NULL,
44 69 
                            geom="segment", position="identity",
45 
-                           xx, yy, width, offset, color, ...,
70 
+                           xx, yy, width, offset, color, offset.label, labelname, ...,
46 71 
                            show.legend=NA, inherit.aes=FALSE, na.rm=FALSE){
47 72
48 73 
     default_aes <- aes_(x=~x, y=~y, xend=~x, yend=~y)
... ... 
@@ -63,6 +88,8 @@ stat_treeScaleLine <- function(mapping=NULL, data=NULL,
63 88 
                     yy=yy,
64 89 
                     width=width,
65 90 
                     offset=offset,
91 
+                    offset.label=offset.label,
92 
+                    labelname=labelname,
66 93 
                     color=color,
67 94 
                     na.rm=na.rm,
68 95 
                     ...)
... ... 
@@ -71,7 +98,7 @@ stat_treeScaleLine <- function(mapping=NULL, data=NULL,
71 98
72 99 
 stat_treeScaleText <- function(mapping=NULL, data=NULL,
73 100 
                                geom="text", position="identity",
74 
-                               xx, yy, width, offset, color, ...,
101 
+                               xx, yy, width, offset, color, offset.label, labelname, ...,
75 102 
                                show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
76 103
77 104 
     default_aes <- aes_(x=~x, y=~y, label=~x)
... ... 
@@ -92,6 +119,8 @@ stat_treeScaleText <- function(mapping=NULL, data=NULL,
92 119 
                       yy=yy,
93 120 
                       width=width,
94 121 
                       offset=offset,
122 
+                      offset.label=offset.label,
123 
+                      labelname=labelname,
95 124 
                       color=color,
96 125 
                       na.rm=na.rm,
97 126 
                       vjust = 0,
... ... 
@@ -99,25 +128,68 @@ stat_treeScaleText <- function(mapping=NULL, data=NULL,
99 128 
     )
100 129 
 }
101 130
131 
+stat_treeScaleLabel <- function(mapping=NULL, data=NULL,
132 
+                                geom="text", position="identity",
133 
+                                xx, yy, width, offset, color, offset.label, labelname, ...,
134 
+                                show.legend=NA, inherit.aes=TRUE, na.rm=FALSE){
135 
+    default_aes <- aes_(x=~x, y=~y, label=~x)
136 
+    if (is.null(mapping)) {
137 
+        mapping <- default_aes
138 
+    }else{
139 
+        mapping <- modifyList(mapping, default_aes)
140 
+    }
141 
+    layer(
142 
+        stat = StatTreeScaleLabel,
143 
+        data = data,
144 
+        mapping = mapping,
145 
+        geom = GeomText,
146 
+        position = position,
147 
+        show.legend = show.legend,
148 
+        inherit.aes = inherit.aes,
149 
+        params = list(xx = xx,
150 
+                     yy = yy,
151 
+                     width = width,
152 
+                     offset = offset,
153 
+                     color = color,
154 
+                     offset.label = offset.label,
155 
+                     labelname=labelname,
156 
+                     na.rm = na.rm,
157 
+                     vjust = 0,
158 
+                     ...
159 
+                      )
160 
+
161 
+    )
162 
+
163 
+}
102 164
103 165 
 StatTreeScaleLine <- ggproto("StatTreeScaleLine", Stat,
104 
-                             compute_group = function(self, data, scales, params, xx, yy, width, offset) {
105 
-                                 get_treescale_position(data, xx, yy, width, offset)[[1]]
166 
+                             compute_group = function(self, data, scales, params, xx, yy, width, offset, offset.label, labelname) {
167 
+                                 get_treescale_position(data=data, xx=xx, yy=yy, width=width,
168 
+                                                        offset=offset, offset.label=offset.label, label=labelname)[[1]]
106 169 
                              },
107 170 
                              required_aes = c("x", "y", "xend", "yend")
108 171 
                              )
109 172
110 173
111 174 
 StatTreeScaleText <- ggproto("StatTreeScaleText", Stat,
112 
-                             compute_group = function(self, data, scales, params, xx, yy, width, offset) {
113 
-                                 get_treescale_position(data, xx, yy, width, offset)[[2]]
175 
+                             compute_group = function(self, data, scales, params, xx, yy, width, offset, offset.label, labelname) {
176 
+                                 get_treescale_position(data=data, xx=xx, yy=yy, width=width,
177 
+                                                        offset=offset, offset.label=offset.label, label=labelname)[[2]]
114 178 
                              },
115 179 
                              required_aes = c("x", "y", "label")
116 180 
                              )
117 181
118 182
183 
+StatTreeScaleLabel <- ggproto("StatTreeScaleLabel", Stat,
184 
+                              compute_panel = function(self, data, scales, params, xx, yy, width, offset, offset.label, labelname){
185 
+                                 get_treescale_position(data=data, xx=xx, yy=yy, width=width,
186 
+                                                        offset=offset, offset.label=offset.label, label=labelname)[[3]]
187 
+                              },
188 
+                              required_aes = c("x", "y", "label")
189 
+                              )
190 
+
119 191
120 
-get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
192 
+get_treescale_position <- function(data, xx, yy, width, offset=NULL, offset.label=NULL, label=NULL) {
121 193 
     x <- xx
122 194 
     y <- yy
123 195 
     dx <- data$x %>% range %>% diff
... ... 
@@ -141,11 +213,24 @@ get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
141 213 
     } else {
142 214 
         d <- width
143 215 
     }
216 
+
217 
+    if (!is.null(offset.label)){
218 
+        offset.label <- offset.label
219 
+    }
144 220
145 221 
     if (is.null(offset)) {
146 222 
         offset <- 0.4
223 
+        if (is.null(offset.label)){
224 
+            offset.label <- -0.4
225 
+        }
226 
+    }
227 
+
228 
+    if (is.null(label) || is.null(offset.label)){
229 
+        list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
230 
+             TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
231 
+    }else{
232 
+        list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
233 
+             TextPosition=data.frame(x=x+d/2, y=y+offset, label=d),
234 
+             LabelPosition=data.frame(x=x+d/2, y=y+offset.label, label=label))
147 235 
     }
148 
-
149 
-    list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
150 
-         TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
151 236 
 }
Browse code

optimize geom-treescale

guangchuang yu authored on 07/03/2018 08:41:33
Showing 1 changed files
R/geom_treescale.R
History View file @ 8407d2ab
... ... 
@@ -94,6 +94,7 @@ stat_treeScaleText <- function(mapping=NULL, data=NULL,
94 94 
                       offset=offset,
95 95 
                       color=color,
96 96 
                       na.rm=na.rm,
97 
+                      vjust = 0,
97 98 
                       ...)
98 99 
     )
99 100 
 }
Browse code

clean up code

guangchuang yu authored on 14/12/2017 08:47:21
Showing 1 changed files
R/geom_treescale.R
History View file @ 14ff9149
... ... 
@@ -1,6 +1,6 @@
1 1 
 ##' add tree scale
2 2 
 ##'
3 
-##'
3 
+##'
4 4 
 ##' @title geom_treescale
5 5 
 ##' @param x x position
6 6 
 ##' @param y y position
... ... 
@@ -15,7 +15,7 @@
15 15 
 ##' @author Guangchuang Yu
16 16 
 geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black",
17 17 
                            linesize=0.5, fontsize=3.88, family="sans") {
18 
-
18 
+
19 19 
     data=NULL
20 20 
     position="identity"
21 21 
     show.legend=NA
... ... 
@@ -24,14 +24,14 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black
24 24
25 25 
     default_aes <- aes_(x=~x, y=~y)
26 26 
     mapping <- default_aes
27 
-
27 
+
28 28 
     list(
29 29 
         stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
30 30 
                            mapping=mapping, data=data,
31 31 
                            position=position, show.legend = show.legend,
32 32 
                            inherit.aes = inherit.aes, na.rm=na.rm),
33 33 
         stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
34 
-                           size=fontsize, family = family,
34 
+                           size=fontsize, family = family,
35 35 
                            mapping=mapping, data=data,
36 36 
                            position=position, show.legend = show.legend,
37 37 
                            inherit.aes = inherit.aes, na.rm=na.rm)
... ... 
@@ -42,9 +42,9 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black
42 42
43 43 
 stat_treeScaleLine <- function(mapping=NULL, data=NULL,
44 44 
                            geom="segment", position="identity",
45 
-                           xx, yy, width, offset, color, ...,
45 
+                           xx, yy, width, offset, color, ...,
46 46 
                            show.legend=NA, inherit.aes=FALSE, na.rm=FALSE){
47 
-
47 
+
48 48 
     default_aes <- aes_(x=~x, y=~y, xend=~x, yend=~y)
49 49 
     if (is.null(mapping)) {
50 50 
         mapping <- default_aes
... ... 
@@ -120,17 +120,17 @@ get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
120 120 
     x <- xx
121 121 
     y <- yy
122 122 
     dx <- data$x %>% range %>% diff
123 
-
123 
+
124 124 
     if (is.null(x)) {
125 125 
         x <- dx/2
126 126 
     }
127 
-
127 
+
128 128 
     if (is.null(y)) {
129 129 
         y <- 0
130 130 
     }
131 131
132 132 
     if (is.null(width) || is.na(width)) {
133 
-        d <- dx/10
133 
+        d <- dx/10
134 134 
         n <- 0
135 135 
         while (d < 1) {
136 136 
             d <- d*10
... ... 
@@ -140,42 +140,11 @@ get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
140 140 
     } else {
141 141 
         d <- width
142 142 
     }
143 
-
143 
+
144 144 
     if (is.null(offset)) {
145 145 
         offset <- 0.4
146 146 
     }
147 
-
147 
+
148 148 
     list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
149 149 
          TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
150 150 
 }
151 
-
152 
-## ##' add evolution distance legend
153 
-## ##'
154 
-## ##'
155 
-## ##' @title add_legend
156 
-## ##' @param p tree view
157 
-## ##' @param width width of legend
158 
-## ##' @param x x position
159 
-## ##' @param y y position
160 
-## ##' @param offset offset of text and line
161 
-## ##' @param font.size font size
162 
-## ##' @param ... additional parameter
163 
-## ##' @return tree view
164 
-## ##' @importFrom grid linesGrob
165 
-## ##' @importFrom grid textGrob
166 
-## ##' @importFrom grid gpar
167 
-## ##' @importFrom ggplot2 ylim
168 
-## ##' @export
169 
-## ##' @author Guangchuang Yu
170 
-## add_legend <- function(p, width=NULL, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
171 
-##     dd <- get_treescale_position(p$data, x, y, width, offset)
172 
-##     x <- dd[[1]]$x
173 
-##     y <- dd[[1]]$y
174 
-##     d <- dd[[1]]$xend -x
175 
-##     p <- p + annotation_custom(linesGrob(), xmin=x, xmax=x+d, ymin=y, ymax=y) +
176 
-##         annotation_custom(textGrob(label=d, gp = gpar(fontsize = font.size)),
177 
-##                           xmin=x+d/2, xmax=x+d/2, ymin=y+offset, ymax=y+offset)
178 
-##     return(p)
179 
-## }
180 
-
181 
-
Browse code

bug fixed in geom_treescale

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

g.yu authored on 16/08/2016 04:18:17
Showing 1 changed files
R/geom_treescale.R
History View file @ 17714487
... ... 
@@ -19,7 +19,7 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black
19 19 
     data=NULL
20 20 
     position="identity"
21 21 
     show.legend=NA
22 
-    na.rm=FALSE
22 
+    na.rm=TRUE
23 23 
     inherit.aes=FALSE
24 24
25 25 
     default_aes <- aes_(x=~x, y=~y)
... ... 
@@ -74,7 +74,7 @@ stat_treeScaleText <- function(mapping=NULL, data=NULL,
74 74 
                                xx, yy, width, offset, color, ...,
75 75 
                                show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
76 76
77 
-    default_aes <- aes_(x=~x, y=~y, label=~label)
77 
+    default_aes <- aes_(x=~x, y=~y, label=~x)
78 78 
     if (is.null(mapping)) {
79 79 
         mapping <- default_aes
80 80 
     } else {
... ... 
@@ -149,9 +149,9 @@ get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
149 149 
          TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
150 150 
 }
151 151
152 
-##' add evolution distance legend
153 
-##'
154 
-##'
152 
+## ##' add evolution distance legend
153 
+## ##'
154 
+## ##'
155 155 
 ## ##' @title add_legend
156 156 
 ## ##' @param p tree view
157 157 
 ## ##' @param width width of legend
Browse code

geom_cladelabel

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

g.yu authored on 11/08/2016 06:54:44
Showing 1 changed files
R/geom_treescale.R
History View file @ 5662ae9e
... ... 
@@ -45,7 +45,7 @@ stat_treeScaleLine <- function(mapping=NULL, data=NULL,
45 45 
                            xx, yy, width, offset, color, ...,
46 46 
                            show.legend=NA, inherit.aes=FALSE, na.rm=FALSE){
47 47
48 
-    default_aes <- aes_(x=~x, y=~y)
48 
+    default_aes <- aes_(x=~x, y=~y, xend=~x, yend=~y)
49 49 
     if (is.null(mapping)) {
50 50 
         mapping <- default_aes
51 51 
     } else {
... ... 
@@ -74,7 +74,7 @@ stat_treeScaleText <- function(mapping=NULL, data=NULL,
74 74 
                                xx, yy, width, offset, color, ...,
75 75 
                                show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
76 76
77 
-    default_aes <- aes_(x=~x, y=~y)
77 
+    default_aes <- aes_(x=~x, y=~y, label=~label)
78 78 
     if (is.null(mapping)) {
79 79 
         mapping <- default_aes
80 80 
     } else {
Browse code

geom_treescale() supports family argument <2016-04-27, Wed>

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

g.yu authored on 27/04/2016 09:37:02
Showing 1 changed files
R/geom_treescale.R
History View file @ 51f3c877
... ... 
@@ -9,11 +9,12 @@
9 9 
 ##' @param color color
10 10 
 ##' @param linesize size of line
11 11 
 ##' @param fontsize size of text
12 
+##' @param family sans by default, can be any supported font
12 13 
 ##' @return ggplot layers
13 14 
 ##' @export
14 15 
 ##' @author Guangchuang Yu
15 16 
 geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black",
16 
-                           linesize=0.5, fontsize=3.88) {
17 
+                           linesize=0.5, fontsize=3.88, family="sans") {
17 18
18 19 
     data=NULL
19 20 
     position="identity"
... ... 
@@ -29,7 +30,8 @@ geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black
29 30 
                            mapping=mapping, data=data,
30 31 
                            position=position, show.legend = show.legend,
31 32 
                            inherit.aes = inherit.aes, na.rm=na.rm),
32 
-        stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset, size=fontsize,
33 
+        stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
34 
+                           size=fontsize, family = family,
33 35 
                            mapping=mapping, data=data,
34 36 
                            position=position, show.legend = show.legend,
35 37 
                            inherit.aes = inherit.aes, na.rm=na.rm)
Browse code

lots of new layers

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

g.yu authored on 22/12/2015 04:13:13
Showing 1 changed files
R/geom_treescale.R
History View file @ 3e4b5998
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,179 @@
1 
+##' add tree scale
2 
+##'
3 
+##'
4 
+##' @title geom_treescale
5 
+##' @param x x position
6 
+##' @param y y position
7 
+##' @param width width of scale
8 
+##' @param offset offset of text to line
9 
+##' @param color color
10 
+##' @param linesize size of line
11 
+##' @param fontsize size of text
12 
+##' @return ggplot layers
13 
+##' @export
14 
+##' @author Guangchuang Yu
15 
+geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black",
16 
+                           linesize=0.5, fontsize=3.88) {
17 
+
18 
+    data=NULL
19 
+    position="identity"
20 
+    show.legend=NA
21 
+    na.rm=FALSE
22 
+    inherit.aes=FALSE
23 
+
24 
+    default_aes <- aes_(x=~x, y=~y)
25 
+    mapping <- default_aes
26 
+
27 
+    list(
28 
+        stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
29 
+                           mapping=mapping, data=data,
30 
+                           position=position, show.legend = show.legend,
31 
+                           inherit.aes = inherit.aes, na.rm=na.rm),
32 
+        stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset, size=fontsize,
33 
+                           mapping=mapping, data=data,
34 
+                           position=position, show.legend = show.legend,
35 
+                           inherit.aes = inherit.aes, na.rm=na.rm)
36 
+    )
37 
+}
38 
+
39 
+
40 
+
41 
+stat_treeScaleLine <- function(mapping=NULL, data=NULL,
42 
+                           geom="segment", position="identity",
43 
+                           xx, yy, width, offset, color, ...,
44 
+                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE){
45 
+
46 
+    default_aes <- aes_(x=~x, y=~y)
47 
+    if (is.null(mapping)) {
48 
+        mapping <- default_aes
49 
+    } else {
50 
+        mapping <- modifyList(mapping, default_aes)
51 
+    }
52 
+    layer(
53 
+        stat=StatTreeScaleLine,
54 
+        data=data,
55 
+        mapping=mapping,
56 
+        geom = geom,
57 
+        position=position,
58 
+        show.legend=show.legend,
59 
+        inherit.aes=inherit.aes,
60 
+        params=list(xx=xx,
61 
+                    yy=yy,
62 
+                    width=width,
63 
+                    offset=offset,
64 
+                    color=color,
65 
+                    na.rm=na.rm,
66 
+                    ...)
67 
+    )
68 
+}
69 
+
70 
+stat_treeScaleText <- function(mapping=NULL, data=NULL,
71 
+                               geom="text", position="identity",
72 
+                               xx, yy, width, offset, color, ...,
73 
+                               show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
74 
+
75 
+    default_aes <- aes_(x=~x, y=~y)
76 
+    if (is.null(mapping)) {
77 
+        mapping <- default_aes
78 
+    } else {
79 
+        mapping <- modifyList(mapping, default_aes)
80 
+    }
81 
+    layer(
82 
+        stat=StatTreeScaleText,
83 
+        data=data,
84 
+        mapping=mapping,
85 
+        geom=GeomText,
86 
+        position=position,
87 
+        show.legend = show.legend,
88 
+        inherit.aes = inherit.aes,
89 
+        params = list(xx=xx,
90 
+                      yy=yy,
91 
+                      width=width,
92 
+                      offset=offset,
93 
+                      color=color,
94 
+                      na.rm=na.rm,
95 
+                      ...)
96 
+    )
97 
+}
98 
+
99 
+
100 
+StatTreeScaleLine <- ggproto("StatTreeScaleLine", Stat,
101 
+                             compute_group = function(self, data, scales, params, xx, yy, width, offset) {
102 
+                                 get_treescale_position(data, xx, yy, width, offset)[[1]]
103 
+                             },
104 
+                             required_aes = c("x", "y", "xend", "yend")
105 
+                             )
106 
+
107 
+
108 
+StatTreeScaleText <- ggproto("StatTreeScaleText", Stat,
109 
+                             compute_group = function(self, data, scales, params, xx, yy, width, offset) {
110 
+                                 get_treescale_position(data, xx, yy, width, offset)[[2]]
111 
+                             },
112 
+                             required_aes = c("x", "y", "label")
113 
+                             )
114 
+
115 
+
116 
+
117 
+get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
118 
+    x <- xx
119 
+    y <- yy
120 
+    dx <- data$x %>% range %>% diff
121 
+
122 
+    if (is.null(x)) {
123 
+        x <- dx/2
124 
+    }
125 
+
126 
+    if (is.null(y)) {
127 
+        y <- 0
128 
+    }
129 
+
130 
+    if (is.null(width) || is.na(width)) {
131 
+        d <- dx/10
132 
+        n <- 0
133 
+        while (d < 1) {
134 
+            d <- d*10
135 
+            n <- n + 1
136 
+        }
137 
+        d <- floor(d)/(10^n)
138 
+    } else {
139 
+        d <- width
140 
+    }
141 
+
142 
+    if (is.null(offset)) {
143 
+        offset <- 0.4
144 
+    }
145 
+
146 
+    list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
147 
+         TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
148 
+}
149 
+
150 
+##' add evolution distance legend
151 
+##'
152 
+##'
153 
+## ##' @title add_legend
154 
+## ##' @param p tree view
155 
+## ##' @param width width of legend
156 
+## ##' @param x x position
157 
+## ##' @param y y position
158 
+## ##' @param offset offset of text and line
159 
+## ##' @param font.size font size
160 
+## ##' @param ... additional parameter
161 
+## ##' @return tree view
162 
+## ##' @importFrom grid linesGrob
163 
+## ##' @importFrom grid textGrob
164 
+## ##' @importFrom grid gpar
165 
+## ##' @importFrom ggplot2 ylim
166 
+## ##' @export
167 
+## ##' @author Guangchuang Yu
168 
+## add_legend <- function(p, width=NULL, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
169 
+##     dd <- get_treescale_position(p$data, x, y, width, offset)
170 
+##     x <- dd[[1]]$x
171 
+##     y <- dd[[1]]$y
172 
+##     d <- dd[[1]]$xend -x
173 
+##     p <- p + annotation_custom(linesGrob(), xmin=x, xmax=x+d, ymin=y, ymax=y) +
174 
+##         annotation_custom(textGrob(label=d, gp = gpar(fontsize = font.size)),
175 
+##                           xmin=x+d/2, xmax=x+d/2, ymin=y+offset, ymax=y+offset)
176 
+##     return(p)
177 
+## }
178 
+
179 
+