在dplyr中绘制阴影时间段（geom_rect），并使用facet_wrap进行循环 [英] Plot shaded time period (geom_rect) inside dplyr do loop with facet_wrap

问题描述

在使用 facet_wrap 和dplyr <$时，我无法使 geom_rect 显示阴影区域c $ c> do（...）来生成图表。

注意：可能与数据结构问题有关。查看

解决方案

好的，这里的问题是建设的数据帧是不平凡的。

 ＃准备NBER经济衰退开始结束日期。 
衰退<  -  data.frame（start = as.Date（as.character（nberDates（）[，Start]），％Y％m％d），
 end = as .Date（as.character（nberDates（）[，End]），％Y％m％d））
 
＃创建长格式数据框
 dl< - 经济学％>％
 collect（metric，value，pce：unemploy）％>％
 group_by（metric）％>％
 mutate（diff = value  -  lag（value，默认=第一（值）））％>％
 mutate（pct = diff / value）％>％
 gather（变换，值，值：pct）＃％>％
 
＃构建经济衰退时开始和结束日期的数据框
 df1<  -  dl％>％
 mutate（dummy = TRUE）％>％
 left_join （衰退％>％mutate（dummy = TRUE））％>％
 filter（日期> =开始&日期< =结束）％>％
 select（-dummy）
 
＃使用start = NA和end = NA 
 df2 < -  dl％>％
 mutate（dummy = TRUE）％>％建立所有其他日期的数据框。 
 left_ ％>％b $ b mutate（start = NA，end = NA）％>％
 unique（）％>％$ b $加入（后退％>％mutate（dummy = TRUE） b选择（-dummy）
＃现在合并这两个。覆盖开始和结束日期的NA值
 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。字符（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， （％）b $ mutate（ymin = -Inf）％>％#min（value））％>％
 mutate（ymax = Inf）#max（ （％，％））＃％>％
＃检查开始结束日期是否存在
 dl％>％group_by（metric，transform，start，end）％>％summarize（count = n（） ）％（％）打印（n = 180）
 
 pl < -  dl％>％
 group_by（公制）％>％
 do（
 plots = ggplot（data =。，aes（x = date，y = value））+ 
 geom_point（）+ 
＃annotate（'r ect'，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]]）
  

I'm having trouble getting a geom_rect to display a shaded area when using facet_wrap and the dplyr do(...) to generate the plots.

NOTE: The issue here may be related to a data structure issue. See this SO question for the current state of play.

The following minimal example uses the ggplot2 packages economics data and the NBER recession dates from the tis package.

Appreciate hints tips and incantations.

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]]

解决方案

Okay, the issue here is the construction of the data frame is non-trivial. Two uses of outer join does not provide the required structure.

# 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]])

这篇关于在dplyr中绘制阴影时间段（geom_rect），并使用facet_wrap进行循环的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！