Finding the middle of the y axis in a ggplot with facets and free scales

Question

I have a facetted density plot with free scales, to which I would like to overlay a geom_pointrange to represent the summary of the distribution. However, I'd like this point to be fixed in the middle of my y axis for each facets (with the x varying according to the summary value). Here is what my code looks like:

library(ggplot2)
library(dplyr)

data <- iris %>% 
  mutate(grouping1 = rep(1:3, length.out = nrow(iris)),
         variable = Sepal.Length) 

data_summ <- data %>% 
  group_by(grouping1) %>% 
  summarise(variable = mean(Sepal.Length), 
            lower = quantile(Sepal.Length, 0.025), 
            upper = quantile(Sepal.Length, 0.975))

ggplot(data) +
  geom_density(aes(x = variable,
                   fill = grouping1)) +
  facet_wrap(~ grouping1, scales = "free")

## What I would like to add
+ geom_pointrange(data = data_summ,
                  aes(x = variable,
                      xmin = lower, xmax = upper,
                      y = mid_y))

My plot looks like this: 1

And I would like it to result to looking something like this: 2

I've tried to obtain the y axis limis after building my ggplot, but haven't managed to extract the right ones (possibly due to each facet having multiple grouping1 variables?). Another idea was to create a secondary y axis and map to that but as that axis needs to be transformed based on the original one I'd still need the max value in each facet...

Any idea would be really appreciated!

Answer 1

You could construct the plot first and then use the corresponding slots to find the center:

data <- iris %>% 
  mutate(grouping1 = rep(1:3, length.out = nrow(iris)),
         variable = Sepal.Length)
pl <- ggplot(data) +
  geom_density(aes(x = variable,
                   fill = grouping1)) +
  facet_wrap(~ grouping1, scales = "free")

plob <- ggplot_build(pl)
data_summ <- data %>% 
  group_by(grouping1) %>% 
  summarise(variable = mean(Sepal.Length), 
            lower = quantile(Sepal.Length, 0.025), 
            upper = quantile(Sepal.Length, 0.975)) %>%
  mutate(mid_y = sapply(plob$layout$panel_scales_y, \(y) mean(y$get_limits())))

pl + geom_pointrange(data = data_summ,
                  aes(x = variable,
                      xmin = lower, xmax = upper,
                      y = mid_y))