1. ggtree
  2. Commit 4edbfa255ef39d58ee4d53540d3a7674b9f32ae2
Browse code

add `compute_group` according to ggplot (v2.1.0) <2016-09-29, Thu>

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

g.yu authored on 29/09/2016 05:55:59
Showing 6 changed files
NEWS
History View file @ 4edbfa25
... ... 
@@ -1,5 +1,7 @@
1 1 
 CHANGES IN VERSION 1.5.14
2 2 
 ------------------------
3 
+ o add `compute_group` according to ggplot (v2.1.0) <2016-09-29, Thu>
4 
+   + https://github.com/hadley/ggplot2/issues/1797
3 5 
  o unit test for groupOTU and groupClade <2016-09-22, Thu>
4 6 
  o groupOTU label groups by input group names (when input is a named list) <2016-09-22, Thu>
5 7 
  o update angle calculation for geom_tiplab <2016-09-13, Thu>
R/geom_cladelabel.R
History View file @ 4edbfa25
... ... 
@@ -1,6 +1,6 @@
1 1 
 ##' annotate a clade with bar and text label
2 2 
 ##'
3 
-##'
3 
+##'
4 4 
 ##' @title geom_cladelabel
5 5 
 ##' @param node selected node
6 6 
 ##' @param label clade label
... ... 
@@ -55,7 +55,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
55 55 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
56 56 
                                         position=position, show.legend = show.legend,
57 57 
                                         inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)
58 
-
58 
+
59 59 
         } else {
60 60 
             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
61 61 
                                         align=align, size=fontsize, angle=angle, fill=fill,family=family,
... ... 
@@ -67,7 +67,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
67 67
68 68 
         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
69 69 
                                    size=barsize,
70 
-                                   mapping=mapping, data=data,
70 
+                                   mapping=mapping, data=data,
71 71 
                                    position=position, show.legend = show.legend,
72 72 
                                    inherit.aes = inherit.aes, na.rm=na.rm, ...)
73 73 
     } else {
... ... 
@@ -78,7 +78,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
78 78 
                                         mapping=mapping, data=data, geom=geom, hjust=hjust,
79 79 
                                         position=position, show.legend = show.legend,
80 80 
                                         inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)
81 
-
81 
+
82 82 
         } else {
83 83 
             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,
84 84 
                                         align=align, size=fontsize, angle=angle, color=labelcolor, fill=fill,family=family,
... ... 
@@ -90,12 +90,12 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,
90 90
91 91 
         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,
92 92 
                                    size=barsize, color = barcolor,
93 
-                                   mapping=mapping, data=data,
93 
+                                   mapping=mapping, data=data,
94 94 
                                    position=position, show.legend = show.legend,
95 95 
                                    inherit.aes = inherit.aes, na.rm=na.rm, ...)
96 
-
96 
+
97 97 
     }
98 
-
98 
+
99 99 
     list(
100 100 
        layer_bar,
101 101 
        layer_text
... ... 
@@ -114,7 +114,7 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
114 114 
     } else {
115 115 
         mapping <- modifyList(mapping, default_aes)
116 116 
     }
117 
-
117 
+
118 118 
     layer(stat=StatCladeText,
119 119 
           data=data,
120 120 
           mapping=mapping,
... ... 
@@ -130,7 +130,7 @@ stat_cladeText <- function(mapping=NULL, data=NULL,
130 130 
                       parse  = parse,
131 131 
                       ...)
132 132 
           )
133 
-
133 
+
134 134 
 }
135 135
136 136 
 stat_cladeBar <- function(mapping=NULL, data=NULL,
... ... 
@@ -143,7 +143,7 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,
143 143 
     } else {
144 144 
         mapping <- modifyList(mapping, default_aes)
145 145 
     }
146 
-
146 
+
147 147 
     layer(stat=StatCladeBar,
148 148 
           data=data,
149 149 
           mapping=mapping,
... ... 
@@ -170,8 +170,8 @@ StatCladeText <- ggproto("StatCladeText", Stat,
170 170 
                          required_aes = c("x", "y", "label")
171 171 
                          )
172 172
173 
-
174 
-
173 
+
174 
+
175 175 
 StatCladeBar <- ggproto("StatCladBar", Stat,
176 176 
                         compute_group = function(self, data, scales, params, node, offset, align) {
177 177 
                             get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)
... ... 
@@ -199,7 +199,7 @@ get_cladelabel_position_ <- function(data, node) {
199 199
200 200 
     y <- sp.df$y
201 201 
     y <- y[!is.na(y)]
202 
-    mx <- max(sp.df$x, na.rm=TRUE)
202 
+    mx <- max(sp.df$x, na.rm=TRUE)
203 203 
     data.frame(x=mx, y=min(y), yend=max(y))
204 204 
 }
205 205
R/geom_point.R
History View file @ 4edbfa25
... ... 
@@ -1,13 +1,13 @@
1 1
2 2 
 ##' add tip point
3 3 
 ##'
4 
-##'
4 
+##'
5 5 
 ##' @title geom_tippoint
6 6 
 ##' @inheritParams geom_point2
7 7 
 ##' @return tip point layer
8 8 
 ##' @export
9 9 
 ##' @author Guangchuang Yu
10 
-geom_tippoint <- function(mapping = NULL, data = NULL,
10 
+geom_tippoint <- function(mapping = NULL, data = NULL,
11 11 
                        position = "identity", na.rm = FALSE,
12 12 
                           show.legend = NA, inherit.aes = TRUE, ...) {
13 13 
     isTip <- NULL
... ... 
@@ -17,18 +17,18 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
17 17 
     } else {
18 18 
         mapping %<>% modifyList(self_mapping)
19 19 
     }
20 
-    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
20 
+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
21 21 
 }
22 22
23 23 
 ##' add node point
24 24 
 ##'
25 
-##'
25 
+##'
26 26 
 ##' @title geom_nodepoint
27 27 
 ##' @inheritParams geom_point2
28 28 
 ##' @return node point layer
29 29 
 ##' @export
30 30 
 ##' @author Guangchuang Yu
31 
-geom_nodepoint <- function(mapping = NULL, data = NULL,
31 
+geom_nodepoint <- function(mapping = NULL, data = NULL,
32 32 
                        position = "identity", na.rm = FALSE,
33 33 
                        show.legend = NA, inherit.aes = TRUE, ...) {
34 34 
     isTip <- NULL
... ... 
@@ -38,19 +38,19 @@ geom_nodepoint <- function(mapping = NULL, data = NULL,
38 38 
     } else {
39 39 
         mapping %<>% modifyList(self_mapping)
40 40 
     }
41 
-    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
41 
+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
42 42 
 }
43 43
44 44
45 45 
 ##' add root point
46 46 
 ##'
47 
-##'
47 
+##'
48 48 
 ##' @title geom_rootpoint
49 49 
 ##' @inheritParams geom_point2
50 50 
 ##' @return root point layer
51 51 
 ##' @export
52 52 
 ##' @author Guangchuang Yu
53 
-geom_rootpoint <- function(mapping = NULL, data = NULL,
53 
+geom_rootpoint <- function(mapping = NULL, data = NULL,
54 54 
                            position = "identity", na.rm = FALSE,
55 55 
                            show.legend = NA, inherit.aes = TRUE, ...) {
56 56 
     isTip <- node <- parent <- NULL
... ... 
@@ -66,7 +66,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
66 66
67 67 
 ##' geom_point2 support aes(subset) via setup_data
68 68 
 ##'
69 
-##'
69 
+##'
70 70 
 ##' @title geom_point2
71 71 
 ##' @param mapping aes mapping
72 72 
 ##' @param data data
... ... 
@@ -85,14 +85,14 @@ geom_point2 <- function(mapping = NULL, data = NULL,
85 85 
                        position = "identity", na.rm = FALSE,
86 86 
                        show.legend = NA, inherit.aes = TRUE, ...) {
87 87
88 
-
88 
+
89 89 
     default_aes <- aes_(node=~node)
90 90 
     if (is.null(mapping)) {
91 91 
         mapping <- default_aes
92 92 
     } else {
93 93 
         mapping <- modifyList(mapping, default_aes)
94 94 
     }
95 
-
95 
+
96 96 
     layer(
97 97 
         data = data,
98 98 
         mapping = mapping,
... ... 
@@ -116,14 +116,16 @@ GeomPointGGtree <- ggproto("GeomPointGGtree", GeomPoint,
116 116 
                                if (is.null(data$subset))
117 117 
                                    return(data)
118 118 
                                data[data$subset,]
119 
-                           }  ## ,
120 
-
119 
+                           }
120 
+
121 
+                           ## ,
122 
+
121 123 
                            ## draw_panel = function(data, panel_scales, coord, na.rm = FALSE){
122 124 
                            ##     GeomPoint$draw_panel(data, panel_scales, coord, na.rm)
123 125 
                            ## },
124 
-
126 
+
125 127 
                            ## draw_key = draw_key_point,
126 
-
128 
+
127 129 
                            ## required_aes = c("x", "y"),
128 130 
                            ## default_aes = aes(shape = 19, colour = "black", size = 1.5, fill = NA,
129 131 
                            ##                   alpha = NA, stroke = 0.5)
R/geom_text.R
History View file @ 4edbfa25
... ... 
@@ -1,6 +1,6 @@
1 1 
 ##' geom_text2 support aes(subset) via setup_data
2 2 
 ##'
3 
-##'
3 
+##'
4 4 
 ##' @title geom_text2
5 5 
 ##' @param mapping the aesthetic mapping
6 6 
 ##' @param data A layer specific dataset -
... ... 
@@ -29,17 +29,17 @@ geom_text2 <- function(mapping = NULL, data = NULL,
29 29 
         if (!missing(position)) {
30 30 
             stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)
31 31 
         }
32 
-
32 
+
33 33 
         position <- position_nudge(nudge_x, nudge_y)
34 34 
     }
35 
-
35 
+
36 36 
     default_aes <- aes_(node=~node)
37 37 
     if (is.null(mapping)) {
38 38 
         mapping <- default_aes
39 39 
     } else {
40 40 
         mapping <- modifyList(mapping, default_aes)
41 41 
     }
42 
-
42 
+
43 43 
     layer(
44 44 
         data = data,
45 45 
         mapping = mapping,
... ... 
@@ -66,16 +66,19 @@ GeomTextGGtree <- ggproto("GeomTextGGtree", GeomText,
66 66 
                                   return(data)
67 67 
                               data[data$subset,]
68 68 
                           },
69 
+                          ## compute_group = function(data, params) {
70 
+                          ##     data
71 
+                          ## },
69 72 
                           draw_panel = function(data, panel_scales, coord, parse = FALSE,
70 73 
                               na.rm = TRUE, check_overlap = FALSE) {
71 74 
                               GeomText$draw_panel(data, panel_scales, coord, parse,
72 75 
                                                   na.rm, check_overlap)
73 76 
                           },
74 77 
                           required_aes = c("node", "x", "y", "label"),
75 
-
78 
+
76 79 
                           default_aes = aes(colour = "black", size = 3.88, angle = 0, hjust = 0.5,
77 80 
                               vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2),
78 
-
81 
+
79 82 
                           draw_key = draw_key_text
80 83 
                           )
81 84
R/geom_tree.R
History View file @ 4edbfa25
... ... 
@@ -1,6 +1,6 @@
1 1 
 ##' add tree layer
2 2 
 ##'
3 
-##'
3 
+##'
4 4 
 ##' @title geom_tree
5 5 
 ##' @param mapping aesthetic mapping
6 6 
 ##' @param data data
... ... 
@@ -14,7 +14,7 @@
14 14 
 ##' @author Yu Guangchuang
15 15 
 geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=FALSE, ...) {
16 16 
     stat_tree(data=data, mapping=mapping, geom="segment",
17 
-              layout=layout, multiPhylo=multiPhylo, lineend="round",
17 
+              layout=layout, multiPhylo=multiPhylo, lineend="round",
18 18 
               position='identity', show.legend=NA,
19 19 
               inherit.aes=TRUE, na.rm=TRUE, ...)
20 20 
 }
... ... 
@@ -23,12 +23,12 @@ geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=
23 23 
 stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identity",
24 24 
                       layout="rectangular", multiPhylo=FALSE, lineend="round", ...,
25 25 
                       show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
26 
-
26 
+
27 27 
     default_aes <- aes_(x=~x, y=~y,node=~node, parent=~parent)
28 28 
     if (multiPhylo) {
29 29 
         default_aes <- modifyList(default_aes, aes_(.id=~.id))
30 30 
     }
31 
-
31 
+
32 32 
     if (is.null(mapping)) {
33 33 
         mapping <- default_aes
34 34 
     } else {
... ... 
@@ -74,11 +74,14 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit
74 74 
                           na.rm = na.rm,
75 75 
                           ...)
76 76 
               )
77 
-    }
77 
+    }
78 78 
 }
79 79
80 80 
 StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
81 81 
                               required_aes = c("node", "parent", "x", "y"),
82 
+                              compute_group = function(data, params) {
83 
+                                  data
84 
+                              },
82 85 
                               compute_panel = function(self, data, scales, params, layout, lineend) {
83 86 
                                   .fun <- function(data) {
84 87 
                                       df <- setup_tree_data(data)
... ... 
@@ -90,7 +93,7 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
90 93 
                                       df$x <- x[ii]
91 94 
                                       return(df)
92 95 
                                   }
93 
-
96 
+
94 97 
                                   if ('.id' %in% names(data)) {
95 98 
                                       ldf <- split(data, data$.id)
96 99 
                                       df <- do.call(rbind, lapply(ldf, .fun))
... ... 
@@ -103,6 +106,9 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
103 106
104 107 
 StatTreeVertical <- ggproto("StatTreeVertical", Stat,
105 108 
                             required_aes = c("node", "parent", "x", "y"),
109 
+                            compute_group = function(data, params) {
110 
+                                data
111 
+                            },
106 112 
                             compute_panel = function(self, data, scales, params, layout, lineend) {
107 113 
                                 .fun <- function(data) {
108 114 
                                     df <- setup_tree_data(data)
... ... 
@@ -129,6 +135,9 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
129 135
130 136 
 StatTree <- ggproto("StatTree", Stat,
131 137 
                     required_aes = c("node", "parent", "x", "y"),
138 
+                    compute_group = function(data, params) {
139 
+                        data
140 
+                    },
132 141 
                     compute_panel = function(self, data, scales, params, layout, lineend) {
133 142 
                         .fun <- function(data) {
134 143 
                             df <- setup_tree_data(data)
... ... 
@@ -155,7 +164,7 @@ StatTree <- ggproto("StatTree", Stat,
155 164 
 setup_tree_data <- function(data) {
156 165 
     if (nrow(data) == length(unique(data$node)))
157 166 
         return(data)
158 
-
167 
+
159 168 
     data[match(unique(data$node), data$node),]
160 169 
     ## data[order(data$node, decreasing = FALSE), ]
161 170 
 }
... ... 
@@ -163,7 +172,7 @@ setup_tree_data <- function(data) {
163 172
164 173 
 ##' add tree layer
165 174 
 ##'
166 
-##'
175 
+##'
167 176 
 ##' @title geom_tree2
168 177 
 ##' @param layout one of 'rectangular', 'slanted', 'circular', 'radial' or 'unrooted'
169 178 
 ##' @param ... additional parameter
... ... 
@@ -182,7 +191,7 @@ geom_tree2 <- function(layout="rectangular", ...) {
182 191 
                              y    = y,
183 192 
                              yend = y),
184 193 
                          lineend  = lineend, ...),
185 
-
194 
+
186 195 
             geom_segment(aes(x    = x[parent],
187 196 
                              xend = x[parent],
188 197 
                              y    = y[parent],
README.md
History View file @ 4edbfa25
... ... 
@@ -1,9 +1,9 @@
1 1 
 ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
2 2 
 ===========================================================================================================================
3 3
4 
-[![releaseVersion](https://img.shields.io/badge/release%20version-1.4.20-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.5.14-green.svg?style=flat)](https://github.com/GuangchuangYu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![total](https://img.shields.io/badge/downloads-13544/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1122/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
4 
+[![releaseVersion](https://img.shields.io/badge/release%20version-1.4.20-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.5.14-green.svg?style=flat)](https://github.com/GuangchuangYu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![total](https://img.shields.io/badge/downloads-13863/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1122/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
5 5
6 
-[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree) [![Last-changedate](https://img.shields.io/badge/last%20change-2016--09--26-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers) [![Awesome](https://cdn.rawgit.com/sindresorhus/awesome/d7305f38d29fed78fa85652e3a63e154dd8e8829/media/badge.svg)](https://awesome-r.com/#awesome-r-graphic-displays)
6 
+[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree) [![Last-changedate](https://img.shields.io/badge/last%20change-2016--09--29-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers) [![Awesome](https://cdn.rawgit.com/sindresorhus/awesome/d7305f38d29fed78fa85652e3a63e154dd8e8829/media/badge.svg)](https://awesome-r.com/#awesome-r-graphic-displays)
7 7
8 8 
 [![platform](http://www.bioconductor.org/shields/availability/devel/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/) [![Linux/Mac Travis Build Status](https://img.shields.io/travis/GuangchuangYu/ggtree/master.svg?label=Mac%20OSX%20%26%20Linux)](https://travis-ci.org/GuangchuangYu/ggtree) [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/Guangchuangyu/ggtree/master.svg?label=Windows)](https://ci.appveyor.com/project/GuangchuangYu/ggtree) [![install with bioconda](https://img.shields.io/badge/install%20with-bioconda-green.svg?style=flat)](http://bioconda.github.io/recipes/bioconductor-ggtree/README.html)
9 9
... ... 
@@ -50,7 +50,7 @@ For details, please visit our project website, <https://guangchuangyu.github.io/
50 50
51 51 
 ### Download stats
52 52
53 
-[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree/) [![total](https://img.shields.io/badge/downloads-13544/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1122/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
53 
+[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree/) [![total](https://img.shields.io/badge/downloads-13863/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1122/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
54 54
55 55 
          +--------------------------+--------------------------+--------------------------+------------+
56 56 
          |                                                                               *             |