在具有小平面和自由刻度的 ggplot 中查找 y 轴的中间

Question

我有一个带有自由刻度的多面密度图，我想在其中叠加一个 geom_pointrange 来表示分布的摘要。但是，我希望将此点固定在每个方面的 y 轴中间（x 根据汇总值而变化）。这是我的代码的样子：

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))

我的情节是这样的：

我希望它看起来像这样：

我尝试在构建 ggplot 后获取 y 轴极限，但未能提取正确的极限（可能是因为每个方面都有多个

grouping1

变量？）。 另一个想法是创建一个辅助 y 轴并映射到该轴，但由于该轴需要根据原始轴进行转换，我仍然需要每个方面的最大值...

任何想法将不胜感激！

Answer 1

这对于当前的 ggplot2 来说是一件痛苦的事情，但是，开发版本有一个很好的技巧来进行相对的、与数据无关的事物放置。在开发版本中，您可以执行

y = I(0.5)

将其设置在每个面板的垂直中间。

# pak::pak("tidyverse/ggplot2") # installs development version of ggplot2
library(ggplot2)
library(dplyr)

iris <- iris %>% mutate(grouping2=rep(c(1:3), length.out=nrow(iris))) 
data_summ <- iris %>% 
  group_by(grouping2) %>% 
  summarise(variable = mean(Sepal.Length), 
            lower = quantile(Sepal.Length, 0.025), 
            upper = quantile(Sepal.Length, 0.975)) 

ggplot(iris) + 
  geom_density(aes(x=Sepal.Length, fill=Species)) + 
  geom_pointrange(
    data = data_summ,
    aes(x = variable, xmin = lower, xmax = upper, y = I(0.5))
  ) +
  facet_wrap(
    ~grouping2, 
    scales="free"
  )

^{创建于 2023-12-08，使用 reprex v2.0.2}

（免责声明：我撰写了添加此内容的 PR）

Answer 2

您可以先构建绘图，然后使用相应的槽来找到中心：

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))