| ... | ... |
@@ -9,6 +9,7 @@ S3method(fortify,phylo4) |
| 9 | 9 |
S3method(fortify,phylo4d) |
| 10 | 10 |
S3method(fortify,phyloseq) |
| 11 | 11 |
S3method(fortify,treedata) |
| 12 |
+S3method(ggplot_add,facet_plot) |
|
| 12 | 13 |
S3method(ggplot_add,facet_xlim) |
| 13 | 14 |
S3method(ggplot_add,scale_ggtree) |
| 14 | 15 |
S3method(groupClade,ggtree) |
| ... | ... |
@@ -39,6 +40,7 @@ export(geom_aline) |
| 39 | 40 |
export(geom_balance) |
| 40 | 41 |
export(geom_cladelabel) |
| 41 | 42 |
export(geom_cladelabel2) |
| 43 |
+export(geom_facet) |
|
| 42 | 44 |
export(geom_hilight) |
| 43 | 45 |
export(geom_hilight_encircle) |
| 44 | 46 |
export(geom_label) |
| ... | ... |
@@ -1,5 +1,6 @@ |
| 1 | 1 |
# ggtree 1.17.1 |
| 2 | 2 |
|
| 3 |
++ `geom_facet`, a geom layer version of `facet_plot` (2019-05-23, Thu) |
|
| 3 | 4 |
+ update `scale_x_ggtree`, now we can use `gheatmap() + scale_x_ggtree()` (2019-05-22, Wed) |
| 4 | 5 |
+ extend `xlim_expand` to work with `ggplot2` (2019-05-20, Tue) |
| 5 | 6 |
- <https://yulab-smu.github.io/treedata-book/chapter9.html#xlim_expand> |
| 6 | 7 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,76 @@ |
| 1 |
+##' label facet_plot output |
|
| 2 |
+##' |
|
| 3 |
+##' |
|
| 4 |
+##' @title facet_labeller |
|
| 5 |
+##' @param p facet_plot output |
|
| 6 |
+##' @param label labels of facet panels |
|
| 7 |
+##' @return ggplot object |
|
| 8 |
+##' @importFrom ggplot2 labeller |
|
| 9 |
+##' @export |
|
| 10 |
+##' @author Guangchuang Yu |
|
| 11 |
+facet_labeller <- function(p, label) {
|
|
| 12 |
+ ## .panel <- panel_col_var(p) |
|
| 13 |
+ ## lbs <- panel_col_levels(p) |
|
| 14 |
+ lbs <- levels(p$data$.panel) |
|
| 15 |
+ names(lbs) <- lbs |
|
| 16 |
+ label <- label[names(label) %in% lbs] |
|
| 17 |
+ lbs[names(label)] <- label |
|
| 18 |
+ |
|
| 19 |
+ ## ff <- as.formula(paste(" . ~ ", .panel))
|
|
| 20 |
+ p + facet_grid(. ~ .panel, scales="free_x", |
|
| 21 |
+ labeller = labeller(.panel = lbs)) |
|
| 22 |
+} |
|
| 23 |
+ |
|
| 24 |
+ |
|
| 25 |
+##' set relative widths (for column only) of facet plots |
|
| 26 |
+##' |
|
| 27 |
+##' |
|
| 28 |
+##' @title facet_widths |
|
| 29 |
+##' @param p ggplot or ggtree object |
|
| 30 |
+##' @param widths relative widths of facet panels |
|
| 31 |
+##' @return ggplot object by redrawing the figure (not a modified version of input object) |
|
| 32 |
+##' @author Guangchuang Yu |
|
| 33 |
+##' @export |
|
| 34 |
+##' @importFrom ggplot2 ggplot_gtable |
|
| 35 |
+facet_widths <- function(p, widths) {
|
|
| 36 |
+ if (!is.null(names(widths))) {
|
|
| 37 |
+ ## if (is.ggtree(p) && !is.null(names(widths))) {
|
|
| 38 |
+ ## .panel <- levels(p$data$.panel) |
|
| 39 |
+ .panel <- panel_col_levels(p) |
|
| 40 |
+ w <- rep(1, length=length(.panel)) |
|
| 41 |
+ names(w) <- .panel |
|
| 42 |
+ w[names(widths)] <- widths |
|
| 43 |
+ widths <- w |
|
| 44 |
+ } |
|
| 45 |
+ gt <- ggplot_gtable(ggplot_build(p)) |
|
| 46 |
+ for(i in seq_along(widths)) {
|
|
| 47 |
+ j <- gt$layout$l[grep(paste0('panel-', i), gt$layout$name)]
|
|
| 48 |
+ gt$widths[j] = widths[i] * gt$widths[j] |
|
| 49 |
+ } |
|
| 50 |
+ return(ggplotify::as.ggplot(gt)) |
|
| 51 |
+} |
|
| 52 |
+ |
|
| 53 |
+panel_col_var <- function(p) {
|
|
| 54 |
+ m <- p$facet$params$cols[[1]] |
|
| 55 |
+ if (is.null(m)) |
|
| 56 |
+ return(m) |
|
| 57 |
+ |
|
| 58 |
+ ## rlang::quo_name(m) |
|
| 59 |
+ rlang::quo_text(m) |
|
| 60 |
+} |
|
| 61 |
+ |
|
| 62 |
+panel_col_levels <- function(p) {
|
|
| 63 |
+ levels(p$data[[panel_col_var(p)]]) |
|
| 64 |
+} |
|
| 65 |
+ |
|
| 66 |
+##' @importFrom ggplot2 facet_grid |
|
| 67 |
+add_panel <- function(p, panel) {
|
|
| 68 |
+ df <- p$data |
|
| 69 |
+ if (is.null(df[[".panel"]])) {
|
|
| 70 |
+ df[[".panel"]] <- factor("Tree")
|
|
| 71 |
+ } |
|
| 72 |
+ levels(df$.panel) %<>% c(., panel) |
|
| 73 |
+ p$data <- df |
|
| 74 |
+ p + facet_grid(.~.panel, scales="free_x") |
|
| 75 |
+} |
|
| 76 |
+ |
| ... | ... |
@@ -3,8 +3,9 @@ |
| 3 | 3 |
##' |
| 4 | 4 |
##' 'facet_plot()' automatically re-arranges the input 'data' according to the tree structure, |
| 5 | 5 |
##' visualizes the 'data' on specific 'panel' using the 'geom' function with aesthetic 'mapping' and other parameters, |
| 6 |
-##' and align the graph with the tree 'p' side by side. |
|
| 6 |
+##' and align the graph with the tree 'p' side by side. 'geom_facet' is a 'ggplot2' layer version of 'facet_plot' |
|
| 7 | 7 |
##' @title facet_plot |
| 8 |
+##' @rdname facet-plot |
|
| 8 | 9 |
##' @param p tree view |
| 9 | 10 |
##' @param panel panel name for plot of input data |
| 10 | 11 |
##' @param data data to plot by 'geom', first column should be matched with tip label of tree |
| ... | ... |
@@ -20,85 +21,18 @@ |
| 20 | 21 |
##' @export |
| 21 | 22 |
##' @author Guangchuang Yu |
| 22 | 23 |
facet_plot <- function(p, panel, data, geom, mapping=NULL, ...) {
|
| 23 |
- p <- add_panel(p, panel) |
|
| 24 |
- df <- p %+>% data |
|
| 25 |
- p + geom(data=df, mapping=mapping, ...) |
|
| 24 |
+ p + geom_facet(panel = panel, data = data, |
|
| 25 |
+ geom = geom, 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 |
- |
|
| 41 |
-##' label facet_plot output |
|
| 42 |
-##' |
|
| 43 |
-##' |
|
| 44 |
-##' @title facet_labeller |
|
| 45 |
-##' @param p facet_plot output |
|
| 46 |
-##' @param label labels of facet panels |
|
| 47 |
-##' @return ggplot object |
|
| 48 |
-##' @importFrom ggplot2 labeller |
|
| 49 |
-##' @export |
|
| 50 |
-##' @author Guangchuang Yu |
|
| 51 |
-facet_labeller <- function(p, label) {
|
|
| 52 |
- ## .panel <- panel_col_var(p) |
|
| 53 |
- ## lbs <- panel_col_levels(p) |
|
| 54 |
- lbs <- levels(p$data$.panel) |
|
| 55 |
- names(lbs) <- lbs |
|
| 56 |
- label <- label[names(label) %in% lbs] |
|
| 57 |
- lbs[names(label)] <- label |
|
| 58 |
- |
|
| 59 |
- ## ff <- as.formula(paste(" . ~ ", .panel))
|
|
| 60 |
- p + facet_grid(. ~ .panel, scales="free_x", |
|
| 61 |
- labeller = labeller(.panel = lbs)) |
|
| 62 |
-} |
|
| 63 |
- |
|
| 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 |
|
| 28 |
+##' @rdname facet-plot |
|
| 73 | 29 |
##' @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 |
|
| 84 |
- } |
|
| 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)) |
|
| 30 |
+geom_facet <- function(panel, data, geom, mapping=NULL, ...) {
|
|
| 31 |
+ params <- list(...) |
|
| 32 |
+ structure(list(panel = panel, data = data, |
|
| 33 |
+ geom = geom, mapping = mapping, |
|
| 34 |
+ params = params), class = 'facet_plot') |
|
| 91 | 35 |
} |
| 92 | 36 |
|
| 93 |
-panel_col_var <- function(p) {
|
|
| 94 |
- m <- p$facet$params$cols[[1]] |
|
| 95 |
- if (is.null(m)) |
|
| 96 |
- return(m) |
|
| 97 | 37 |
|
| 98 |
- ## rlang::quo_name(m) |
|
| 99 |
- rlang::quo_text(m) |
|
| 100 |
-} |
|
| 101 | 38 |
|
| 102 |
-panel_col_levels <- function(p) {
|
|
| 103 |
- levels(p$data[[panel_col_var(p)]]) |
|
| 104 |
-} |
| 105 | 39 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,83 @@ |
| 1 |
+##' @importFrom rlang quo_name |
|
| 2 |
+##' @importFrom ggplot2 ggplot_add |
|
| 3 |
+##' @method ggplot_add facet_xlim |
|
| 4 |
+##' @export |
|
| 5 |
+ggplot_add.facet_xlim <- function(object, plot, object_name) {
|
|
| 6 |
+ var <- panel_col_var(plot) |
|
| 7 |
+ free_x <- plot$facet$params$free$x |
|
| 8 |
+ if (!is.null(free_x)) {
|
|
| 9 |
+ if (!free_x) |
|
| 10 |
+ message('If you want to adjust xlim for specific panel, ',
|
|
| 11 |
+ 'you need to set `scales = "free_x"`') |
|
| 12 |
+ } |
|
| 13 |
+ |
|
| 14 |
+ dummy <- data.frame(x = object$x, .panel = object$panel) |
|
| 15 |
+ if (!is.null(var)) {
|
|
| 16 |
+ names(dummy)[2] <- var |
|
| 17 |
+ } |
|
| 18 |
+ |
|
| 19 |
+ obj <- geom_blank(aes_(x = ~x), dummy, inherit.aes = FALSE) |
|
| 20 |
+ ggplot_add(obj, plot, object_name) |
|
| 21 |
+} |
|
| 22 |
+ |
|
| 23 |
+ |
|
| 24 |
+##' @method ggplot_add facet_plot |
|
| 25 |
+##' @export |
|
| 26 |
+ggplot_add.facet_plot <- function(object, plot, object_name) {
|
|
| 27 |
+ plot <- add_panel(plot, object$panel) |
|
| 28 |
+ df <- plot %+>% object$data |
|
| 29 |
+ params <- c(list(data = df, mapping = object$mapping), |
|
| 30 |
+ object$params) |
|
| 31 |
+ obj <- do.call(object$geom, params) |
|
| 32 |
+ ggplot_add(obj, plot, object_name) |
|
| 33 |
+} |
|
| 34 |
+ |
|
| 35 |
+##' @importFrom ggplot2 scale_x_continuous |
|
| 36 |
+##' @importFrom ggplot2 scale_x_date |
|
| 37 |
+##' @method ggplot_add scale_ggtree |
|
| 38 |
+##' @export |
|
| 39 |
+ggplot_add.scale_ggtree <- function(object, plot, object_name) {
|
|
| 40 |
+ mrsd <- get("mrsd", envir = plot$plot_env)
|
|
| 41 |
+ if (!is.null(mrsd) && class(plot$data$x) == "Date") {
|
|
| 42 |
+ x <- Date2decimal(plot$data$x) |
|
| 43 |
+ } else {
|
|
| 44 |
+ x <- plot$data$x |
|
| 45 |
+ } |
|
| 46 |
+ |
|
| 47 |
+ breaks <- object$breaks |
|
| 48 |
+ labels <- object$labels |
|
| 49 |
+ |
|
| 50 |
+ if (length(breaks) == 0) {
|
|
| 51 |
+ breaks <- graphics::hist(x, breaks=5, plot=FALSE)$breaks |
|
| 52 |
+ } |
|
| 53 |
+ m <- attr(plot, "mapping") |
|
| 54 |
+ |
|
| 55 |
+ if (!is.null(mrsd) && class(m$to) == "Date") {
|
|
| 56 |
+ to <- Date2decimal(m$to) |
|
| 57 |
+ } else {
|
|
| 58 |
+ to <- m$to |
|
| 59 |
+ } |
|
| 60 |
+ |
|
| 61 |
+ idx <- which(sapply(breaks, function(x) any(x > m$to))) |
|
| 62 |
+ if (length(idx)) {
|
|
| 63 |
+ breaks <- breaks[-idx] |
|
| 64 |
+ } |
|
| 65 |
+ |
|
| 66 |
+ if (length(labels) == 0) {
|
|
| 67 |
+ labels <- breaks |
|
| 68 |
+ } |
|
| 69 |
+ |
|
| 70 |
+ if (length(breaks) != length(labels)) {
|
|
| 71 |
+ stop("breaks and labels should be in equal length.")
|
|
| 72 |
+ } |
|
| 73 |
+ |
|
| 74 |
+ breaks <- c(breaks, to) |
|
| 75 |
+ labels <- c(labels, gsub("\\.", "", as.character(m$from)))
|
|
| 76 |
+ |
|
| 77 |
+ if (!is.null(mrsd) && class(plot$data$x) == "Date") {
|
|
| 78 |
+ obj <- scale_x_date(breaks=decimal2Date(breaks), labels) |
|
| 79 |
+ } else {
|
|
| 80 |
+ obj <- scale_x_continuous(breaks=breaks, labels=labels) |
|
| 81 |
+ } |
|
| 82 |
+ ggplot_add(obj, plot, object_name) |
|
| 83 |
+} |
| ... | ... |
@@ -13,52 +13,3 @@ scale_x_ggtree <- function(breaks = waiver(), labels = waiver()) {
|
| 13 | 13 |
} |
| 14 | 14 |
|
| 15 | 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 |
-} |
| ... | ... |
@@ -25,27 +25,6 @@ xlim_expand <- function(xlim, panel) {
|
| 25 | 25 |
structure(list(x = xlim, panel = panel), class = "facet_xlim") |
| 26 | 26 |
} |
| 27 | 27 |
|
| 28 |
-##' @importFrom rlang quo_name |
|
| 29 |
-##' @importFrom ggplot2 ggplot_add |
|
| 30 |
-##' @method ggplot_add facet_xlim |
|
| 31 |
-##' @export |
|
| 32 |
-ggplot_add.facet_xlim <- function(object, plot, object_name) {
|
|
| 33 |
- var <- panel_col_var(plot) |
|
| 34 |
- free_x <- plot$facet$params$free$x |
|
| 35 |
- if (!is.null(free_x)) {
|
|
| 36 |
- if (!free_x) |
|
| 37 |
- message('If you want to adjust xlim for specific panel, ',
|
|
| 38 |
- 'you need to set `scales = "free_x"`') |
|
| 39 |
- } |
|
| 40 |
- |
|
| 41 |
- dummy <- data.frame(x = object$x, .panel = object$panel) |
|
| 42 |
- if (!is.null(var)) {
|
|
| 43 |
- names(dummy)[2] <- var |
|
| 44 |
- } |
|
| 45 |
- |
|
| 46 |
- obj <- geom_blank(aes_(x = ~x), dummy, inherit.aes = FALSE) |
|
| 47 |
- ggplot_add(obj, plot, object_name) |
|
| 48 |
-} |
|
| 49 | 28 |
|
| 50 | 29 |
##' reverse timescle x-axis |
| 51 | 30 |
##' |
| 52 | 31 |
similarity index 84% |
| 53 | 32 |
rename from man/facet_plot.Rd |
| 54 | 33 |
rename to man/facet-plot.Rd |
| ... | ... |
@@ -2,9 +2,12 @@ |
| 2 | 2 |
% Please edit documentation in R/facet_plot.R |
| 3 | 3 |
\name{facet_plot}
|
| 4 | 4 |
\alias{facet_plot}
|
| 5 |
+\alias{geom_facet}
|
|
| 5 | 6 |
\title{facet_plot}
|
| 6 | 7 |
\usage{
|
| 7 | 8 |
facet_plot(p, panel, data, geom, mapping = NULL, ...) |
| 9 |
+ |
|
| 10 |
+geom_facet(panel, data, geom, mapping = NULL, ...) |
|
| 8 | 11 |
} |
| 9 | 12 |
\arguments{
|
| 10 | 13 |
\item{p}{tree view}
|
| ... | ... |
@@ -28,7 +31,7 @@ plot tree associated data in an additional panel |
| 28 | 31 |
\details{
|
| 29 | 32 |
'facet_plot()' automatically re-arranges the input 'data' according to the tree structure, |
| 30 | 33 |
visualizes the 'data' on specific 'panel' using the 'geom' function with aesthetic 'mapping' and other parameters, |
| 31 |
-and align the graph with the tree 'p' side by side. |
|
| 34 |
+and align the graph with the tree 'p' side by side. 'geom_facet' is a 'ggplot2' layer version of 'facet_plot' |
|
| 32 | 35 |
} |
| 33 | 36 |
\examples{
|
| 34 | 37 |
tr <- rtree(10) |
