Browse code

reexport arrow and unit

Guangchuang Yu authored on 28/09/2019 10:22:18
Showing6 changed files

... ...
@@ -45,6 +45,7 @@ export(StatHilight)
45 45
 export(add_colorbar)
46 46
 export(aes)
47 47
 export(annotation_image)
48
+export(arrow)
48 49
 export(as.polytomy)
49 50
 export(collapse)
50 51
 export(decimal2Date)
... ...
@@ -128,6 +129,7 @@ export(theme_dendrogram)
128 129
 export(theme_inset)
129 130
 export(theme_tree)
130 131
 export(theme_tree2)
132
+export(unit)
131 133
 export(viewClade)
132 134
 export(xlim)
133 135
 export(xlim_expand)
... ...
@@ -210,6 +212,7 @@ importFrom(ggplot2,xlim)
210 212
 importFrom(ggplot2,ylab)
211 213
 importFrom(ggplot2,ylim)
212 214
 importFrom(graphics,identify)
215
+importFrom(grid,arrow)
213 216
 importFrom(grid,convertX)
214 217
 importFrom(grid,convertY)
215 218
 importFrom(grid,dataViewport)
... ...
@@ -20,7 +20,8 @@ geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=
20 20
 
21 21
 stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identity",
22 22
                       layout="rectangular", multiPhylo=FALSE, lineend="round", MAX_COUNT=5,
23
-					  ..., show.legend=NA, inherit.aes=TRUE, na.rm=TRUE, check.param=TRUE) {
23
+                      ..., arrow=NULL, rootnode=TRUE, show.legend=NA, inherit.aes=TRUE,
24
+                      na.rm=TRUE, check.param=TRUE) {
24 25
 
25 26
     default_aes <- aes_(x=~x, y=~y,node=~node, parent=~parent)
26 27
     if (multiPhylo) {
... ...
@@ -33,6 +34,10 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit
33 34
         mapping <- modifyList(default_aes, mapping)
34 35
     }
35 36
 
37
+    if (!is.null(arrow)) {
38
+        rootnode <- FALSE
39
+    }
40
+
36 41
     if (layout %in% c("rectangular", "fan", "circular")) {
37 42
         list(layer(data=data,
38 43
                    mapping=mapping,
... ...
@@ -44,6 +49,8 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit
44 49
                    params=list(layout = layout,
45 50
                                lineend = lineend,
46 51
                                na.rm = na.rm,
52
+                               arrow = arrow,
53
+                               rootnode = rootnode,
47 54
                                ...),
48 55
                    check.aes = FALSE
49 56
                    ),
... ...
@@ -57,6 +64,8 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit
57 64
                    params=list(layout = layout,
58 65
                                lineend = lineend,
59 66
                                na.rm = na.rm,
67
+                               arrow = arrow,
68
+                               rootnode = rootnode,
60 69
                                ...),
61 70
                    check.aes = FALSE
62 71
                    )
... ...
@@ -72,6 +81,8 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit
72 81
               params=list(layout = layout,
73 82
                           lineend = lineend,
74 83
                           na.rm = na.rm,
84
+                          arrow = arrow,
85
+                          rootnode = rootnode,
75 86
                           ...),
76 87
               check.aes = FALSE
77 88
               )
... ...
@@ -151,7 +162,7 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
151 162
                                     df$yend <- y
152 163
 
153 164
                                     if (!rootnode) {
154
-                                        df <- dplyr::filter(df, .data$node != tidytree:::rootnode.tbl_tree(df)$node)
165
+                                        df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node)
155 166
                                     }
156 167
 
157 168
                                     if (continuous && !is.null(df$colour ))
... ...
@@ -190,7 +201,7 @@ StatTree <- ggproto("StatTree", Stat,
190 201
                             df$yend <- y
191 202
 
192 203
                             if (!rootnode) {
193
-                                df <- dplyr::filter(df, .data$node != tidytree:::rootnode.tbl_tree(df)$node)
204
+                                df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node)
194 205
                             }
195 206
 
196 207
                             if (continuous && !is.null(df$colour)) {
... ...
@@ -46,7 +46,9 @@ ggtree <- function(tr,
46 46
                    ...) {
47 47
 
48 48
     # Check if layout string is valid.
49
-    layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", "radial", "unrooted", "equal_angle", "daylight"))
49
+    layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular",
50
+                            "radial", "unrooted", "equal_angle", "daylight"))
51
+
50 52
     if (layout == "unrooted") {
51 53
         layout <- "daylight"
52 54
         message('"daylight" method was used as default layout for unrooted tree.')
... ...
@@ -70,4 +70,10 @@ ggplot2::geom_label
70 70
 ##' @export
71 71
 ggplot2::geom_point
72 72
 
73
+##' @importFrom grid arrow
74
+##' @export
75
+grid::arrow
73 76
 
77
+##' @importFrom grid unit
78
+##' @export
79
+grid::unit
... ...
@@ -1,2 +1,3 @@
1 1
 nodeid.tbl_tree <- utils::getFromNamespace("nodeid.tbl_tree", "tidytree")
2
+rootnode.tbl_tree <- utils::getFromNamespace("rootnode.tbl_tree", "tidytree")
2 3
 offspring.tbl_tree <- utils::getFromNamespace("offspring.tbl_tree", "tidytree")
... ...
@@ -21,6 +21,8 @@
21 21
 \alias{geom_text}
22 22
 \alias{geom_label}
23 23
 \alias{geom_point}
24
+\alias{arrow}
25
+\alias{unit}
24 26
 \title{Objects exported from other packages}
25 27
 \keyword{internal}
26 28
 \description{
... ...
@@ -34,6 +36,8 @@ below to see their documentation.
34 36
 
35 37
   \item{ggplot2}{\code{\link[ggplot2]{fortify}}, \code{\link[ggplot2]{ggplot}}, \code{\link[ggplot2]{xlim}}, \code{\link[ggplot2]{theme}}, \code{\link[ggplot2]{ggsave}}, \code{\link[ggplot2]{aes}}, \code{\link[ggplot2]{geom_text}}, \code{\link[ggplot2]{geom_label}}, \code{\link[ggplot2]{geom_point}}}
36 38
 
39
+  \item{grid}{\code{\link[grid]{arrow}}, \code{\link[grid]{unit}}}
40
+
37 41
   \item{magrittr}{\code{\link[magrittr]{\%>\%}}}
38 42
 
39 43
   \item{tidytree}{\code{\link[tidytree]{groupOTU}}, \code{\link[tidytree]{groupClade}}, \code{\link[tidytree]{nodeid}}, \code{\link[tidytree]{nodelab}}, \code{\link[tidytree]{MRCA}}}