Draw a line across multiple ggplot figures in a gtable_matrix - r

Question

I am trying to draw a line across two ggplot histograms in a gtable_matrix, so that the mean of the values in the one histogram is overlaid across both plots.
However, I cannot get at the device coordinates of the plotting area. In base graphics, I would use grconvertX(), but where can I find the device coordinates of the plotting area of ggplot so I can convert numbers on my 'user' scale (0-10) to device coordinates?
In the example below, I have meticulously found the numbers to plug in to get the line at the correct location, but as soon as the plot is rescaled, or the axis labels change, or any other plot element changes, it breaks down. Probably won't work as intended on your machine either.
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

Here's a stripped-down version with facets. You can decide whether this accomplishes enough of what you're looking for to drop the gtable stuff.
Use a geom_vline with the intercept set to the mean of your y-values; this will put it in the same place on each facet. I took out the strip text (strip.text = element_blank()) to mimic what you'd done with removing the titles of the two plots. Other than that, it's just a standard facet_wrap by groups.
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())