在dplyr中绘制阴影时间段（geom_rect），并使用facet_wrap循环

Question

使用facet_wrap和dplyr do(...)生成图时，我无法让geom_rect显示阴影区域。

注意：这里的问题可能与数据结构问题有关。 请参阅此SO问题以了解当前的游戏状态。

以下最小示例使用ggplot2软件包的economics数据和tis软件包的NBER衰退日期。

赞赏提示技巧和咒语。

library(tis)
library(ggplot2)
# Prepare NBER recession start end dates.
start <- data.frame(date = as.Date(as.character(nberDates()[,"Start"]),"%Y%m%d"),
                    start= as.Date(as.character(nberDates()[,"Start"]),"%Y%m%d"))
end <- data.frame(date = as.Date(as.character(nberDates()[,"End"]),"%Y%m%d"),
                  end= as.Date(as.character(nberDates()[,"End"]),"%Y%m%d"))
dl <- economics %>% 
        gather(metric, value, pce:unemploy ) %>%
        group_by(metric) %>%
        mutate(diff = value - lag(value, default=first(value))) %>%
        mutate(pct = diff/value) %>%
        gather(transform, value, value:pct ) %>%
        full_join(x=., y=start, by=c('date' = 'date')) %>%
        full_join(x=., y=end, by=c('date' = 'date')) %>%
        mutate(ymin = 0) %>%
        mutate(ymax = Inf)
# Check the start end dates are present
dl %>% group_by(metric,transform, start) %>% summarise( count=n())

pl <- dl %>%
        do(
          plots = ggplot(data=., aes(x = date, y = value)) +
                      geom_point() +
                      geom_rect(aes(xmin = start, xmax = end, ymin = ymin, ymax = ymax)) +
                      stat_smooth(method="auto",size=1.5) +
                      facet_wrap(~transform, scales="free_y") 
          )  

pl[[1,2]]

Answer 1

我检查了每个组的最小和最大日期是否相同（不绘制NA组）：

dl %>% 
  group_by(transform) %>% 
  summarise(min= min(start, na.rm =TRUE), max = max(start, na.rm =TRUE))# 

A tibble: 4 x 3
  transform min        max       
  <chr>     <date>     <date>    
1 diff      1970-01-01 2008-01-01
2 pct       1970-01-01 2008-01-01
3 value     1970-01-01 2008-01-01
4 NA        1857-07-01 1960-05-01

即使不是最佳解决方案，您也可以对日期和日期进行硬编码，并使用annotate来避免不透明，因为geom_rect将绘制多个矩形。 我为透明度添加了alpha = 0.5 。

pl <- dl %>%
  do(
    plots = ggplot(data=., aes(x = date, y = value)) +
      geom_point() +
      annotate('rect', xmin = as.Date("1970-01-01"), xmax = as.Date("2008-01-01"), 
               ymin = -Inf, ymax = Inf, alpha = 0.5) +
      stat_smooth(method="auto",size=1.5) +
      facet_wrap(~transform, scales="free_y") 
  )  
pl[[1,2]]

Answer 2

好的，这里的问题是数据帧的构造是不平凡的。 外部联接的两种用法未提供所需的结构。

# Prepare NBER recession start end dates.
recessions <- data.frame(start = as.Date(as.character(nberDates()[,"Start"]),"%Y%m%d"),
                    end= as.Date(as.character(nberDates()[,"End"]),"%Y%m%d"))

# Create the long format data frame
dl <- economics %>% 
        gather(metric, value, pce:unemploy ) %>%
        group_by(metric) %>%
        mutate(diff = value - lag(value, default=first(value))) %>%
        mutate(pct = diff/value) %>%
        gather(transform, value, value:pct ) #%>%

# Build the data frame with start and end dates given in recessions 
df1 <- dl %>% 
        mutate(dummy=TRUE) %>% 
        left_join(recessions %>% mutate(dummy=TRUE)) %>% 
        filter(date >= start & date <= end) %>% 
        select(-dummy) 

# Build data frame of all other dates with start=NA and end=NA
df2 <- dl %>% 
        mutate(dummy=TRUE) %>% 
        left_join(recessions %>% mutate(dummy=TRUE)) %>% 
        mutate(start=NA, end=NA) %>%
        unique() %>%
        select(-dummy) 
# Now merge the two.  Overwirte NA values with start and end dates
dl <- df2 %>% 
      left_join(x=., y=df1, by="date") %>%
      mutate(date, start = ifelse(is.na(start.y), as.character(start.x), as.character(start.y)),end = ifelse(is.na(end.y), as.character(end.x), as.character(end.y))) %>%
      mutate(start=as.Date(start), end=as.Date(end) ) %>%
      select(-starts_with("start."),-starts_with("end."),-ends_with(".y")) %>% 
      setNames(sub(".x", "", names(.))) %>%
      mutate(ymin = -Inf) %>% #min(value)) %>%
      mutate(ymax = Inf) #max(value)) #%>%
# Check the start end dates are present
dl %>% group_by(metric,transform, start, end) %>% summarise( count = n() ) %>% print(n=180)

pl <- dl %>%
        group_by(metric) %>%
        do(
          plots = ggplot(data=., aes(x = date, y = value)) +
                      geom_point() +
                      # annotate('rect', xmin = start, xmax = end, 
                      #          ymin = ymin, ymax = ymax, alpha = 0.5) +
                      geom_rect(aes(xmin = start, xmax = end, ymin = ymin, ymax = ymax), na.rm=TRUE) +
                      stat_smooth(method="auto",size=1.5) +
                      facet_wrap(~transform, scales="free_y") 
          )

grid.draw(pl[[1,2]])