如何使用帶有geom_vline和facet_wrap的回圈？

我的資料類似于我在下面創建的資料：

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多次寫作。因為類別的數量可能會發生變化（增加/減少），所以每次都要更改代碼。

請問有什么指導嗎？

uj5u.com熱心網友回復：

我不確定這是最好的方法，但是您可以使用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)

uj5u.com熱心網友回復：

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

uj5u.com熱心網友回復：

如果我猜對了，您已經為每個組定義了日期。所以制作第一個情節：

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)

標籤：r ggplot2 箱形图 geom-vline

上一篇：在R中繪制鏡像直方圖并處理NA

下一篇：更改聚集geom_col中的填充順序？