Наличие geom_vline() хорошо ладит с facet_grid(): неудачный пример отображения

Question

Используя данные, сгенерированные отсюда, я бы хотел, чтобы ggplot2 создал график, похожий на приведенный ниже.

Желательно сюжетные панели с нежелательной маркировкой (facet_wrap):

Цель этого графика - сделать возможным визуальное сравнение среднего значения распределения первого столбца (подход 1) со средним значением плотности каждого столбца. Скрипт для создания графиков плотности выглядит следующим образом:

ggplot(surg_df, aes(x=op_tm, col=color_hex)) +
  geom_density(aes(fill=color_hex), alpha=0.3) +
  geom_density(data = base_comp_df, col='#a269ff', alpha=1, size=0.5) +
  geom_vline(data=avg_surg_df, aes(xintercept= avg_op_tm), 
             size=1, col=avg_surg_df$color_hex, linetype="dashed") +
  geom_vline(data=avg_comp_df, aes(xintercept= avg_op_tm+2), 
             size=1, colour='#a269ff', linetype="dashed") +
  annotate(geom= "text",
           label=paste("mean diff: ", 
                       as.character(floor(avg_comp_df$avg_op_tm-avg_surg_df$avg_op_tm)), 
                       sep=""), 
           col='black', size=4, x=100, y=0.006) +
  geom_segment(aes(x = avg_op_tm, y=0.006, xend = avg_surg_df$avg_op_tm, 
                   yend = 0.006, colour = "red") , 
               size=1, data = avg_comp_df) +    
  facet_wrap(~surg_grp) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  scale_colour_identity(guide="none", breaks=base_surg_df$color_hex) +
  scale_fill_identity(guide="legend", breaks=base_surg_df$color_hex,
                      name="Surgical Approaches", 
                      labels=base_surg_df$surg_apprch) 

Вышеуказанный участок желательно создать с использованием facet_wrap() с группировкой по переменным surg_grp, Но когда я решил сделать его менее запутанным из-за того, что facet_grid() вместо этого все вышло из-под контроля. Что мне удалось создать facet_grid() была следующая паршивая коллекция графиков плотности, каждая из которых имеет 3 нелепые вертикальные линии для каждой панели:)) Линии оказались средними значениями по каждому столбцу, выбранному из переменной avg_op_tm от avg_surg_df Расчетная таблица сводок.

Нежелательные сюжетные панели, желаемая маркировка (facet_grid):

Как вы заметили в приведенном ниже скрипте, в отличие от предыдущего графика, есть только один geom_vline, и три строки на каждой панели происходят из этой единственной строки:

ggplot(surg_df)+
  geom_density(aes(x=op_tm, col=color_hex, fill=color_hex), alpha=0.3) +
  scale_fill_identity("Approaches", guide="legend", breaks=base_surg_df$color_hex, 
                      labels=base_surg_df$surg_apprch,
                      aesthetics = "fill")+    
  scale_colour_identity(guide="none",breaks=base_surg_df$color_hex)+
  geom_density(data = base_comp_df, aes(x=op_tm), alpha=1, col='#a269ff', size=0.5) +
  geom_vline(data=avg_surg_df, aes(xintercept= avg_op_tm), size=1,
             linetype="dashed")+
  annotate(geom= "text",
           label=paste("mean diff: ", 
                       as.character(floor(avg_surg_df$avg_op_tm)), sep=""), 
           col='black', size=4, x=100, y=0.006)+
  facet_grid(rows = vars(condition_grp), cols=vars(surg_apprch), scales = 'free')

Сообщество богато с подобными вопросами и ответами вокруг facet_wrap() + geom_vline() но не так много полезных вопросов и ответов о facet_grid() + geom_vline(), Как я могу иметь geom_vline() использовать два параметра группировки, которые были переданы facet_wrap (condition_grp а также surg_apprch) и заставить его отображать данные правильно? Какую образовательную точку я не смог понять, что сделало мой подход с facet_grid() потерпеть поражение?

Любая помощь высоко ценится.

Answer 1

Вам необходимо предварительно рассчитать средства в отдельном фрейме данных, который повторяет структуру вашего facet_gridв его группах. Грубый и грязный пример с mtcars:

      library(dplyr)
library(ggplot2)

mean_df <- mtcars %>% 
  group_by(am, vs) %>% 
  summarise(mean_val = mean(mpg))

ggplot(mtcars) +
  geom_freqpoly(aes(x = mpg)) +
  geom_vline(data = mean_df, aes(xintercept = mean_val), colour = "red") +
  facet_grid(am ~ vs)