扩展轴限制而不作图(以x单位对齐两个图) [英] Extend axis limits without plotting (in order to align two plots by x-unit)

问题描述

我正在尝试将两个ggplot对象与patchwork结合在一起-两个具有不同数据子集的绘图，但是它们具有相同的x变量(因此也具有相同的单位).我想根据x值对齐图-每个x单位在最终图中应具有相同的物理宽度.

在实际绘制较大数据集的整个宽度时，这非常容易(请参见下图)-但是我很难仅绘制部分数据并保持相同的对齐方式.

 library(ggplot2)
library(patchwork)
library(dplyr)

p1 <- 
ggplot(mtcars, aes(mpg)) + 
  geom_density(trim = TRUE) +
  scale_x_continuous(limits = c(10,35))

p2 <- 
ggplot(filter(mtcars, mpg < 20), aes(mpg)) + 
  geom_histogram(binwidth = 1, boundary = 1) +
  scale_x_continuous(limits = c(10,35)) 

p1/p2
 

^{由 reprex软件包(v0.3.0)}

所需的输出
^{那是photoshop的}

添加coord_cartesian(xlim = c(10,(20 or 35)), clip = 'off')和/或将scale_x限制更改为c(0,(20 or 35))不起作用.

patchwork也不会让我设置两个图的宽度，当它们处于两行时，这在某种意义上是合理的.因此，我可以为第二行创建一个空图并为其设置宽度，但这似乎是很糟糕的事情，我觉得必须有一个更简单的解决方案.
我不限于patchwork，但是任何允许使用它的解决方案都将非常受欢迎.

解决方案

为此，我从cowplot包中修改了align_plots函数，以便其plot_grid函数现在可以支持对每个图的尺寸进行调整. /p>

(我选择Cowplot而不是拼凑的主要原因是，我对后者没有太多的修修补补经验，而像+这样的普通运算符的重载使我有些紧张.)

结果演示

# x / y axis range of p1 / p2 have been changed for illustration purpose
p1 <- ggplot(mtcars, aes(mpg, 1 + stat(count))) + 
  geom_density(trim = TRUE) +
  scale_x_continuous(limits = c(10,35)) +
  coord_cartesian(ylim = c(1, 3.5))

p2 <- ggplot(filter(mtcars, mpg >= 15 & mpg < 30), aes(mpg)) + 
  geom_histogram(binwidth = 1, boundary = 1) 

plot_grid(p1, p2, ncol = 1, align = "v") # plots in 1 column, x-axes aligned
plot_grid(p1, p2, nrow = 1, align = "h") # plots in 1 row, y-axes aligned

1列中的图(x轴对齐15-28范围):

1行中的图(y轴在1-3.5范围内对齐):

注意事项

1. 此hack假设用户打算对齐的图(水平或垂直)具有大小可比的合理相似的轴.我还没有在更极端的情况下对其进行测试.

2. 此黑客希望在笛卡尔坐标中使用简单的无平面图.我不确定对齐多面图会有什么期望.同样，我也没有考虑极坐标(要对齐的内容?)或地图投影(没有研究过，但感觉很复杂).

3. 此黑客希望包含绘图面板的gtable单元格位于gtable对象的第7行/第5列，这是基于我对ggplot对象通常如何转换的理解到gtables，并且可能无法承受对基础代码的更改.

代码

cowplot::align_plots的修改版本:

align_plots_modified <- function (..., plotlist = NULL, align = c("none", "h", "v", "hv"),
                                  axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"), 
                                  greedy = TRUE) {
  plots <- c(list(...), plotlist)
  num_plots <- length(plots)
  grobs <- lapply(plots, function(x) {
    if (!is.null(x)) as_gtable(x)
    else NULL
  })
  halign <- switch(align[1], h = TRUE, vh = TRUE, hv = TRUE, FALSE)
  valign <- switch(align[1], v = TRUE, vh = TRUE, hv = TRUE, FALSE)
  vcomplex_align <- hcomplex_align <- FALSE
  if (valign) {

    # 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)
    }))
    num_widths[num_widths == 0] <- NULL
    if (length(num_widths) > 1 || length(grep("l|r", axis[1])) > 0) {
      vcomplex_align = TRUE
      warning("Method not implemented for faceted plots. Placing unaligned.")
      valign <- FALSE
    }
    else {
      max_widths <- list(do.call(grid::unit.pmax, 
                                 lapply(grobs, function(x) {x$widths})))
    }
  }
  if (halign) {

    # 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)
    }))
    num_heights[num_heights == 0] <- NULL
    if (length(num_heights) > 1 || length(grep("t|b", axis[1])) > 0) {
      hcomplex_align = TRUE
      warning("Method not implemented for faceted plots. Placing unaligned.")
      halign <- FALSE
    }
    else {
      max_heights <- list(do.call(grid::unit.pmax, 
                                  lapply(grobs, function(x) {x$heights})))
    }
  }
  for (i in 1:num_plots) {
    if (!is.null(grobs[[i]])) {
      if (valign) {
        grobs[[i]]$widths <- max_widths[[1]]

        # 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) {
        grobs[[i]]$heights <- max_heights[[1]]

        # 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)
      }
    }
  }
  grobs
}

在Cowplot软件包的plot_grid中使用以上修改的功能:

# To start using (in current R session only; effect will not carry over to subsequent session)
trace(cowplot::plot_grid, edit = TRUE)
# In the pop-up window, change `grobs <- align_plots(...)` (at around line 27) to
# `grobs <- align_plots_modified(...)`

# To stop using
untrace(cowplot::plot_grid)

(或者，我们可以定义使用align_plots_modified而不是cowplot::align_plots的plot_grid函数的修改版本.两种方法的结果都是相同的.)

I am trying to combine two ggplot objects with patchwork - two plots with different subsets of data, but the same x variable (and therefore same unit). I would like to align the plots according to the x values - Each x unit should have the same physical width in the final plot.

This is very easy when actually plotting the entire width of the larger data set (see plot below) - but I struggle to plot only parts of the data and keeping the same alignment.

library(ggplot2)
library(patchwork)
library(dplyr)

p1 <- 
ggplot(mtcars, aes(mpg)) + 
  geom_density(trim = TRUE) +
  scale_x_continuous(limits = c(10,35))

p2 <- 
ggplot(filter(mtcars, mpg < 20), aes(mpg)) + 
  geom_histogram(binwidth = 1, boundary = 1) +
  scale_x_continuous(limits = c(10,35)) 

p1/p2

^{Created on 2019-08-07 by the reprex package (v0.3.0)}

The desired output
^{That's photoshopped}

adding coord_cartesian(xlim = c(10,(20 or 35)), clip = 'off'), and/or changing scale_x limits to c(0,(20 or 35)) doesn't work.

patchwork also won't let me set the widths of both plots when they are in two rows, which makes sense in a way. So I could create an empty plot for the second row and set the widths for those, but this seems a terrible hack and I feel there must be a much easier solution.
I am not restricted to patchwork, but any solution allowing to use it would be very welcome.

解决方案

I modified the align_plots function from the cowplot package for this, so that its plot_grid function can now support adjustments to the dimensions of each plot.

(The main reason I went with cowplot rather than patchwork is that I haven't had much tinkering experience with the latter, and overloading common operators like + makes me slightly nervous.)

Demonstration of results

# x / y axis range of p1 / p2 have been changed for illustration purpose
p1 <- ggplot(mtcars, aes(mpg, 1 + stat(count))) + 
  geom_density(trim = TRUE) +
  scale_x_continuous(limits = c(10,35)) +
  coord_cartesian(ylim = c(1, 3.5))

p2 <- ggplot(filter(mtcars, mpg >= 15 & mpg < 30), aes(mpg)) + 
  geom_histogram(binwidth = 1, boundary = 1) 

plot_grid(p1, p2, ncol = 1, align = "v") # plots in 1 column, x-axes aligned
plot_grid(p1, p2, nrow = 1, align = "h") # plots in 1 row, y-axes aligned

Plots in 1 column (x-axes aligned for 15-28 range):

Plots in 1 row (y-axes aligned for 1 - 3.5 range):

Caveats

1. This hack assumes the plots that the user intends to align (either horizontally or vertically) have reasonably similar axes of comparable magnitude. I haven't tested it on more extreme cases.

2. This hack expects simple non-faceted plots in Cartesian coordinates. I'm not sure what one could expect from aligning faceted plots. Similarly, I'm not considering polar coordinates (what's there to align?) or map projections (haven't looked into this, but they feel rather complicated).

3. This hack expects the gtable cell containing the plot panel to be in the 7th row / 5th column of the gtable object, which is based on my understanding of how ggplot objects are typically converted to gtables, and may not survive changes to the underlying code.

Code

Modified version of cowplot::align_plots:

align_plots_modified <- function (..., plotlist = NULL, align = c("none", "h", "v", "hv"),
                                  axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"), 
                                  greedy = TRUE) {
  plots <- c(list(...), plotlist)
  num_plots <- length(plots)
  grobs <- lapply(plots, function(x) {
    if (!is.null(x)) as_gtable(x)
    else NULL
  })
  halign <- switch(align[1], h = TRUE, vh = TRUE, hv = TRUE, FALSE)
  valign <- switch(align[1], v = TRUE, vh = TRUE, hv = TRUE, FALSE)
  vcomplex_align <- hcomplex_align <- FALSE
  if (valign) {

    # 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)
    }))
    num_widths[num_widths == 0] <- NULL
    if (length(num_widths) > 1 || length(grep("l|r", axis[1])) > 0) {
      vcomplex_align = TRUE
      warning("Method not implemented for faceted plots. Placing unaligned.")
      valign <- FALSE
    }
    else {
      max_widths <- list(do.call(grid::unit.pmax, 
                                 lapply(grobs, function(x) {x$widths})))
    }
  }
  if (halign) {

    # 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)
    }))
    num_heights[num_heights == 0] <- NULL
    if (length(num_heights) > 1 || length(grep("t|b", axis[1])) > 0) {
      hcomplex_align = TRUE
      warning("Method not implemented for faceted plots. Placing unaligned.")
      halign <- FALSE
    }
    else {
      max_heights <- list(do.call(grid::unit.pmax, 
                                  lapply(grobs, function(x) {x$heights})))
    }
  }
  for (i in 1:num_plots) {
    if (!is.null(grobs[[i]])) {
      if (valign) {
        grobs[[i]]$widths <- max_widths[[1]]

        # 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) {
        grobs[[i]]$heights <- max_heights[[1]]

        # 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)
      }
    }
  }
  grobs
}

Utilising the above modified function with cowplot package's plot_grid:

# To start using (in current R session only; effect will not carry over to subsequent session)
trace(cowplot::plot_grid, edit = TRUE)
# In the pop-up window, change `grobs <- align_plots(...)` (at around line 27) to
# `grobs <- align_plots_modified(...)`

# To stop using
untrace(cowplot::plot_grid)

(Alternatively, we can define a modified version of plot_grid function that uses align_plots_modified instead of cowplot::align_plots. Results would be the same either way.)

这篇关于扩展轴限制而不作图(以x单位对齐两个图)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！