Browse code

Document update

Document update

William Lee authored on 22/03/2022 14:46:29
Showing 1 changed files
... ...
@@ -1,5 +1,5 @@
1 1
 
2
-##' add tip point
2
+##' add tip point layer for a tree
3 3
 ##'
4 4
 ##'
5 5
 ##' @title geom_tippoint
... ...
@@ -7,6 +7,15 @@
7 7
 ##' @return tip point layer
8 8
 ##' @export
9 9
 ##' @author Guangchuang Yu
10
+##' @examples
11
+##' library(ggtree)
12
+##' tr<- rtree(15)
13
+##' x <- ggtree(tr)
14
+##' x + geom_tippoint()
15
+##' @references
16
+##' For more detailed demonstration, please refer to chapter 4.3.2 of 
17
+##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees*
18
+##' <http://yulab-smu.top/treedata-book/index.html> by Guangchuang Yu.
10 19
 geom_tippoint <- function(mapping = NULL, data = NULL,
11 20
                        position = "identity", na.rm = FALSE,
12 21
                           show.legend = NA, inherit.aes = TRUE, ...) {
... ...
@@ -49,7 +58,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
49 58
 ## }
50 59
 
51 60
 
52
-##' add node point
61
+##' add node point layer to a tree
53 62
 ##'
54 63
 ##'
55 64
 ##' @title geom_nodepoint
... ...
@@ -58,6 +67,14 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
58 67
 ##' @importFrom ggplot2 aes_string
59 68
 ##' @export
60 69
 ##' @author Guangchuang Yu
70
+##' library(ggtree)
71
+##' tr<- rtree(15)
72
+##' x <- ggtree(tr)
73
+##' x + geom_nodepoint()
74
+##' @references
75
+##' For more detailed demonstration, please refer to chapter 4.3.2 of 
76
+##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees*
77
+##' <http://yulab-smu.top/treedata-book/index.html> by Guangchuang Yu.
61 78
 geom_nodepoint <- function(mapping = NULL, data = NULL,
62 79
                        position = "identity", na.rm = FALSE,
63 80
                        show.legend = NA, inherit.aes = TRUE, ...) {
... ...
@@ -80,9 +97,9 @@ geom_nodepoint <- function(mapping = NULL, data = NULL,
80 97
 }
81 98
 
82 99
 
83
-##' geom_rootpoint is used to add root point
100
+##' geom_rootpoint is used to add root point layer to a tree
84 101
 ##'
85
-##' geom_rootpoint inherit from geom_point2, it is used to display and customize the points on the root
102
+##' geom_rootpoint inherit from geom_point2, and it is used to display and customize the points on the root
86 103
 ##'
87 104
 ##' @title geom_rootpoint
88 105
 ##' @inheritParams geom_point2
... ...
@@ -136,13 +153,13 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
136 153
 #' If `inherit.aes = TRUE`, the mapping can be inherited from the plot mapping as
137 154
 #' specified in the call to `ggplot()`.
138 155
 #' @param data The data to be displayed in this layer. If 'NULL' (the default),
139
-#' the data is inherited from the plot data as specified in the call to 'ggplot()',
156
+#' the data is inherited from the plot data as specified in the call to `ggplot()`.
140 157
 #' @param stat Name of the statistical transformation to be used on the data for this layer.
141 158
 #' @param position Position adjustment.
142
-#' @param na.rm logical. If 'FALSE' (the default), missing values are removed with a warning. If 'TRUE', missing values are silently removed.
159
+#' @param na.rm logical. If 'FALSE' (default), missing values are removed with a warning. If 'TRUE', missing values are silently removed.
143 160
 #' @param show.legend logical. Should this layer be included in the legends?
144 161
 #' 'NA', the default, includes if any aesthetics are mapped. 'FALSE' never includes, and 'TRUE' always includes.
145
-#' @param inherit.aes logical (default is 'TRUE'). If 'FALSE', overrides the default aesthetics,
162
+#' @param inherit.aes logical (defaults to 'TRUE'). If 'FALSE', overrides the default aesthetics,
146 163
 #' rather then combining with them.
147 164
 #' @param ... addtional parameters that passed on to this layer. These are often aesthetics, used to set an aesthetic to a fixed value, like `colour = "red"` or `size = 3`.
148 165
 #' @importFrom ggplot2 layer
... ...
@@ -150,12 +167,12 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
150 167
 #' \code{geom_point2()} understands the following aesthetics
151 168
 #'     \itemize{
152 169
 #'        \item \code{subset} logical expression indicating elements or rows to keep: missing values are taken as false; should be in aes().
153
-#'        \item \code{colour} the colour of point, default is black.
154
-#'        \item \code{fill} the colour of fill, default is black.
155
-#'        \item \code{alpha} the transparency of fill, default is 1.
156
-#'        \item \code{size} the size of point, default is 1.5.
157
-#'        \item \code{shape} specify a shape, default is 19.
158
-#'        \item \code{stroke} control point border thickness of point, default is 0.5.
170
+#'        \item \code{colour} the colour of point, defaults to "black".
171
+#'        \item \code{fill} the colour of fill, defaults to "black".
172
+#'        \item \code{alpha} the transparency of fill, defaults to 1.
173
+#'        \item \code{size} the size of point, defaults to 1.5.
174
+#'        \item \code{shape} specify a shape, defaults to 19.
175
+#'        \item \code{stroke} control point border thickness of point, defaults to 0.5.
159 176
 #'     }
160 177
 #' @seealso
161 178
 #'  [geom_point][ggplot2::geom_point]; 
Browse code

update

Guangchuang Yu authored on 08/01/2021 07:30:55
Showing 1 changed files
... ...
@@ -89,19 +89,7 @@ geom_nodepoint <- function(mapping = NULL, data = NULL,
89 89
 ##' @return root point layer
90 90
 ##' @export
91 91
 ##' @author Guangchuang Yu
92
-##' @references 1. G Yu, DK Smith, H Zhu, Y Guan, TTY Lam (2017). ggtree: an R package for
93
-##' visualization and annotation of phylogenetic trees with their covariates and
94
-##' other associated data. Methods in Ecology and Evolution, 8(1):28-36.
95
-##' <https://doi.org/10.1111/2041-210X.12628>
96
-##' 
97
-##' 2. G Yu*, TTY Lam, H Zhu, Y Guan*. Two methods for mapping and visualizing associated data 
98
-##' on phylogeny using ggtree. Molecular Biology and Evolution, 2018, 35(2):3041-3043. <https://doi.org/10.1093/molbev/msy194>
99
-##' 
100
-##' 3. G Yu. Using ggtree to visualize data on tree-like structures. Current Protocols in 
101
-##' Bioinformatics, 2020, 69:e96. <https://doi.org/10.1002/cpbi.96>
102
-##' 
103
-##' For more information about tree visualization, please refer to the online book
104
-##' <https://yulab-smu.top/treedata-book/>
92
+##' @references `r ggtree:::ggtree_references()`
105 93
 ##' @seealso
106 94
 ##'  [geom_point][ggplot2::geom_point]; 
107 95
 ##'  [geom_rootpoint] add point of root; 
Browse code

update document of geom_rootpoint()

xiayh17 authored on 08/01/2021 06:14:53
Showing 1 changed files
... ...
@@ -80,14 +80,39 @@ geom_nodepoint <- function(mapping = NULL, data = NULL,
80 80
 }
81 81
 
82 82
 
83
-##' add root point
83
+##' geom_rootpoint is used to add root point
84 84
 ##'
85
+##' geom_rootpoint inherit from geom_point2, it is used to display and customize the points on the root
85 86
 ##'
86 87
 ##' @title geom_rootpoint
87 88
 ##' @inheritParams geom_point2
88 89
 ##' @return root point layer
89 90
 ##' @export
90 91
 ##' @author Guangchuang Yu
92
+##' @references 1. G Yu, DK Smith, H Zhu, Y Guan, TTY Lam (2017). ggtree: an R package for
93
+##' visualization and annotation of phylogenetic trees with their covariates and
94
+##' other associated data. Methods in Ecology and Evolution, 8(1):28-36.
95
+##' <https://doi.org/10.1111/2041-210X.12628>
96
+##' 
97
+##' 2. G Yu*, TTY Lam, H Zhu, Y Guan*. Two methods for mapping and visualizing associated data 
98
+##' on phylogeny using ggtree. Molecular Biology and Evolution, 2018, 35(2):3041-3043. <https://doi.org/10.1093/molbev/msy194>
99
+##' 
100
+##' 3. G Yu. Using ggtree to visualize data on tree-like structures. Current Protocols in 
101
+##' Bioinformatics, 2020, 69:e96. <https://doi.org/10.1002/cpbi.96>
102
+##' 
103
+##' For more information about tree visualization, please refer to the online book
104
+##' <https://yulab-smu.top/treedata-book/>
105
+##' @seealso
106
+##'  [geom_point][ggplot2::geom_point]; 
107
+##'  [geom_rootpoint] add point of root; 
108
+##'  [geom_nodepoint] add points of internal nodes; 
109
+##'  [geom_tippoint] add points of external nodes (also known as tips or leaves).
110
+##' @examples
111
+##' library(ggtree)
112
+##' tr <- rtree(10)
113
+##' ##  add root point
114
+##' ggtree(tr) + geom_rootpoint()
115
+##' ggtree(tr) + geom_rootpoint(size=2,color="red",shape=2)
91 116
 geom_rootpoint <- function(mapping = NULL, data = NULL,
92 117
                            position = "identity", na.rm = FALSE,
93 118
                            show.legend = NA, inherit.aes = TRUE, ...) {
Browse code

fortify method for treedataList

Guangchuang Yu authored on 20/09/2020 06:49:31
Showing 1 changed files
... ...
@@ -14,10 +14,16 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
14 14
     if (is.null(mapping)) {
15 15
         mapping <- self_mapping
16 16
     } else {
17
-        if (!is.null(mapping$subset)) {
18
-            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(get_aes_var(mapping, "subset")), '&isTip'))
17
+        if (is.null(mapping$subset)) {
18
+            mapping <- modifyList(self_mapping, mapping)   
19
+        } else { 
20
+            mapping <- modifyList(self_mapping, mapping)
21
+            subset_mapping <- aes_string(subset = paste0(
22
+                                             as.expression(get_aes_var(mapping, "subset")),
23
+                                             '&isTip')
24
+                                         )
25
+            mapping <- modifyList(mapping, subset_mapping)
19 26
         }
20
-        mapping <- modifyList(self_mapping, mapping)
21 27
     }
22 28
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
23 29
 }
... ...
@@ -59,10 +65,16 @@ geom_nodepoint <- function(mapping = NULL, data = NULL,
59 65
     if (is.null(mapping)) {
60 66
         mapping <- self_mapping
61 67
     } else {
62
-        if (!is.null(mapping$subset)) {
63
-            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(get_aes_var(mapping, "subset")), '&!isTip'))
68
+        if (is.null(mapping$subset)) {
69
+            mapping <- modifyList(self_mapping, mapping)   
70
+        } else {
71
+            mapping <- modifyList(self_mapping, mapping)
72
+            subset_mapping <- aes_string(subset = paste0(
73
+                                             as.expression(get_aes_var(mapping, "subset")),
74
+                                             '&!isTip')
75
+                                         )
76
+            mapping <- modifyList(mapping, subset_mapping)               
64 77
         }
65
-        mapping %<>% modifyList(self_mapping)
66 78
     }
67 79
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
68 80
 }
... ...
@@ -84,7 +96,18 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
84 96
     if (is.null(mapping)) {
85 97
         mapping <- self_mapping
86 98
     } else {
87
-        mapping %<>% modifyList(self_mapping)
99
+        if (is.null(mapping$subset)) {
100
+            mapping <- modifyList(self_mapping, mapping)               
101
+        } else {
102
+            mapping <- modifyList(self_mapping, mapping)
103
+            subset_mapping <- aes_string(subset = paste0(
104
+                                             as.expression(get_aes_var(mapping, "subset")),
105
+                                             '&node==parent')
106
+                                         )
107
+            mapping <- modifyList(mapping, subset_mapping)   
108
+        }
109
+
110
+
88 111
     }
89 112
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
90 113
 }
Browse code

update geom_point2 manual

Guangchuang Yu authored on 25/08/2020 03:22:29
Showing 1 changed files
... ...
@@ -90,20 +90,25 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
90 90
 }
91 91
 
92 92
 
93
-#' geom_point2 support aes(subset) via setup_data
93
+#' geom_point2 is a modified version of geom_point that supports aes(subset)
94
+#'
95
+#' `geom_point2` creates scatterplots, just similar to `ggplot2::geom_point`. It extends the `ggplot2::geom_point` to support filtering via the `subset` aesthetic mapping (see Aesthetics section).
94 96
 #'
95
-#' `geom_point2` supports data.frame as input.And aesthetics of layer can be mapped.
96
-#' you can see the Aesthetics section to set parameters. 
97 97
 #'
98 98
 #' @title geom_point2
99
-#' @param mapping aes mapping
100
-#' @param data data
101
-#' @param stat Name of stat to modify data
102
-#' @param position position
103
-#' @param na.rm logical
104
-#' @param show.legend logical
105
-#' @param inherit.aes logical
106
-#' @param ... addktional parameter
99
+#' @param mapping Set of aesthetic mapping created by `aes()`.
100
+#' If `inherit.aes = TRUE`, the mapping can be inherited from the plot mapping as
101
+#' specified in the call to `ggplot()`.
102
+#' @param data The data to be displayed in this layer. If 'NULL' (the default),
103
+#' the data is inherited from the plot data as specified in the call to 'ggplot()',
104
+#' @param stat Name of the statistical transformation to be used on the data for this layer.
105
+#' @param position Position adjustment.
106
+#' @param na.rm logical. If 'FALSE' (the default), missing values are removed with a warning. If 'TRUE', missing values are silently removed.
107
+#' @param show.legend logical. Should this layer be included in the legends?
108
+#' 'NA', the default, includes if any aesthetics are mapped. 'FALSE' never includes, and 'TRUE' always includes.
109
+#' @param inherit.aes logical (default is 'TRUE'). If 'FALSE', overrides the default aesthetics,
110
+#' rather then combining with them.
111
+#' @param ... addtional parameters that passed on to this layer. These are often aesthetics, used to set an aesthetic to a fixed value, like `colour = "red"` or `size = 3`.
107 112
 #' @importFrom ggplot2 layer
108 113
 #' @section Aesthetics:
109 114
 #' \code{geom_point2()} understands the following aesthetics
... ...
@@ -119,8 +124,8 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
119 124
 #' @seealso
120 125
 #'  [geom_point][ggplot2::geom_point]; 
121 126
 #'  [geom_rootpoint] add point of root; 
122
-#'  [geom_nodepoint] add point of node; 
123
-#'  [geom_tippoint] add point of tip.
127
+#'  [geom_nodepoint] add points of internal nodes; 
128
+#'  [geom_tippoint] add points of external nodes (also known as tips or leaves).
124 129
 #' @export
125 130
 #' @return point layer
126 131
 #' @author Guangchuang Yu 
... ...
@@ -130,24 +135,24 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
130 135
 #' <https://doi.org/10.1111/2041-210X.12628>
131 136
 #' 
132 137
 #' 2. G Yu*, TTY Lam, H Zhu, Y Guan*. Two methods for mapping and visualizing associated data 
133
-#' on phylogeny using ggtree. Molecular Biology and Evolution, 2018, 35(2):3041-3043. doi: 10.1093/molbev/msy194.
138
+#' on phylogeny using ggtree. Molecular Biology and Evolution, 2018, 35(2):3041-3043. <https://doi.org/10.1093/molbev/msy194>
134 139
 #' 
135 140
 #' 3. G Yu. Using ggtree to visualize data on tree-like structures. Current Protocols in 
136
-#' Bioinformatics, 2020, 69:e96. doi: 10.1002/cpbi.96.
141
+#' Bioinformatics, 2020, 69:e96. <https://doi.org/10.1002/cpbi.96>
137 142
 #' 
138 143
 #' For more information about tree visualization, please refer to the online book
139
-#' \url{https://yulab-smu.top/treedata-book/}
144
+#' <https://yulab-smu.top/treedata-book/>
140 145
 #' @export
141 146
 #' @examples
142 147
 #' library(ggtree)
143 148
 #' ## add point by aes(subset)
144 149
 #' tr <- rtree(10)
145 150
 #' # group tip and node
146
-#' ggtree(tr) + geom_point(aes(shape=isTip, color=isTip), size=3)
151
+#' ggtree(tr) + geom_point2(aes(shape=isTip, color=isTip), size=3)
147 152
 #' # specify a node to display
148 153
 #' ggtree(tr) + geom_point2(aes(subset=(node==15)), shape=21, size=5, fill='green')
149 154
 #' # specify a tip to display
150
-#' ggtree(tr) + geom_point2(aes(subset=(label=="t1")), shape=21, size=5, fill='green')
155
+#' ggtree(tr) + geom_point2(aes(subset=(label %in% c("t1", "t3"))), shape=21, size=5, fill='green')
151 156
 #' 
152 157
 #' ## color point with continuous variables
153 158
 #' library(ggtree)
... ...
@@ -157,7 +162,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
157 162
 #' beast_tree <- read.beast(beast_file)
158 163
 #' p <- ggtree(beast_tree) +
159 164
 #'   geom_tiplab(hjust = -.1)+ 
160
-#'   geom_point(aes(fill = rate), shape = 21, size = 4) +
165
+#'   geom_nodepoint(aes(fill = rate), shape = 21, size = 4) +
161 166
 #'   scale_fill_continuous(low = 'blue', high = 'red') +
162 167
 #'   theme_tree2() + theme(legend.position = 'right')
163 168
 #' p
... ...
@@ -165,7 +170,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
165 170
 geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
166 171
                        position = "identity", na.rm = FALSE,
167 172
                        show.legend = NA, inherit.aes = TRUE, ...) {
168
-
173
+  
169 174
 
170 175
     default_aes <- aes_() # node=~node)
171 176
     if (is.null(mapping)) {
Browse code

delete the error term of " for rectangular layer"

xiayh17 authored on 23/08/2020 17:07:51
Showing 1 changed files
... ...
@@ -106,7 +106,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
106 106
 #' @param ... addktional parameter
107 107
 #' @importFrom ggplot2 layer
108 108
 #' @section Aesthetics:
109
-#' \code{geom_point2()} understands the following aesthetics for rectangular layer
109
+#' \code{geom_point2()} understands the following aesthetics
110 110
 #'     \itemize{
111 111
 #'        \item \code{subset} logical expression indicating elements or rows to keep: missing values are taken as false; should be in aes().
112 112
 #'        \item \code{colour} the colour of point, default is black.
Browse code

add aes param subset, modified online book reference

xiayh17 authored on 22/08/2020 11:05:37
Showing 1 changed files
... ...
@@ -108,6 +108,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
108 108
 #' @section Aesthetics:
109 109
 #' \code{geom_point2()} understands the following aesthetics for rectangular layer
110 110
 #'     \itemize{
111
+#'        \item \code{subset} logical expression indicating elements or rows to keep: missing values are taken as false; should be in aes().
111 112
 #'        \item \code{colour} the colour of point, default is black.
112 113
 #'        \item \code{fill} the colour of fill, default is black.
113 114
 #'        \item \code{alpha} the transparency of fill, default is 1.
... ...
@@ -133,6 +134,9 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
133 134
 #' 
134 135
 #' 3. G Yu. Using ggtree to visualize data on tree-like structures. Current Protocols in 
135 136
 #' Bioinformatics, 2020, 69:e96. doi: 10.1002/cpbi.96.
137
+#' 
138
+#' For more information about tree visualization, please refer to the online book
139
+#' \url{https://yulab-smu.top/treedata-book/}
136 140
 #' @export
137 141
 #' @examples
138 142
 #' library(ggtree)
... ...
@@ -158,8 +162,6 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
158 162
 #'   theme_tree2() + theme(legend.position = 'right')
159 163
 #' p
160 164
 #' 
161
-#' ## For more information about tree visualization, please refer to our online book
162
-#' \url{https://yulab-smu.top/treedata-book/}
163 165
 geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
164 166
                        position = "identity", na.rm = FALSE,
165 167
                        show.legend = NA, inherit.aes = TRUE, ...) {
Browse code

add details, aesthetics ,reference and example sections; modified seealso section

xiayh17 authored on 22/08/2020 10:01:14
Showing 1 changed files
... ...
@@ -90,24 +90,76 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
90 90
 }
91 91
 
92 92
 
93
-##' geom_point2 support aes(subset) via setup_data
94
-##'
95
-##'
96
-##' @title geom_point2
97
-##' @param mapping aes mapping
98
-##' @param data data
99
-##' @param stat Name of stat to modify data
100
-##' @param position position
101
-##' @param na.rm logical
102
-##' @param show.legend logical
103
-##' @param inherit.aes logical
104
-##' @param ... addktional parameter
105
-##' @importFrom ggplot2 layer
106
-##' @export
107
-##' @seealso
108
-##' [geom_point][ggplot2::geom_point]
109
-##' @return point layer
110
-##' @author Guangchuang Yu
93
+#' geom_point2 support aes(subset) via setup_data
94
+#'
95
+#' `geom_point2` supports data.frame as input.And aesthetics of layer can be mapped.
96
+#' you can see the Aesthetics section to set parameters. 
97
+#'
98
+#' @title geom_point2
99
+#' @param mapping aes mapping
100
+#' @param data data
101
+#' @param stat Name of stat to modify data
102
+#' @param position position
103
+#' @param na.rm logical
104
+#' @param show.legend logical
105
+#' @param inherit.aes logical
106
+#' @param ... addktional parameter
107
+#' @importFrom ggplot2 layer
108
+#' @section Aesthetics:
109
+#' \code{geom_point2()} understands the following aesthetics for rectangular layer
110
+#'     \itemize{
111
+#'        \item \code{colour} the colour of point, default is black.
112
+#'        \item \code{fill} the colour of fill, default is black.
113
+#'        \item \code{alpha} the transparency of fill, default is 1.
114
+#'        \item \code{size} the size of point, default is 1.5.
115
+#'        \item \code{shape} specify a shape, default is 19.
116
+#'        \item \code{stroke} control point border thickness of point, default is 0.5.
117
+#'     }
118
+#' @seealso
119
+#'  [geom_point][ggplot2::geom_point]; 
120
+#'  [geom_rootpoint] add point of root; 
121
+#'  [geom_nodepoint] add point of node; 
122
+#'  [geom_tippoint] add point of tip.
123
+#' @export
124
+#' @return point layer
125
+#' @author Guangchuang Yu 
126
+#' @references 1. G Yu, DK Smith, H Zhu, Y Guan, TTY Lam (2017). ggtree: an R package for
127
+#' visualization and annotation of phylogenetic trees with their covariates and
128
+#' other associated data. Methods in Ecology and Evolution, 8(1):28-36.
129
+#' <https://doi.org/10.1111/2041-210X.12628>
130
+#' 
131
+#' 2. G Yu*, TTY Lam, H Zhu, Y Guan*. Two methods for mapping and visualizing associated data 
132
+#' on phylogeny using ggtree. Molecular Biology and Evolution, 2018, 35(2):3041-3043. doi: 10.1093/molbev/msy194.
133
+#' 
134
+#' 3. G Yu. Using ggtree to visualize data on tree-like structures. Current Protocols in 
135
+#' Bioinformatics, 2020, 69:e96. doi: 10.1002/cpbi.96.
136
+#' @export
137
+#' @examples
138
+#' library(ggtree)
139
+#' ## add point by aes(subset)
140
+#' tr <- rtree(10)
141
+#' # group tip and node
142
+#' ggtree(tr) + geom_point(aes(shape=isTip, color=isTip), size=3)
143
+#' # specify a node to display
144
+#' ggtree(tr) + geom_point2(aes(subset=(node==15)), shape=21, size=5, fill='green')
145
+#' # specify a tip to display
146
+#' ggtree(tr) + geom_point2(aes(subset=(label=="t1")), shape=21, size=5, fill='green')
147
+#' 
148
+#' ## color point with continuous variables
149
+#' library(ggtree)
150
+#' library(treeio)
151
+#' library(ggplot2)
152
+#' beast_file <- system.file("examples/MCC_FluA_H3.tree", package="ggtree")
153
+#' beast_tree <- read.beast(beast_file)
154
+#' p <- ggtree(beast_tree) +
155
+#'   geom_tiplab(hjust = -.1)+ 
156
+#'   geom_point(aes(fill = rate), shape = 21, size = 4) +
157
+#'   scale_fill_continuous(low = 'blue', high = 'red') +
158
+#'   theme_tree2() + theme(legend.position = 'right')
159
+#' p
160
+#' 
161
+#' ## For more information about tree visualization, please refer to our online book
162
+#' \url{https://yulab-smu.top/treedata-book/}
111 163
 geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
112 164
                        position = "identity", na.rm = FALSE,
113 165
                        show.legend = NA, inherit.aes = TRUE, ...) {
Browse code

roxygen2md

Guangchuang Yu authored on 01/11/2019 04:24:00
Showing 1 changed files
... ...
@@ -105,7 +105,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
105 105
 ##' @importFrom ggplot2 layer
106 106
 ##' @export
107 107
 ##' @seealso
108
-##' \link[ggplot2]{geom_point}
108
+##' [geom_point][ggplot2::geom_point]
109 109
 ##' @return point layer
110 110
 ##' @author Guangchuang Yu
111 111
 geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
Browse code

compatible with ggplot2 v2.2.1 & 2.2.2

guangchuang yu authored on 25/06/2018 07:19:15
Showing 1 changed files
... ...
@@ -15,7 +15,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
15 15
         mapping <- self_mapping
16 16
     } else {
17 17
         if (!is.null(mapping$subset)) {
18
-            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(mapping$subset), '&isTip'))
18
+            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(get_aes_var(mapping, "subset")), '&isTip'))
19 19
         }
20 20
         mapping <- modifyList(self_mapping, mapping)
21 21
     }
... ...
@@ -60,7 +60,7 @@ geom_nodepoint <- function(mapping = NULL, data = NULL,
60 60
         mapping <- self_mapping
61 61
     } else {
62 62
         if (!is.null(mapping$subset)) {
63
-            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(mapping$subset), '&!isTip'))
63
+            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(get_aes_var(mapping, "subset")), '&!isTip'))
64 64
         }
65 65
         mapping %<>% modifyList(self_mapping)
66 66
     }
Browse code

update geom_tippoint

guangchuang yu authored on 02/02/2018 07:58:26
Showing 1 changed files
... ...
@@ -14,6 +14,9 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
14 14
     if (is.null(mapping)) {
15 15
         mapping <- self_mapping
16 16
     } else {
17
+        if (!is.null(mapping$subset)) {
18
+            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(mapping$subset), '&isTip'))
19
+        }
17 20
         mapping <- modifyList(self_mapping, mapping)
18 21
     }
19 22
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
Browse code

support passing `aes(subset)` in geom_nodepoint

guangchuang yu authored on 26/01/2018 04:50:30
Showing 1 changed files
... ...
@@ -46,16 +46,19 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
46 46
 ##' @title geom_nodepoint
47 47
 ##' @inheritParams geom_point2
48 48
 ##' @return node point layer
49
+##' @importFrom ggplot2 aes_string
49 50
 ##' @export
50 51
 ##' @author Guangchuang Yu
51 52
 geom_nodepoint <- function(mapping = NULL, data = NULL,
52 53
                        position = "identity", na.rm = FALSE,
53 54
                        show.legend = NA, inherit.aes = TRUE, ...) {
54
-    node <- isTip <- NULL
55
-    self_mapping <- aes(node = node, subset = !isTip)
55
+    self_mapping <- aes_(node = ~node, subset = ~ (!isTip))
56 56
     if (is.null(mapping)) {
57 57
         mapping <- self_mapping
58 58
     } else {
59
+        if (!is.null(mapping$subset)) {
60
+            self_mapping <- aes_string(node = "node", subset = paste0(as.expression(mapping$subset), '&!isTip'))
61
+        }
59 62
         mapping %<>% modifyList(self_mapping)
60 63
     }
61 64
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
Browse code

now geom_text2, geom_label2, geom_point2 and geom_segment2 work with ggplot2

guangchuang yu authored on 01/08/2017 12:22:46
Showing 1 changed files
... ...
@@ -10,14 +10,13 @@
10 10
 geom_tippoint <- function(mapping = NULL, data = NULL,
11 11
                        position = "identity", na.rm = FALSE,
12 12
                           show.legend = NA, inherit.aes = TRUE, ...) {
13
-    isTip <- NULL
14
-    self_mapping <- aes(subset = isTip)
13
+    self_mapping <- aes_(node = ~node, subset = ~isTip)
15 14
     if (is.null(mapping)) {
16 15
         mapping <- self_mapping
17 16
     } else {
18 17
         mapping <- modifyList(self_mapping, mapping)
19 18
     }
20
-    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
19
+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
21 20
 }
22 21
 
23 22
 ## angle is not supported,
... ...
@@ -52,14 +51,14 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
52 51
 geom_nodepoint <- function(mapping = NULL, data = NULL,
53 52
                        position = "identity", na.rm = FALSE,
54 53
                        show.legend = NA, inherit.aes = TRUE, ...) {
55
-    isTip <- NULL
56
-    self_mapping <- aes(subset = !isTip)
54
+    node <- isTip <- NULL
55
+    self_mapping <- aes(node = node, subset = !isTip)
57 56
     if (is.null(mapping)) {
58 57
         mapping <- self_mapping
59 58
     } else {
60 59
         mapping %<>% modifyList(self_mapping)
61 60
     }
62
-    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
61
+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
63 62
 }
64 63
 
65 64
 
... ...
@@ -75,13 +74,13 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
75 74
                            position = "identity", na.rm = FALSE,
76 75
                            show.legend = NA, inherit.aes = TRUE, ...) {
77 76
     isTip <- node <- parent <- NULL
78
-    self_mapping <- aes(subset = (node == parent))
77
+    self_mapping <- aes(node = node, subset = (node == parent))
79 78
     if (is.null(mapping)) {
80 79
         mapping <- self_mapping
81 80
     } else {
82 81
         mapping %<>% modifyList(self_mapping)
83 82
     }
84
-    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
83
+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, stat = StatTreeData, ...)
85 84
 }
86 85
 
87 86
 
... ...
@@ -91,6 +90,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
91 90
 ##' @title geom_point2
92 91
 ##' @param mapping aes mapping
93 92
 ##' @param data data
93
+##' @param stat Name of stat to modify data
94 94
 ##' @param position position
95 95
 ##' @param na.rm logical
96 96
 ##' @param show.legend logical
... ...
@@ -102,12 +102,12 @@ geom_rootpoint <- function(mapping = NULL, data = NULL,
102 102
 ##' \link[ggplot2]{geom_point}
103 103
 ##' @return point layer
104 104
 ##' @author Guangchuang Yu
105
-geom_point2 <- function(mapping = NULL, data = NULL,
105
+geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
106 106
                        position = "identity", na.rm = FALSE,
107 107
                        show.legend = NA, inherit.aes = TRUE, ...) {
108 108
 
109 109
 
110
-    default_aes <- aes_(node=~node)
110
+    default_aes <- aes_() # node=~node)
111 111
     if (is.null(mapping)) {
112 112
         mapping <- default_aes
113 113
     } else {
... ...
@@ -117,7 +117,7 @@ geom_point2 <- function(mapping = NULL, data = NULL,
117 117
     layer(
118 118
         data = data,
119 119
         mapping = mapping,
120
-        stat = StatTreeData,
120
+        stat = stat,
121 121
         geom = GeomPointGGtree,
122 122
         position = position,
123 123
         show.legend = show.legend,
Browse code

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

guangchuang yu authored on 16/02/2017 06:10:17
Showing 1 changed files
... ...
@@ -137,7 +137,7 @@ GeomPointGGtree <- ggproto("GeomPointGGtree", GeomPoint,
137 137
                            setup_data = function(data, params) {
138 138
                                if (is.null(data$subset))
139 139
                                    return(data)
140
-                               data[data$subset,]
140
+                               data[which(data$subset),]
141 141
                            }
142 142
 
143 143
                            ## ,
Browse code

ggplot2 2.2.0

guangchuang yu authored on 14/11/2016 04:41:23
Showing 1 changed files
... ...
@@ -126,7 +126,7 @@ geom_point2 <- function(mapping = NULL, data = NULL,
126 126
             na.rm = na.rm,
127 127
             ...
128 128
         ),
129
-        if (packageVersion('ggplot2') > '2.1.0') check.aes = FALSE
129
+        check.aes = FALSE
130 130
     )
131 131
 }
132 132
 
Browse code

fixed R check

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

g.yu authored on 11/10/2016 01:31:56
Showing 1 changed files
... ...
@@ -126,7 +126,7 @@ geom_point2 <- function(mapping = NULL, data = NULL,
126 126
             na.rm = na.rm,
127 127
             ...
128 128
         ),
129
-        check.aes = FALSE
129
+        if (packageVersion('ggplot2') > '2.1.0') check.aes = FALSE
130 130
     )
131 131
 }
132 132
 
Browse code

version 1.5.15

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

g.yu authored on 07/10/2016 05:18:29
Showing 1 changed files
... ...
@@ -125,7 +125,8 @@ geom_point2 <- function(mapping = NULL, data = NULL,
125 125
         params = list(
126 126
             na.rm = na.rm,
127 127
             ...
128
-        )
128
+        ),
129
+        check.aes = FALSE
129 130
     )
130 131
 }
131 132
 
Browse code

comment out geom_tippoint2

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

g.yu authored on 05/10/2016 09:44:05
Showing 1 changed files
... ...
@@ -20,21 +20,25 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
20 20
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
21 21
 }
22 22
 
23
-geom_tippoint2 <- function(mapping=NULL, hjust=0, ...) {
24
-    angle <- NULL
25
-    isTip <- NULL
26
-    m1 <- aes(subset=(isTip & (angle < 90 | angle > 270)), angle=angle)
27
-    m2 <- aes(subset=(isTip & (angle >= 90 & angle <=270)), angle=angle+180)
28
-
29
-    if (!is.null(mapping)) {
30
-        m1 <- modifyList(mapping, m1)
31
-        m2 <- modifyList(mapping, m2)
32
-    }
33
-
34
-    list(geom_tippoint(m1, hjust=hjust, ...),
35
-         geom_tippoint(m2, hjust=1-hjust, ...)
36
-         )
37
-}
23
+## angle is not supported,
24
+## https://github.com/GuangchuangYu/ggtree/issues/77
25
+##
26
+##
27
+## geom_tippoint2 <- function(mapping=NULL, hjust=0, ...) {
28
+##     angle <- NULL
29
+##     isTip <- NULL
30
+##     m1 <- aes(subset=(isTip & (angle < 90 | angle > 270)), angle=angle)
31
+##     m2 <- aes(subset=(isTip & (angle >= 90 & angle <=270)), angle=angle+180)
32
+
33
+##     if (!is.null(mapping)) {
34
+##         m1 <- modifyList(mapping, m1)
35
+##         m2 <- modifyList(mapping, m2)
36
+##     }
37
+
38
+##     list(geom_tippoint(m1, hjust=hjust, ...),
39
+##          geom_tippoint(m2, hjust=1-hjust, ...)
40
+##          )
41
+## }
38 42
 
39 43
 
40 44
 ##' add node point
Browse code

subset tip in geom_tiplab2

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

g.yu authored on 05/10/2016 08:52:08
Showing 1 changed files
... ...
@@ -22,6 +22,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
22 22
 
23 23
 geom_tippoint2 <- function(mapping=NULL, hjust=0, ...) {
24 24
     angle <- NULL
25
+    isTip <- NULL
25 26
     m1 <- aes(subset=(isTip & (angle < 90 | angle > 270)), angle=angle)
26 27
     m2 <- aes(subset=(isTip & (angle >= 90 & angle <=270)), angle=angle+180)
27 28
 
Browse code

fixed geom_tiplab2

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

g.yu authored on 05/10/2016 08:51:00
Showing 1 changed files
... ...
@@ -15,11 +15,27 @@ geom_tippoint <- function(mapping = NULL, data = NULL,
15 15
     if (is.null(mapping)) {
16 16
         mapping <- self_mapping
17 17
     } else {
18
-        mapping %<>% modifyList(self_mapping)
18
+        mapping <- modifyList(self_mapping, mapping)
19 19
     }
20 20
     geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
21 21
 }
22 22
 
23
+geom_tippoint2 <- function(mapping=NULL, hjust=0, ...) {
24
+    angle <- NULL
25
+    m1 <- aes(subset=(isTip & (angle < 90 | angle > 270)), angle=angle)
26
+    m2 <- aes(subset=(isTip & (angle >= 90 & angle <=270)), angle=angle+180)
27
+
28
+    if (!is.null(mapping)) {
29
+        m1 <- modifyList(mapping, m1)
30
+        m2 <- modifyList(mapping, m2)
31
+    }
32
+
33
+    list(geom_tippoint(m1, hjust=hjust, ...),
34
+         geom_tippoint(m2, hjust=1-hjust, ...)
35
+         )
36
+}
37
+
38
+
23 39
 ##' add node point
24 40
 ##'
25 41
 ##'
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 1 changed files
... ...
@@ -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)
Browse code

geom_label2

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

g.yu authored on 07/04/2016 04:02:44
Showing 1 changed files
... ...
@@ -7,7 +7,7 @@
7 7
 ##' @return tip point layer
8 8
 ##' @export
9 9
 ##' @author Guangchuang Yu
10
-geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",
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,7 +17,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",
17 17
     } else {
18 18
         mapping %<>% modifyList(self_mapping)
19 19
     }
20
-    geom_point2(mapping, data, stat, 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
... ...
@@ -28,7 +28,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",
28 28
 ##' @return node point layer
29 29
 ##' @export
30 30
 ##' @author Guangchuang Yu
31
-geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",
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,7 +38,7 @@ geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",
38 38
     } else {
39 39
         mapping %<>% modifyList(self_mapping)
40 40
     }
41
-    geom_point2(mapping, data, stat, 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
 
... ...
@@ -50,7 +50,7 @@ geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",
50 50
 ##' @return root point layer
51 51
 ##' @export
52 52
 ##' @author Guangchuang Yu
53
-geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",
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
... ...
@@ -60,7 +60,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",
60 60
     } else {
61 61
         mapping %<>% modifyList(self_mapping)
62 62
     }
63
-    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)
63
+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)
64 64
 }
65 65
 
66 66
 
... ...
@@ -70,7 +70,6 @@ geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",
70 70
 ##' @title geom_point2
71 71
 ##' @param mapping aes mapping
72 72
 ##' @param data data
73
-##' @param stat stat
74 73
 ##' @param position position
75 74
 ##' @param na.rm logical
76 75
 ##' @param show.legend logical
... ...
@@ -82,7 +81,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",
82 81
 ##' \link[ggplot2]{geom_point}
83 82
 ##' @return point layer
84 83
 ##' @author Guangchuang Yu
85
-geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
84
+geom_point2 <- function(mapping = NULL, data = NULL,
86 85
                        position = "identity", na.rm = FALSE,
87 86
                        show.legend = NA, inherit.aes = TRUE, ...) {
88 87
 
... ...
@@ -97,7 +96,7 @@ geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
97 96
     layer(
98 97
         data = data,
99 98
         mapping = mapping,
100
-        stat = StatTreePoint,
99
+        stat = StatTreeData,