如何使用 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 的麻烦。因为类别数量可能会发生变化（increase/decrease），那就是每次都要改代码。

有什么指导吗？

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 一次完成所有这些。这将节省您写出个人 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)

如何使用 geom_vline 和 facet_wrap 循环？

How to use loop with geom_vline and facet_wrap?

r

ggplot2

boxplot

geom-vline