ggplot2，facet_wrap：在不同方面绘制两次数据

Question

假设我有这样的数据框：

df <- data.frame(year_day = rep(1:365, 3), 
                 year = rep(2001:2003, each = 365), 
                 value = sin(2*pi*rep(1:365, 3)/365))

它代表了2001年到2003年之间每年（ year_day ）每天的某些价值（ value ）。我想每年绘制一次并使用ggplot2这样做。

ggplot(df) + geom_point(aes(year_day, value)) + facet_wrap(~year, ncol=1)

这给了我：

大。 现在，假设我想稍微扩展我的绘图区域，以便每年包括前一年的3个月和下一年的3个月（如果存在这些数据）。 这意味着一些数据将被绘制两次。 例如，2003年的前三个月将出现在2002年和2003年的情节中。因此，我可以复制这些行并将它们分配给2002年，但是year-day 366到485.这样可行，但很有意思。 有更优雅的解决方案吗？

Answer 1

编辑删除旧版本并替换

这是我一直在考虑的事情，所以这是一个足够的理由来尝试实现它。 它仍然涉及重复行，这是很糟糕的，但这是我能想到的最好的方式。

这是一个整洁的管道功能，它将数据帧（甚至是分组的）作为其第一个参数，并将一列日期作为其第二个参数。 有一个可选的第三个参数来扩展每个窗口扩展的范围（默认为0.25或3个月）。 第四个论点是财政或学术年代，而不是Jan-Jan，但我还没有深入思考过那个。

输出是相同的数据帧，具有多年尾部的重复行，其中每年的日期为doy_wrapped （从负数到> 365），而nominal_yr是每个窗口居中的年份。

例如，使用数据集ggplot2::economics ：

library(dplyr)
library(lubridate)

economics %>% 
  filter(year(date) > 2007) 

 # A tibble: 88 x 6 date pce pop psavert uempmed unemploy <date> <dbl> <int> <dbl> <dbl> <int> 1 2008-01-01 9963.2 303506 3.4 9.0 7685 2 2008-02-01 9955.7 303711 3.9 8.7 7497 3 2008-03-01 10004.2 303907 4.0 8.7 7822 4 2008-04-01 10044.6 304117 3.5 9.4 7637 5 2008-05-01 10093.3 304323 7.9 7.9 8395 6 2008-06-01 10149.4 304556 5.6 9.0 8575 7 2008-07-01 10151.1 304798 4.4 9.7 8937 8 2008-08-01 10140.3 305045 3.7 9.7 9438 9 2008-09-01 10083.2 305309 4.4 10.2 9494 10 2008-10-01 9983.3 305554 5.4 10.4 10074 # ... with 78 more rows 

---

economics %>% 
  filter(year(date) > 2007) %>% 
  wrap_years(date, expand = 3/12)

 # A tibble: 136 x 8 # Groups: nominal_yr [8] date pce pop psavert uempmed unemploy nominal_yr doy_wrapped <date> <dbl> <int> <dbl> <dbl> <int> <dbl> <dbl> 1 2008-01-01 9963.2 303506 3.4 9.0 7685 2008 1 2 2008-02-01 9955.7 303711 3.9 8.7 7497 2008 32 3 2008-03-01 10004.2 303907 4.0 8.7 7822 2008 61 4 2008-04-01 10044.6 304117 3.5 9.4 7637 2008 92 5 2008-05-01 10093.3 304323 7.9 7.9 8395 2008 122 6 2008-06-01 10149.4 304556 5.6 9.0 8575 2008 153 7 2008-07-01 10151.1 304798 4.4 9.7 8937 2008 183 8 2008-08-01 10140.3 305045 3.7 9.7 9438 2008 214 9 2008-09-01 10083.2 305309 4.4 10.2 9494 2008 245 10 2008-10-01 9983.3 305554 5.4 10.4 10074 2009 -90 # ... with 126 more rows 

这确实有点不合时宜; 它按顺序将行重复三次，然后将它们重新分配给相邻年份。 它保留原始分组，同时为新的nominal_yr添加一个（以删除可能的孤立尾部，其中缺少中心年份数据）。

economics %>% 
  filter(year(date) > 2007) %>% 
  wrap_years(date, expand = 3/12) %>%
  ggplot(aes(doy_wrapped, unemploy)) + 
  geom_line() + facet_wrap(~nominal_yr, ncol = 3)

然后有几个技巧来装扮它并纠正轴：

economics %>% 
  filter(year(date) > 2007) %>% 
  wrap_years(date, expand = 3/12) %>%
  ggplot(aes(doy_wrapped + ymd("1900-01-01") - 1, unemploy)) + 
  geom_line() + facet_wrap(~nominal_yr, ncol = 2) +
  geom_vline(xintercept = as.numeric(c(ymd("1900-01-01"), ymd("1901-01-01")))) +
  scale_x_date(date_breaks = "2 months",date_labels = "%b",
               name = NULL, expand = c(0,0) +
  theme_minimal() +
  theme(panel.spacing.x = unit(1, "cm"))

+ ymd("1900-01-01") - 1 aes(...)是任意的，你只是希望它与1月1日+ ymd("1900-01-01") - 1 ，这样每年都有正确的月份。 然后将它与垂直线中的xintercept =匹配。

理想情况下，这最终将成为一系列wrap_*函数的一部分，包括四分之一，几个月，几小时，几十年等。

功能代码：

wrap_years <- function(df, datecol, expand = 0.25, offset = "2001-01-01") {

  if(!is.data.frame(df)) {return(df)}

  datecol <- enquo(datecol)

  if(expand > 1) {
    warning(paste0("Window expansions of > 1 are not supported."))
    return(df)
  }


  if(!(quo_name(datecol) %in% names(df))) {
    warning(paste0("Column '", quo_name(datecol), "' not found in data."))
    return(df)
  }

  # offset <- as_date(offset)
  # warning(paste0("Using  ", stamp("August 26", orders = "md")(offset), 
  #                " as start of year. Not yet implemented."))

  if(!is.Date(df %>% pull(!!datecol))) {
    warning(paste0("Use lubridate functions to parse '", 
                   quo_name(datecol), 
                   "' before proceeding."))
    return(df)
  }

  df %>% 
    mutate(adj_wrap = list(-1:1)) %>% 
    tidyr::unnest() %>% 
    mutate(nominal_yr =  year(!!datecol) -     adj_wrap,
           doy_wrapped = yday(!!datecol) + 365*adj_wrap) %>% 
    filter(between(doy_wrapped, -expand * 365, (1 + expand) * 365)) %>% 
    select(-adj_wrap) %>% 
    group_by(nominal_yr, add = T) %>% 
    filter(sum(year(!!datecol) != nominal_yr) != length(nominal_yr))

}

我曾经假设复制最少的行数将是最快的方法，这是我第一次尝试它的范例。 稍后考虑一下，我意识到一种更天真的方法是简单地复制所有行，结果证明要快得多。 然后过滤步骤between完成，这也很快。 此版本的功能大约是以前版本速度的2倍（但是绘制原始数据的速度约为0.01倍）。