将时间序列数据转换为嵌套数据框，其中组在增加时间段w / dplyr和tidyr

如何解决将时间序列数据转换为嵌套数据框，其中组在增加时间段w / dplyr和tidyr

我有一个数据集，每年的每日计数跨越几十年，我想根据时间跨度的增加对数据的不同子集运行一个函数。例如，我想在数据的第一个十年（1995-2005），然后在第一个十年+ 1（1995-2006），第一个十年+ 2（1995-2007）上运行该函数，依此类推，直到时间序列的结尾。这就是我的想法：

dat <- tibble(
  year = rep(1995:2014,each = 30),count = rpois(600,5)
)
dat

# A tibble: 600 x 2
    year count
   <int> <int>
 1  1995     8
 2  1995     3
 3  1995     9
 4  1995     2
 5  1995     8
 6  1995     7
 7  1995     3
 8  1995     6
 9  1995     1
10  1995     7
# … with 590 more rows

最终产品看起来像这样：

# A tibble: 3 x 2
  time_span data              
  <chr>     <list>            
1 1995-2004 <tibble [300 × 1]>
2 1995-2005 <tibble [330 × 1]>
3 1995-2006 <tibble [360 × 1]>
...

然后将我的函数应用于嵌套数据框：

dat_nested %>%
  mutate(result = map(data,my_function))

我正在努力想办法用dplyr创建这些子集...有什么建议吗？谢谢！

解决方法

可以直接从原始数据帧计算结果，而无需中间的嵌套数据帧。但是，如果您仍然想创建嵌套的数据框，则使用相同的代码，但将其与

一起使用

my_function <- base::list

嵌套两列或使用

my_function <- function(x) list(x["count"])

仅嵌套count列。该解决方案仅使用dplyr。它不使用tidyr或purrr。

library(dplyr)

my_function <- function(x) sum(x$count)  # test function

dat %>%
  group_by(year) %>%
  summarize(result = my_function(.[.$year <= first(year),]),.groups = "drop") %>%
  mutate(year = paste(first(year),year,sep = "-")) %>%
  tail(-9)

给予：

# A tibble: 11 x 2
   year      result
   <chr>      <int>
 1 1995-2004   1502
 2 1995-2005   1647
 3 1995-2006   1810
 4 1995-2007   1957
 5 1995-2008   2106
 6 1995-2009   2258
 7 1995-2010   2398
 8 1995-2011   2547
 9 1995-2012   2697
10 1995-2013   2855
11 1995-2014   3016

使用my_function <- function(x) list(x["count"])时，输出如下所示：

# A tibble: 11 x 2
   year      result            
   <chr>     <list>            
 1 1995-2004 <tibble [300 x 1]>
 2 1995-2005 <tibble [330 x 1]>
 3 1995-2006 <tibble [360 x 1]>
 4 1995-2007 <tibble [390 x 1]>
 5 1995-2008 <tibble [420 x 1]>
 6 1995-2009 <tibble [450 x 1]>
 7 1995-2010 <tibble [480 x 1]>
 8 1995-2011 <tibble [510 x 1]>
 9 1995-2012 <tibble [540 x 1]>
10 1995-2013 <tibble [570 x 1]>
11 1995-2014 <tibble [600 x 1]>

注意

可重复形式的测试输入dat为：

set.seed(123)
dat <- data.frame(year = rep(1995:2014,each = 30),count = rpois(600,5))

,

这是使用map的一种方式：

library(dplyr)

n <- min(dat$year)
purrr::map_df((n+10):max(dat$year),~dat %>% 
      filter(between(year,n,.x)) %>%
      summarise(year = paste(min(year),max(year),sep = '-'),data = list(count)))
                #If you want dataframe
                #data = list(data.frame(count = count))))

#     year      data       
#   <chr>     <list>     
# 1 1995-2005 <int [330]>
# 2 1995-2006 <int [360]>
# 3 1995-2007 <int [390]>
# 4 1995-2008 <int [420]>
# 5 1995-2009 <int [450]>
# 6 1995-2010 <int [480]>
# 7 1995-2011 <int [510]>
# 8 1995-2012 <int [540]>
# 9 1995-2013 <int [570]>
#10 1995-2014 <int [600]>

,

这是我尝试在滚动窗口的基础上用时间序列数据创建嵌套数据的方法。 （注意：在将来的版本中，rlang与var=enquo(str_varname)一起使用!!var可能会发生变化。）

library(dplyr)
library(tidyr)

create_rolling_yr_data <- function(df,year='year',rolling=9,var_list=c('count'),newvar='rolling') {
  year <- enquo(year)
  var_list <- enquos(var_list)

  df <- df %>% dplyr::select(!!year,!!!var_list)
  df_nest <- df %>% group_by(year) %>% nest()
  print(df_nest)
  list_data <- list()
  yrs <- unique(df[[ensym(year)]]) 
  yr_end <- max(yrs) - rolling
  for (i in seq_along(yrs)) {
    yr <- yrs[i]
    if (yr <= yr_end) {
      list_data[[i]] <- df %>% filter(year >= yr,year <= (yr+rolling))
    } else {
      list_data[[i]] <- list()
    }
  }
  df_nest[[newvar]] <- list_data
  return(df_nest %>% filter(year <= yr_end))
}

create_rolling_yr_data(dat,newvar='rolling')