diff --git a/DESCRIPTION b/DESCRIPTION index e5df44a..0759f02 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cowplot Title: Streamlined Plot Theme and Plot Annotations for 'ggplot2' -Version: 1.1.2 +Version: 1.1.2.9001 Authors@R: person( given = "Claus O.", @@ -72,6 +72,6 @@ Collate: 'stamp.R' 'themes.R' 'utils_ggplot2.R' -RoxygenNote: 7.1.1 +RoxygenNote: 7.2.3 Roxygen: list(markdown = TRUE) Encoding: UTF-8 diff --git a/R/align_plots.R b/R/align_plots.R index d53cd2c..e203221 100644 --- a/R/align_plots.R +++ b/R/align_plots.R @@ -160,6 +160,8 @@ align_margin <- function(sizes, margin_to_align, greedy = TRUE) { #' @param greedy (optional) Defines the alignment policy when alignment axes are specified via the #' `axis` option. `greedy = TRUE` tries to always align by adjusting the outmost margin. `greedy = FALSE` #' aligns all columns/rows in the gtable if possible. +#' @param align_axis (optional) If set to TRUE, the axis are aligned and adjusted by their values. +#' #' @examples #' library(ggplot2) #' @@ -179,15 +181,14 @@ align_margin <- function(sizes, margin_to_align, greedy = TRUE) { #' @export align_plots <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"), - greedy = TRUE){ - # browser() + greedy = TRUE, align_axis = FALSE) { plots <- c(list(...), plotlist) num_plots <- length(plots) # convert list of plots into list of grobs / gtables grobs <- lapply(plots, function(x) {if (!is.null(x)) as_gtable(x) else NULL}) - #aligning graphs. + # aligning graphs. halign <- switch( align[1], h = TRUE, @@ -207,13 +208,31 @@ align_plots <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), # calculate the maximum widths and heights over all graphs, and find out whether # they can be aligned if necessary if (valign) { + + if (align_axis) { + # modification: get x-axis value range associated with each plot, create union of + # value ranges across all plots, & calculate the proportional width of each plot + # (with white space on either side) required in order for the plots to align + plot_x_range <- lapply(plots, function(x) { + ggplot_build(x)$layout$panel_params[[1]]$x.range + }) + full_range <- range(plot_x_range) + plot_x_range <- lapply(plot_x_range, function(x) { + c( + diff(c(full_range[1], x[1])) / diff(full_range), + diff(x) / diff(full_range), + diff(c(x[2], full_range[2])) / diff(full_range) + ) + }) + } + num_widths <- unique(lapply(grobs, function(x) {length(x$widths)})) # count number of unique lengths num_widths[num_widths == 0] <- NULL # remove entry for missing graphs if (length(num_widths) > 1 || length(grep("l|r", axis[1])) > 0) { # Complex aligns are ones that don't have the same number of elements that have sizes # or for which explicit axis alignment is requested vcomplex_align = TRUE - if(axis[1] == "none") { + if (axis[1] == "none") { warning( "Graphs cannot be vertically aligned unless the axis parameter is set. Placing graphs unaligned.", call. = FALSE @@ -231,18 +250,36 @@ align_plots <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), max_widths <- align_margin(max_widths, "last", greedy = greedy) } } else { - max_widths <- list(do.call(grid::unit.pmax, lapply(grobs, function(x){x$widths}))) + max_widths <- list(do.call(grid::unit.pmax, lapply(grobs, function(x) {x$widths}))) } } if (halign) { + + if (align_axis) { + # modification: get y-axis value range associated with each plot, create union of + # value ranges across all plots, & calculate the proportional width of each plot + # (with white space on either side) required in order for the plots to align + plot_y_range <- lapply(plots, function(x) { + ggplot_build(x)$layout$panel_params[[1]]$y.range + }) + full_range <- range(plot_y_range) + plot_y_range <- lapply(plot_y_range, function(x) { + c( + diff(c(full_range[1], x[1])) / diff(full_range), + diff(x) / diff(full_range), + diff(c(x[2], full_range[2])) / diff(full_range) + ) + }) + } + num_heights <- unique(lapply(grobs, function(x) {length(x$heights)})) # count number of unique lengths num_heights[num_heights == 0] <- NULL # remove entry for missing graphs if (length(num_heights) > 1 || length(grep("t|b", axis[1])) > 0) { # Complex aligns are ones that don't have the same number of elements that have sizes # or for which explicit axis alignment is requested hcomplex_align = TRUE - if (axis[1] == "none"){ + if (axis[1] == "none") { warning( "Graphs cannot be horizontally aligned unless the axis parameter is set. Placing graphs unaligned.", call. = FALSE @@ -260,7 +297,7 @@ align_plots <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), } } else { - max_heights <- list(do.call(grid::unit.pmax, lapply(grobs, function(x){x$heights}))) + max_heights <- list(do.call(grid::unit.pmax, lapply(grobs, function(x) {x$heights}))) } } @@ -268,18 +305,48 @@ align_plots <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), for (i in 1:num_plots) { if (!is.null(grobs[[i]])) { if (valign) { - if(vcomplex_align) { + if (vcomplex_align) { grobs[[i]]$widths <- max_widths[[i]] } else{ grobs[[i]]$widths <- max_widths[[1]] } + if (align_axis) { + # modification: change panel cell's width to a proportion of unit(1, "null"), + # then add whitespace to the left / right of the plot's existing gtable + grobs[[i]]$widths[[5]] <- unit(plot_x_range[[i]][2], "null") + grobs[[i]] <- gtable::gtable_add_cols( + grobs[[i]], + widths = unit(plot_x_range[[i]][1], "null"), + pos = 0 + ) + grobs[[i]] <- gtable::gtable_add_cols( + grobs[[i]], + widths = unit(plot_x_range[[i]][3], "null"), + pos = -1 + ) + } } if (halign) { - if(hcomplex_align){ + if (hcomplex_align) { grobs[[i]]$heights <- max_heights[[i]] } else{ grobs[[i]]$heights <- max_heights[[1]] } + if (align_axis) { + # modification: change panel cell's height to a proportion of unit(1, "null"), + # then add whitespace to the bottom / top of the plot's existing gtable + grobs[[i]]$heights[[7]] <- unit(plot_y_range[[i]][2], "null") + grobs[[i]] <- gtable::gtable_add_rows( + grobs[[i]], + heights = unit(plot_y_range[[i]][1], "null"), + pos = -1 + ) + grobs[[i]] <- gtable::gtable_add_rows( + grobs[[i]], + heights = unit(plot_y_range[[i]][3], "null"), + pos = 0 + ) + } } } } diff --git a/R/plot_grid.R b/R/plot_grid.R index 2501762..e9d0b18 100644 --- a/R/plot_grid.R +++ b/R/plot_grid.R @@ -40,6 +40,8 @@ #' @param byrow Logical value indicating if the plots should be arrange by row (default) or by column. #' @param rows Deprecated. Use \code{nrow}. #' @param cols Deprecated. Use \code{ncol}. +#' @param align_axis (optional) If set to TRUE, the axis are aligned and adjusted by their values. +#' #' @examples #' library(ggplot2) #' @@ -86,6 +88,20 @@ #' align = "h", axis = "b", nrow = 1, rel_widths = c(1, 2) #' ) #' +#' # aligning two plots by their x axis values +#' p1 <- ggplot(mtcars, aes(x = disp, y = mpg)) + +#' geom_point() +#' p2 <- ggplot(mtcars[mtcars$disp > 300, ], aes(x = disp, y = mpg)) + +#' geom_point() +#' +#' plot_grid(p1, p2, ncol = 1, align = "v", align_axis = TRUE) +#' +#' # align horizontally +#' p3 <- ggplot(mtcars[mtcars$mpg > 20, ], aes(x = disp, y = mpg)) + +#' geom_point() +#' +#' plot_grid(p1, p3, nrow = 1, align = "h", align_axis = TRUE) +#' #' # more examples #' \donttest{ #' #' # missing plots in some grid locations, auto-generate lower-case labels @@ -139,7 +155,7 @@ plot_grid <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), label_fontfamily = NULL, label_fontface = "bold", label_colour = NULL, label_x = 0, label_y = 1, hjust = -0.5, vjust = 1.5, scale = 1., greedy = TRUE, - byrow = TRUE, cols = NULL, rows = NULL) { + byrow = TRUE, cols = NULL, rows = NULL, align_axis = FALSE) { # Make a list from the ... arguments and plotlist plots <- c(list(...), plotlist) @@ -181,7 +197,8 @@ plot_grid <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"), if (!isTRUE(byrow)) plots <- plots[c(t(matrix(c(1:num_plots, rep(NA, (rows * cols) - num_plots)), nrow = rows, byrow = FALSE)))] # Align the plots (if specified) - grobs <- align_plots(plotlist = plots, align = align, axis = axis, greedy = greedy) + grobs <- align_plots(plotlist = plots, align = align, axis = axis, + greedy = greedy, align_axis = align_axis) if ("AUTO" %in% labels) labels <- LETTERS[1:num_plots] diff --git a/man/align_plots.Rd b/man/align_plots.Rd index 095c6d2..aa81523 100644 --- a/man/align_plots.Rd +++ b/man/align_plots.Rd @@ -9,7 +9,8 @@ align_plots( plotlist = NULL, align = c("none", "h", "v", "hv"), axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"), - greedy = TRUE + greedy = TRUE, + align_axis = FALSE ) } \arguments{ @@ -28,6 +29,8 @@ margins. Options are \code{axis="none"} (default), or a string of any combinatio \item{greedy}{(optional) Defines the alignment policy when alignment axes are specified via the \code{axis} option. \code{greedy = TRUE} tries to always align by adjusting the outmost margin. \code{greedy = FALSE} aligns all columns/rows in the gtable if possible.} + +\item{align_axis}{(optional) If set to TRUE, the axis are aligned and adjusted by their values.} } \description{ Align the plot area of multiple plots. Inputs are a list of plots plus alignment parameters. diff --git a/man/plot_grid.Rd b/man/plot_grid.Rd index cc2c5c9..0aa4e1d 100644 --- a/man/plot_grid.Rd +++ b/man/plot_grid.Rd @@ -26,7 +26,8 @@ plot_grid( greedy = TRUE, byrow = TRUE, cols = NULL, - rows = NULL + rows = NULL, + align_axis = FALSE ) } \arguments{ @@ -90,6 +91,8 @@ sometimes be more powerful.} \item{cols}{Deprecated. Use \code{ncol}.} \item{rows}{Deprecated. Use \code{nrow}.} + +\item{align_axis}{(optional) If set to TRUE, the axis are aligned and adjusted by their values.} } \description{ Arrange multiple plots into a grid. @@ -140,6 +143,20 @@ plot_grid( align = "h", axis = "b", nrow = 1, rel_widths = c(1, 2) ) +# aligning two plots by their x axis values +p1 <- ggplot(mtcars, aes(x = disp, y = mpg)) + + geom_point() +p2 <- ggplot(mtcars[mtcars$disp > 300, ], aes(x = disp, y = mpg)) + + geom_point() + +plot_grid(p1, p2, ncol = 1, align = "v", align_axis = TRUE) + +# align horizontally +p3 <- ggplot(mtcars[mtcars$mpg > 20, ], aes(x = disp, y = mpg)) + + geom_point() + +plot_grid(p1, p3, nrow = 1, align = "h", align_axis = TRUE) + # more examples \donttest{ #' # missing plots in some grid locations, auto-generate lower-case labels diff --git a/tests/testthat/test_align_plots.R b/tests/testthat/test_align_plots.R index a4aab65..4e1c678 100644 --- a/tests/testthat/test_align_plots.R +++ b/tests/testthat/test_align_plots.R @@ -141,3 +141,26 @@ test_that("complex alignments with non-plots", { dev.off() }) + + +test_that("align by axis", { + p1 <- ggplot(mtcars, aes(x = disp, y = mpg)) + + geom_point() + p2 <- ggplot(mtcars[mtcars$disp > 300, ], aes(x = disp, y = mpg)) + + geom_point() + p3 <- ggplot(mtcars[mtcars$mpg > 20, ], aes(x = disp, y = mpg)) + + geom_point() + + plots <- align_plots(p1, p2, align = "v", align_axis = TRUE) + # vertical alignment -> same height + expect_equal(capture.output(plots[[1]]$heights), + capture.output(plots[[2]]$heights)) + # note there is a string difference in some subpart of plot$heights, + # not sure why or how to access it; + # comparing what is printed in units is probably better than nothing... + + plots <- align_plots(p1, p3, align = "v", align_axis = TRUE) + # horizontal alignment -> same width + expect_equal(capture.output(plots[[1]]$widths), + capture.output(plots[[2]]$widths)) +}) diff --git a/tests/testthat/test_plot_grid.R b/tests/testthat/test_plot_grid.R index 18d5546..5196322 100644 --- a/tests/testthat/test_plot_grid.R +++ b/tests/testthat/test_plot_grid.R @@ -98,3 +98,22 @@ test_that("alignment", { plot_grid(p1, p2, ncol = 1, align = 'v', axis = "rl") + theme_map() ) }) + + +test_that("align by axis", { + p1 <- ggplot(mtcars, aes(x = disp, y = mpg)) + + geom_point() + p2 <- ggplot(mtcars[mtcars$disp > 300, ], aes(x = disp, y = mpg)) + + geom_point() + + expect_doppelganger("aligning by x-axis values", + plot_grid(p1, p2, ncol = 1, align = "v", align_axis = TRUE) + ) + + p3 <- ggplot(mtcars[mtcars$mpg > 20, ], aes(x = disp, y = mpg)) + + geom_point() + + expect_doppelganger("aligning by y-axis values", + plot_grid(p1, p3, nrow = 1, align = "h", align_axis = TRUE) + ) +})