如何使用带有 geom_vline 和 facet_wrap 的循环？

Question

我的数据类似于我在下面创建的数据：

set.seed(42)
dates <- seq.Date(as.Date("2012-08-01"), as.Date("2014-08-30"), "day")
n <- length(dates)
dat <- data.frame(date = dates,
                  category = rep(LETTERS[1:4], n/2),
                  daily_count = sample(18:100, n, replace=TRUE))

#following to be used for creating dotted lines; highlighting a certain point for each category
point_dates <- sample(seq.Date(as.Date("2012-08-01"), as.Date("2014-08-30"), "month"),4)
category_name <- list("A", "B", "C", "D")

我正在使用facet_wrap为每个类别创建一个箱线图，并且point_dates对我很重要，因为它们显示了每个箱线图中的兴趣点。 这就是我创建情节的方式：

ggplot(dat) +
  geom_boxplot(aes(y = daily_count,
                   x = yearmonth(date),
                   group = paste(yearmonth(date), category),
                   fill = category)) +
  labs(x = 'Month & Year',
       y = 'Count',
       fill = "Category") +
  theme_bw() +
  theme(axis.text=element_text(size=10),
        axis.title=element_text(size=10),
        legend.position="none") +
  geom_vline(xintercept =  lubridate::ymd("2013-08-23"), linetype=1, colour="red", size = 0.5)+
  
  sapply(point_dates[[1]], function(xint) geom_vline(data=filter(dat, 
  category==category_name[[1]]),aes(xintercept = xint),
  linetype=3, colour="black", size = 1))+
  
  sapply(point_dates[[2]], function(xint) geom_vline(data=filter(dat, 
  category==category_name[[2]]),aes(xintercept = xint),
  linetype=3, colour="black", size = 1))+
  
  sapply(point_dates[[3]], function(xint) geom_vline(data=filter(dat, 
  category==category_name[[3]]),aes(xintercept = xint),
  linetype=3, colour="black", size = 1))+
  
  sapply(point_dates[[4]], function(xint) geom_vline(data=filter(dat, 
  category==category_name[[4]]),aes(xintercept = xint),
  linetype=3, colour="black", size = 1))+
  
  facet_wrap(~category, nrow = 2)

这是代码的输出： 情节正在创建得很好。 我的问题是，有没有更好的办法（循环可能？），这将帮助我摆脱写作的sapply多次。 因为类别的数量可能会发生变化（增加/减少），所以每次都要更改代码。

请问有什么指导吗？

Answer 1

您可以使用map()来迭代对sapply()的调用：

ggplot(dat) +
  geom_boxplot(aes(y = daily_count,
                   x = yearmonth(date),
                   group = paste(yearmonth(date), category),
                   fill = category)) +
  labs(x = 'Month & Year',
       y = 'Count',
       fill = "Category") +
  theme_bw() +
  theme(axis.text=element_text(size=10),
        axis.title=element_text(size=10),
        legend.position="none") +
  geom_vline(xintercept =  lubridate::ymd("2013-08-23"), linetype=1, colour="red", size = 0.5)+
  
  map(seq_along(unique(dat$category)), ~sapply(point_dates[[.]], function(xint) geom_vline(data=filter(dat, 
  category==category_name[[.]]),aes(xintercept = xint),
  linetype=3, colour="black", size = 1))) +

  facet_wrap(~category, nrow = 2)

Answer 2

我不确定这是最好的方法，但是您可以使用tidyr map2 tidyr完成所有这些。 这将节省您不必写出单个sapply 。

library(tidyverse)

ggplot(dat) +
  geom_boxplot(aes(y = daily_count,
                   x = yearmonth(date),
                   group = paste(yearmonth(date), category),
                   fill = category)) +
  labs(x = 'Month & Year',
       y = 'Count',
       fill = "Category") +
  theme_bw() +
  theme(axis.text=element_text(size=10),
        axis.title=element_text(size=10),
        legend.position="none") +
  geom_vline(xintercept =  lubridate::ymd("2013-08-23"), 
             linetype=1, colour="red", size = 0.5)+
  map2(point_dates, category_name, 
       ~geom_vline(data=filter(dat, category==.y),
                   aes(xintercept = .x),
                   linetype=3, colour="black", size = 1))+
  facet_wrap(~category, nrow = 2)

Answer 3

如果我猜对了，您已经为每个组定义了日期。 所以制作第一个情节：

library(ggplot2)
library(tsibble)

g = ggplot(dat) +
  geom_boxplot(aes(y = daily_count,
                   x = yearmonth(date),
                   group = paste(yearmonth(date), category),
                   fill = category)) +
  labs(x = 'Month & Year',
       y = 'Count',
       fill = "Category") +
  theme_bw() +
  theme(axis.text=element_text(size=10),
        axis.title=element_text(size=10),
        legend.position="none") +
  geom_vline(xintercept =  lubridate::ymd("2013-08-23"), linetype=1, colour="red", size = 0.5)+ 
  facet_wrap(~category, nrow = 2)

您只需要提供一个新的数据框并调用 geom_vline：

tmp = data.frame(category=unlist(category_name),date=point_dates)

g + geom_vline(data=tmp,aes(xintercept = date),
linetype=3, colour="black", size = 1)