Нарисуйте линию на нескольких рисунках 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())