Browse code

facet_widths

Guangchuang Yu authored on 27/01/2019 16:59:37
Showing 5 changed files

... ...
@@ -2,7 +2,7 @@ Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with
4 4
     their covariates and other associated data
5
-Version: 1.15.5
5
+Version: 1.15.6
6 6
 Authors@R: c(
7 7
 	   person("Guangchuang", "Yu",     email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6485-8781")),
8 8
 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com",   role = c("aut", "ths")),
... ...
@@ -36,6 +36,7 @@ Imports:
36 36
 Suggests:
37 37
     emojifont,
38 38
     ggimage,
39
+    ggplotify,
39 40
     knitr,
40 41
     prettydoc,
41 42
     rmarkdown,
... ...
@@ -30,6 +30,7 @@ export(decimal2Date)
30 30
 export(expand)
31 31
 export(facet_labeller)
32 32
 export(facet_plot)
33
+export(facet_widths)
33 34
 export(flip)
34 35
 export(fortify)
35 36
 export(geom_aline)
... ...
@@ -166,6 +167,7 @@ importFrom(ggplot2,geom_tile)
166 167
 importFrom(ggplot2,ggplot)
167 168
 importFrom(ggplot2,ggplotGrob)
168 169
 importFrom(ggplot2,ggplot_build)
170
+importFrom(ggplot2,ggplot_gtable)
169 171
 importFrom(ggplot2,ggproto)
170 172
 importFrom(ggplot2,ggsave)
171 173
 importFrom(ggplot2,guide_legend)
... ...
@@ -1,3 +1,8 @@
1
+# ggtree 1.15.6
2
+
3
++ `facet_widths` function to set relative widths of facet panels (2019-01-28, Mon)
4
+  - the output is `ggplotify::as.ggplot(grid_object)`, so it is not the original `ggtree` object.
5
+
1 6
 # ggtree 1.15.5
2 7
 
3 8
 + bug fixed of `theme_tree2` (2019-01-14, Mon)
... ...
@@ -25,6 +25,19 @@ facet_plot <- function(p, panel, data, geom, mapping=NULL, ...) {
25 25
     p + geom(data=df, mapping=mapping, ...)
26 26
 }
27 27
 
28
+
29
+##' @importFrom ggplot2 facet_grid
30
+add_panel <- function(p, panel) {
31
+    df <- p$data
32
+    if (is.null(df[[".panel"]])) {
33
+        df[[".panel"]] <- factor("Tree")
34
+    }
35
+    levels(df$.panel) %<>% c(., panel)
36
+    p$data <- df
37
+    p + facet_grid(.~.panel, scales="free_x")
38
+}
39
+
40
+
28 41
 ##' label facet_plot output
29 42
 ##'
30 43
 ##' 
... ...
@@ -36,23 +49,52 @@ facet_plot <- function(p, panel, data, geom, mapping=NULL, ...) {
36 49
 ##' @export
37 50
 ##' @author Guangchuang Yu
38 51
 facet_labeller <- function(p, label) {
52
+    ## .panel <- panel_col_var(p)
53
+    ## lbs <- panel_col_levels(p)
39 54
     lbs  <-  levels(p$data$.panel)
40 55
     names(lbs)  <-  lbs
41 56
     label <- label[names(label) %in% lbs]
42 57
     lbs[names(label)]  <-  label
43 58
 
44
-    p + facet_grid( . ~ .panel, scales="free_x",
45
-               labeller = labeller(.panel = lbs))
59
+    ## ff <- as.formula(paste(" . ~ ", .panel))
60
+    p + facet_grid(. ~ .panel, scales="free_x",
61
+                   labeller = labeller(.panel = lbs))
46 62
 }
47 63
 
48
-##' @importFrom ggplot2 facet_grid
49
-add_panel <- function(p, panel) {
50
-    df <- p$data
51
-    if (is.null(df[[".panel"]])) {
52
-        df[[".panel"]] <- factor("Tree")
64
+
65
+##' set relative widths (for column only) of facet plots
66
+##'
67
+##' 
68
+##' @title facet_widths
69
+##' @param p ggplot or ggtree object
70
+##' @param widths relative widths of facet panels
71
+##' @return ggplot object by redrawing the figure (not a modified version of input object)
72
+##' @author Guangchuang Yu
73
+##' @export
74
+##' @importFrom ggplot2 ggplot_gtable
75
+facet_widths <- function(p, widths) {
76
+    if (!is.null(names(widths))) {
77
+        ## if (is.ggtree(p) && !is.null(names(widths))) {
78
+        ## .panel <- levels(p$data$.panel)
79
+        .panel <- panel_col_levels(p)
80
+        w <- rep(1, length=length(.panel))
81
+        names(w) <- .panel
82
+        w[names(widths)] <- widths
83
+        widths <- w
53 84
     }
54
-    levels(df$.panel) %<>% c(., panel)
55
-    p$data <- df
56
-    p + facet_grid(.~.panel, scales="free_x")
85
+    gt  <- ggplot_gtable(ggplot_build(p))
86
+    for(i in seq_along(widths)) {
87
+        j <- gt$layout$l[grep(paste0('panel-', i), gt$layout$name)]
88
+        gt$widths[j] = widths[i] * gt$widths[j]
89
+    }
90
+    return(ggplotify::as.ggplot(gt))
57 91
 }
58 92
 
93
+panel_col_var <- function(p) {
94
+    m <- p$facet$params$cols[[1]]
95
+    rlang::quo_text(m)
96
+}
97
+
98
+panel_col_levels <- function(p) {
99
+    levels(p$data[[panel_col_var(p)]])
100
+}
59 101
new file mode 100644
... ...
@@ -0,0 +1,22 @@
1
+% Generated by roxygen2: do not edit by hand
2
+% Please edit documentation in R/facet_plot.R
3
+\name{facet_widths}
4
+\alias{facet_widths}
5
+\title{facet_widths}
6
+\usage{
7
+facet_widths(p, widths)
8
+}
9
+\arguments{
10
+\item{p}{ggplot or ggtree object}
11
+
12
+\item{widths}{relative widths of facet panels}
13
+}
14
+\value{
15
+ggplot object by redrawing the figure (not a modified version of input object)
16
+}
17
+\description{
18
+set relative widths (for column only) of facet plots
19
+}
20
+\author{
21
+Guangchuang Yu
22
+}