Нарисуйте линию на нескольких рисунках ggplot в gtable_matrix

Question

Я пытаюсь нарисовать линию на двух гистограммах ggplot в gtable_matrix, чтобы среднее значение на одной гистограмме накладывалось на оба графика.

Тем не менее, я не могу получить координаты устройства области построения. В базовой графике я бы использовал 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())