r - 如何将循环与 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

我不确定这是不是最好的方法，但你可以使用map2from一次性完成所有这些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 2

您可以使用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 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)