时间戳

首页 > 解决方案 > 使用 purrr 迭代时间序列数据

r - 使用 purrr 迭代时间序列数据

问题描述

我在数据框中有一堆时间序列数据堆叠在一起；一个国家的每个地区都有一个系列。我想迭代地将seas()函数（从seasonal包中）应用到每个系列，以使系列进行季节性调整。为此，我首先必须将系列转换为ts类。我正在努力使用purrr.

这是一个最低限度的工作示例：

library(seasonal)
library(tidyverse)
set.seed(1234)
df <- data.frame(region = rep(1:10, each = 20),
             quarter = rep(1:20, 10),
             var = sample(5:200, 200, replace = T))

对于每个区域（由数字索引），我想执行以下操作。这里以第一个区域为例：

tem1 <- df %>% filter(region==1)
tem2 <- ts(data = tem1$var, frequency = 4, start=c(1990,1)) 
tem3 <- seas(tem2)
tem4 <- as.data.frame(tem3$data)

然后我想堆叠输出（即多个 tem4 数据帧，每个区域一个），以及区域和季度标识符。

因此，区域 1 的输出开始是这样的：

  final seasonaladj trend irregular region quarter
1    27          27 96.95 -67.97279      1       1
2   126         126 96.95  27.87381      1       2
3   124         124 96.95  27.10823      1       3
4   127         127 96.95  30.55075      1       4
5   173         173 96.95  75.01355      1       5
6   130         130 96.95  32.10672      1       6

区域 2 的数据将低于此等。

我从以下开始，但到目前为止还没有运气。基本上，我正在努力将时间序列放入小标题：

seas.adjusted <- df %>%
group_by(region) %>% 
mutate(data.ts = map(.x = data$var, 
                     .f = as.ts, 
                     start = 1990,
                     freq = 4))

标签： rtime-seriespurrr

解决方案

我对季节性调整部分了解不多，因此可能会遗漏一些东西，但我可以帮助您将计算转移到一个map友好的函数中。

按区域分组后，您可以嵌套数据，以便每个区域都有一个嵌套数据框。然后，您可以运行与以前基本相同的代码，但在map. 取消嵌套生成的列会给您一个长形的调整数据框。

就像我说的那样，我没有专业知识来知道最后两列是否有NAs 是预期的。

编辑：基于@wibeasley关于保留quarter列的问题，我添加了一个mutate添加嵌套数据框中列出的季度的列。

library(seasonal)
library(tidyverse)
set.seed(1234)
df <- data.frame(region = rep(1:10, each = 20),
                 quarter = rep(1:20, 10),
                 var = sample(5:200, 200, replace = T))

df %>%
  group_by(region) %>%
  nest() %>%
  mutate(data.ts = map(data, function(x) {
    tem2 <- ts(x$var, frequency = 4, start = c(1990, 1))
    tem3 <- seas(tem2)
    as.data.frame(tem3$data) %>%
      mutate(quarter = x$quarter)
  })) %>%
  unnest(data.ts)
#> # A tibble: 200 x 8
#>    region final seasonaladj trend irregular quarter seasonal adjustfac
#>     <int> <dbl>       <dbl> <dbl>     <dbl>   <int>    <dbl>     <dbl>
#>  1      1    27          27  97.0    -68.0        1       NA        NA
#>  2      1   126         126  97.0     27.9        2       NA        NA
#>  3      1   124         124  97.0     27.1        3       NA        NA
#>  4      1   127         127  97.0     30.6        4       NA        NA
#>  5      1   173         173  97.0     75.0        5       NA        NA
#>  6      1   130         130  97.0     32.1        6       NA        NA
#>  7      1     6           6  97.0    -89.0        7       NA        NA
#>  8      1    50          50  97.0    -46.5        8       NA        NA
#>  9      1   135         135  97.0     36.7        9       NA        NA
#> 10      1   105         105  97.0      8.81      10       NA        NA
#> # ... with 190 more rows

我也更多地考虑在没有嵌套的情况下执行此操作，而是尝试使用split. 将数据帧列表传递给imap_dfr让我获取数据帧的每个拆分片段及其名称（在本例中为 的值region），然后将所有rbinded 一起返回到一个数据帧中。我有时会回避嵌套数据，只是因为我无法看到正在发生的事情，所以这是一种可能更透明的替代方案。

df %>%
  split(.$region) %>%
  imap_dfr(function(x, reg) {
    tem2 <- ts(x$var, frequency = 4, start = c(1990, 1))
    tem3 <- seas(tem2)
    as.data.frame(tem3$data) %>%
      mutate(region = reg, quarter = x$quarter)
  }) %>%
  select(region, quarter, everything()) %>%
  head()
#>   region quarter final seasonaladj trend irregular seasonal adjustfac
#> 1      1       1    27          27 96.95 -67.97274       NA        NA
#> 2      1       2   126         126 96.95  27.87378       NA        NA
#> 3      1       3   124         124 96.95  27.10823       NA        NA
#> 4      1       4   127         127 96.95  30.55077       NA        NA
#> 5      1       5   173         173 96.95  75.01353       NA        NA
#> 6      1       6   130         130 96.95  32.10669       NA        NA

由reprex 包(v0.2.0) 于 2018 年 8 月 12 日创建。

推荐阅读