Browse code

update scale_x_ggtree

Guangchuang Yu authored on 22/05/2019 14:09:37
Showing 6 changed files

... ...
@@ -10,6 +10,7 @@ S3method(fortify,phylo4d)
10 10
 S3method(fortify,phyloseq)
11 11
 S3method(fortify,treedata)
12 12
 S3method(ggplot_add,facet_xlim)
13
+S3method(ggplot_add,scale_ggtree)
13 14
 S3method(groupClade,ggtree)
14 15
 S3method(groupOTU,ggtree)
15 16
 S3method(identify,gg)
... ...
@@ -186,6 +187,7 @@ importFrom(ggplot2,scale_x_reverse)
186 187
 importFrom(ggplot2,scale_y_continuous)
187 188
 importFrom(ggplot2,theme)
188 189
 importFrom(ggplot2,theme_bw)
190
+importFrom(ggplot2,waiver)
189 191
 importFrom(ggplot2,xlab)
190 192
 importFrom(ggplot2,xlim)
191 193
 importFrom(ggplot2,ylab)
... ...
@@ -1,5 +1,6 @@
1 1
 # ggtree 1.17.1
2 2
 
3
++ update `scale_x_ggtree`, now we can use `gheatmap() + scale_x_ggtree()` (2019-05-22, Wed)
3 4
 + extend `xlim_expand` to work with `ggplot2` (2019-05-20, Tue)
4 5
   - <https://yulab-smu.github.io/treedata-book/chapter9.html#xlim_expand>
5 6
 + add `legend_title` variable in `gheatmap` (2019-05-16, Thu)
... ...
@@ -84,58 +84,6 @@ get_heatmap_column_position <- function(treeview, by="bottom") {
84 84
     return(mapping)
85 85
 }
86 86
 
87
-##' scale x for tree with heatmap
88
-##'
89
-##'
90
-##' @title scale_x_ggtree
91
-##' @param tree_view tree view
92
-##' @param breaks breaks for tree
93
-##' @param labels lables for corresponding breaks
94
-##' @return tree view
95
-##' @importFrom ggplot2 scale_x_continuous
96
-##' @importFrom ggplot2 scale_x_date
97
-##' @export
98
-##' @author Guangchuang Yu
99
-scale_x_ggtree <- function(tree_view, breaks=NULL, labels=NULL) {
100
-    p <- get_tree_view(tree_view)
101
-
102
-    mrsd <- get("mrsd", envir=tree_view$plot_env)
103
-    if (!is.null(mrsd) && class(p$data$x) == "Date") {
104
-        x <- Date2decimal(p$data$x)
105
-    } else {
106
-        x <- p$data$x
107
-    }
108
-
109
-    if (is.null(breaks)) {
110
-        breaks <- graphics::hist(x, breaks=5, plot=FALSE)$breaks
111
-    }
112
-    m <- attr(p, "mapping")
113
-
114
-    if (!is.null(mrsd) &&class(m$to) == "Date") {
115
-        to <- Date2decimal(m$to)
116
-    } else {
117
-        to <- m$to
118
-    }
119
-
120
-    idx <- which(sapply(breaks, function(x) any(x > m$to)))
121
-    if (length(idx)) {
122
-        breaks <- breaks[-idx]
123
-    }
124
-
125
-    if (is.null(labels)) {
126
-        labels <- breaks
127
-    }
128
-
129
-    breaks <- c(breaks, to)
130
-    labels <- c(labels, gsub("\\.", "", as.character(m$from)))
131
-
132
-    if (!is.null(mrsd) && class(p$data$x) == "Date") {
133
-        p <- p + scale_x_date(breaks=decimal2Date(breaks), labels)
134
-    } else {
135
-        p <- p + scale_x_continuous(breaks=breaks, labels=labels)
136
-    }
137
-    return(p)
138
-}
139 87
 
140 88
 
141 89
 
142 90
new file mode 100644
... ...
@@ -0,0 +1,64 @@
1
+##' scale x for tree with gheatmap
2
+##'
3
+##'
4
+##' @title scale_x_ggtree
5
+##' @param breaks breaks for tree
6
+##' @param labels lables for corresponding breaks
7
+##' @return updated tree view
8
+##' @importFrom ggplot2 waiver
9
+##' @export
10
+##' @author Guangchuang Yu
11
+scale_x_ggtree <- function(breaks = waiver(), labels = waiver()) {
12
+    structure(list(breaks = breaks, labels = labels), class="scale_ggtree")
13
+}
14
+
15
+
16
+##' @importFrom ggplot2 scale_x_continuous
17
+##' @importFrom ggplot2 scale_x_date
18
+##' @method ggplot_add scale_ggtree
19
+##' @export
20
+ggplot_add.scale_ggtree <- function(object, plot, object_name) {
21
+    mrsd <- get("mrsd", envir = plot$plot_env)
22
+    if (!is.null(mrsd) && class(plot$data$x) == "Date") {
23
+        x <- Date2decimal(plot$data$x)
24
+    } else {
25
+        x <- plot$data$x
26
+    }
27
+
28
+    breaks <- object$breaks
29
+    labels <- object$labels
30
+
31
+    if (length(breaks) == 0) {
32
+        breaks <- graphics::hist(x, breaks=5, plot=FALSE)$breaks
33
+    }
34
+    m <- attr(plot, "mapping")
35
+
36
+    if (!is.null(mrsd) && class(m$to) == "Date") {
37
+        to <- Date2decimal(m$to)
38
+    } else {
39
+        to <- m$to
40
+    }
41
+    
42
+    idx <- which(sapply(breaks, function(x) any(x > m$to)))
43
+    if (length(idx)) {
44
+        breaks <- breaks[-idx]
45
+    }
46
+
47
+    if (length(labels) == 0) {
48
+        labels <- breaks
49
+    }
50
+
51
+    if (length(breaks) != length(labels)) {
52
+        stop("breaks and labels should be in equal length.")
53
+    }
54
+
55
+    breaks <- c(breaks, to)
56
+    labels <- c(labels, gsub("\\.", "", as.character(m$from)))
57
+
58
+    if (!is.null(mrsd) && class(plot$data$x) == "Date") {
59
+        obj <- scale_x_date(breaks=decimal2Date(breaks), labels)
60
+    } else {
61
+        obj <- scale_x_continuous(breaks=breaks, labels=labels)
62
+    }
63
+    ggplot_add(obj, plot, object_name)
64
+}
... ...
@@ -34,15 +34,23 @@ xlim_expand <- function(xlim, panel) {
34 34
 ##' @method ggplot_add facet_xlim
35 35
 ##' @export
36 36
 ggplot_add.facet_xlim <- function(object, plot, object_name) {
37
-    var <- quo_name(plot$facet$params$cols[[1]])
37
+    facet_col <- plot$facet$params$cols
38
+    var <- quo_name(facet_col[[1]])
39
+
38 40
     free_x <- plot$facet$params$free$x
39
-    if (!is.null(free_x) && !free_x) {
40
-        message('If you want to adjust xlim for specific panel, you need to set `scales = "free_x"`')
41
+    if (!is.null(free_x)) {
42
+        if (!free_x)
43
+            message('If you want to adjust xlim for specific panel, you need to set `scales = "free_x"`')
41 44
     }
45
+
42 46
     class(object) %<>% extract(., .!= "facet_xlim")
43
-    nm <- names(object$data)
44
-    nm[nm == '.panel']  <- var
45
-    names(object$data)  <- nm
47
+
48
+    if (!is.null(facet_col)) {
49
+        nm <- names(object$data)
50
+        nm[nm == '.panel']  <- var
51
+        names(object$data)  <- nm
52
+    }
53
+
46 54
     ggplot_add(object, plot, object_name)
47 55
 }
48 56
 
... ...
@@ -1,23 +1,21 @@
1 1
 % Generated by roxygen2: do not edit by hand
2
-% Please edit documentation in R/experimental_function.R
2
+% Please edit documentation in R/scales.R
3 3
 \name{scale_x_ggtree}
4 4
 \alias{scale_x_ggtree}
5 5
 \title{scale_x_ggtree}
6 6
 \usage{
7
-scale_x_ggtree(tree_view, breaks = NULL, labels = NULL)
7
+scale_x_ggtree(breaks = waiver(), labels = waiver())
8 8
 }
9 9
 \arguments{
10
-\item{tree_view}{tree view}
11
-
12 10
 \item{breaks}{breaks for tree}
13 11
 
14 12
 \item{labels}{lables for corresponding breaks}
15 13
 }
16 14
 \value{
17
-tree view
15
+updated tree view
18 16
 }
19 17
 \description{
20
-scale x for tree with heatmap
18
+scale x for tree with gheatmap
21 19
 }
22 20
 \author{
23 21
 Guangchuang Yu