在 gtable_matrix 中跨多个 ggplot 图形绘制一条线

Question

我正在尝试在 gtable_matrix 中的两个 ggplot 直方图上画一条线，以便一个直方图中的值的平均值覆盖在两个图中。

但是，我无法获取绘图区域的设备坐标。在基本图形中，我会使用 grconvertX()，但是在哪里可以找到 ggplot 绘图区域的设备坐标，以便我可以将“用户”比例 (0-10) 上的数字转换为设备坐标？

在下面的示例中，我仔细地找到了要插入的数字以使线位于正确的位置，但是一旦重新缩放绘图，或者轴标签发生变化，或者任何其他绘图元素发生变化，它就会中断向下。可能也无法在您的机器上按预期工作。

library(ggplot2)
library(grid)
library(gtable)

n_1 = 10
n_2 = 10
mean_1 = 5.5
sd_1 = 1
mean_2 = 7
sd_2 = 1
data = data.frame(y = c(
  rnorm(n_1, mean_1, sd_1),
  rnorm(n_2, mean_2, sd_2)
),
group = c(rep("1", n_1), rep("2", n_2)))
data$y[data$y > 10] <- 10
data$y[data$y < 0] <- 0

plots <- lapply(c("1", "2"), function(x) {
  ggplotGrob(
    ggplot(data[data$group == x,], aes(y)) +
      geom_histogram(
        breaks = seq(0, 10, length.out = 12),
        fill = ifelse(x == "1", "blue", "red"),
        colour = "black",
        alpha = .2
      ) +
      theme_classic() +
      theme(axis.title.x = element_blank()) +
      ylab(x) +
      scale_x_continuous(expand = c(0, 0), limits = c(0, 10)) +
      scale_y_continuous(expand = c(0, 0), limits = c(0, 4))
  )

})

gt <- gtable_matrix(
  "histograms",
  matrix(plots, nrow = 2, byrow = TRUE),
  widths = unit(1, "null"),
  heights = unit(c(1, 1), "null")
)

left <- textGrob("Frequency", rot = 90, just = c(.5, .5))
gt <-
  gtable_add_cols(gt, widths = grobWidth(left) + unit(0.5, "line"), 0)
gt <- gtable_add_grob(
  gt,
  left,
  t = 1,
  b = nrow(gt),
  l = 1,
  r = 1,
  z = Inf
)

gt <- gtable_add_cols(gt, widths = unit(0.5, "line"))
grid.newpage()
grid.draw(gt)

pushViewport(viewport())

grid.lines(y = c(.05, .98),
           x = (.11 + (5 / 10 * .861)),
           gp = gpar(col = "red"))
popViewport()

Answer 1

这是一个带有刻面的精简版本。您可以决定这是否足以满足您的要求，以放弃 gtable 的内容。

使用geom_vline 并将截距设置为 y 值的平均值；这会将它放在每个方面的相同位置。我取出了条形文字 (strip.text = element_blank()) 来模仿您删除两个情节的标题所做的事情。除此之外，它只是一个标准的facet_wrap 分组。

library(tidyverse)

n_1 = 10
n_2 = 10
mean_1 = 5.5
sd_1 = 1
mean_2 = 7
sd_2 = 1
data = data.frame(y = c(
  rnorm(n_1, mean_1, sd_1),
  rnorm(n_2, mean_2, sd_2)
),
group = c(rep("1", n_1), rep("2", n_2)))
data$y[data$y > 10] <- 10
data$y[data$y < 0] <- 0

ggplot(data, aes(x = y, fill = group)) +
  geom_histogram(breaks = seq(0, 10, length.out = 12)) +
  geom_vline(aes(xintercept = mean(y))) +
  facet_wrap(~ group, ncol = 1) +
  theme_minimal() +
  theme(strip.text = element_blank())