扩展轴限制而不作图（以x单位对齐两个图）

Question

我正在尝试将两个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）创建于2019-08-07}

所需的输出
^{这是Photoshop处理}

添加coord_cartesian(xlim = c(10,(20 or 35)), clip = 'off')和/或更改scale_x限制c(0,(20 or 35))无效。

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

Answer 1

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

（我选择 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. 这个 hack 期望在笛卡尔坐标中绘制简单的非分面图。我不确定对齐多面图会带来什么。同样，我没有考虑极坐标（有什么要对齐的？）或地图投影（没有研究过这个，但它们感觉相当复杂）。

3. 此 hack 期望包含绘图面板的 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)

（或者，我们可以定义plot_grid使用align_plots_modified而不是 的修改版本的函数cowplot::align_plots。无论哪种方式，结果都是相同的。）

Answer 2

这是一个grid.arrange不使用空白图的选项，但需要手动进行以下调整：

• 地块余量
• x轴扩展
• y轴标签中的小数位数

library(ggplot2)
library(dplyr)
library(gridExtra)

p1 <- 
  ggplot(mtcars, aes(mpg)) + 
  geom_density(trim = TRUE) +
  scale_x_continuous(limits = c(10,35), breaks=seq(10,35,5), expand = expand_scale(add=c(0,0))) 

p2 <- 
  ggplot(filter(mtcars, mpg < 20), aes(mpg)) + 
  geom_histogram(binwidth = 1, boundary = 1) +
  scale_x_continuous(limits = c(10,20), breaks=seq(10,20,5), expand = expand_scale(add=c(0,0))) +
  scale_y_continuous(labels = scales::number_format(accuracy = 0.01)) +
  theme(plot.margin = unit(c(0,1,0,0), "cm"))

grid.arrange(p1, p2,
  layout_matrix = rbind(c(1, 1), c(2, NA))
)

应该做这个图：