dplyr自定义延迟函数用于不规则时间序列

Question

我有一组不规则的时间序列数据，其中数据集中存在间隙。此外，数据是分组的。我已经能够找到观察到的滞后函数（因此它们会在数据集中找到先前的记录），但我想指定一个时间变量，并通过匹配滞后时间来计算滞后。这个问题：R lag/lead irregular time series data 做了类似的事情。然而，我不能使用zoo解决方案（我有某种包不兼容的问题，根本无法使用zoo），并且未能使data.table解决方案成为足够灵活的东西，以便将其作为带有滞后量输入和分组数据容量的函数来使用。

测试数据：

testdf <- data.frame(group = c(1,1,1,1,1,2,2,2,2,2),
                 counter = c(1,2,3,5,6,7,8,9,11,12),
                 xval = seq(100, 1000, 100))
lagamount <- 1

输出应该是向量：NA 100 200 NA 400 NA 600 700 NA 900。

目前我正在使用以下内容：

library(dplyr)
testout <- group_by(testdf, group) %>%
  mutate(testout = function(x) which((testdf$counter - x) == lagamount))

这给我一个数据类型错误，说某些东西（未指定）不是向量。

有没有办法使这个构造工作？或者，如何在分组变量的不规则时间序列中滞后？

- JenB

---

也许你可以将相关的 zoo 函数称为 zoo::needed_function()，从而避免加载该包。 - Axeman

你得到了那个错误是因为你向 mutate 提供了一个函数，而它期望一个向量。 - Axeman

谢谢，我应该表达得更清楚 - Zoo 在我的机器上无法安装，存在 Rccp 依赖问题。感谢您对错误消息的解释，我会再试一次。 - JenB

Answer 1

只有在不使用do的情况下，通过dplyr来实现这一点的唯一方法是先使隐式缺失值变为显式缺失值，然后再进行筛选。

提供一个向量以进行突变，并使用ifelse（或可能是新的dplyr::if_else）检查滞后是否符合要求。示例：

library(tidyr)
lagamount <- 2

testout <- group_by(testdf, group) %>%
  complete(group, counter = min(counter):max(counter)) %>% 
  mutate(testout = if_else(counter - lag(counter, lagamount) == lagamount, 
                           lag(xval, lagamount), 
                           NA_real_)) %>% 
  filter(!is.na(xval))

生成：

Source: local data frame [10 x 4]
Groups: group [2]

   group counter  xval testout
   <dbl>   <dbl> <dbl>   <dbl>
1      1       1   100      NA
2      1       2   200      NA
3      1       3   300     100
4      1       5   400     300
5      1       6   500      NA
6      2       7   600      NA
7      2       8   700      NA
8      2       9   800     600
9      2      11   900     800
10     2      12  1000      NA

- Axeman

---

谢谢。不幸的是，它只适用于单个时间单位滞后。例如，它无法检索2或3个时间单位之前的值（除非这恰好是先前的观察结果）。这就是为什么我试图使用“which”来解决问题的原因。 - JenB

好的，我认为编辑应该解决了这个问题。否则，你能给出“lagamount = 2”的预期输出吗？ - Axeman

抱歉，由于网络信号不好，回复有些晚了。输出看起来确实符合我的要求。是的，先填充缺失的数据点，然后在最后删除它们是一个很好的方法。我会逐步进行并在几分钟内接受。谢谢你，我自己肯定无法做到这一点。 - JenB

很高兴能够帮忙。抱歉我需要几次迭代才能理解出问题所在。 - Axeman

那段代码不是多余的吗？如果你使用 complete() 函数来完成数据集，最终结果总是会满足 counter - dplyr::lag(counter, lagamount) == lagamount，对吧（至少在按照 counter 排序之后）？ - Matifou

Answer 2

现在有一种高效的解决方案，可以在collapse::flag（以及fdiff和fgrowth）中使用。创建数据时，需要确保时间变量为整数，否则它将在内部转换为因子，在这种情况下会删除不规则性。

testdf <- data.frame(group = c(1,1,1,1,1,2,2,2,2,2),
                     counter = as.integer(c(1,2,3,5,6,7,8,9,11,12)),
                     xval = seq(100, 1000, 100))
lagamount <- 1

然后我们可以写：

然后我们可以写：

library(collapse)
settransform(testdf, L_xval = flag(xval, lagamount, group, counter))
testdf
#>    group counter xval L_xval
#> 1      1       1  100     NA
#> 2      1       2  200    100
#> 3      1       3  300    200
#> 4      1       5  400     NA
#> 5      1       6  500    400
#> 6      2       7  600     NA
#> 7      2       8  700    600
#> 8      2       9  800    700
#> 9      2      11  900     NA
#> 10     2      12 1000    900

^{由reprex包(v0.3.0)于2021-07-10创建}

您还可以选择使用管道生成滞后和超前序列（或特定的滞后/超前顺序）：

testdf |> gby(group) |> flag(-1:3, counter)
#>    group counter F1.xval xval L1.xval L2.xval L3.xval
#> 1      1       1     200  100      NA      NA      NA
#> 2      1       2     300  200     100      NA      NA
#> 3      1       3      NA  300     200     100      NA
#> 4      1       5     500  400      NA     300     200
#> 5      1       6      NA  500     400      NA     300
#> 6      2       7     700  600      NA      NA      NA
#> 7      2       8     800  700     600      NA      NA
#> 8      2       9      NA  800     700     600      NA
#> 9      2      11    1000  900      NA     800     700
#> 10     2      12      NA 1000     900      NA     800
#> 
#> Grouped by:  group  [2 | 5 (0)]

^{本文创建于2021年7月10日，使用reprex package (v0.3.0)。}

或者使用settransformv进行原地修改：

settransformv(testdf, "xval", flag, -1:3, group, counter, apply = FALSE)
testdf
#>    group counter xval F1.xval L1.xval L2.xval L3.xval
#> 1      1       1  100     200      NA      NA      NA
#> 2      1       2  200     300     100      NA      NA
#> 3      1       3  300      NA     200     100      NA
#> 4      1       5  400     500      NA     300     200
#> 5      1       6  500      NA     400      NA     300
#> 6      2       7  600     700      NA      NA      NA
#> 7      2       8  700     800     600      NA      NA
#> 8      2       9  800      NA     700     600      NA
#> 9      2      11  900    1000      NA     800     700
#> 10     2      12 1000      NA     900      NA     800

^{本文创建于2021年7月10日，使用reprex包（v0.3.0）}

fdiff和fgrowth的工作方式类似，也支持迭代和复利计算。您还可以将这些函数应用于不规则时间序列（没有面板ID），然后需要指定t = counter。所有函数都可以应用于向量/时间序列、矩阵/xts、数据框/数据表/小提琴图，并且如果您正在寻找面向对象的方法，则还支持plm面板系列和数据框。

更多信息请参见：https://sebkrantz.github.io/collapse/reference/time-series-panel-series.html

- Sebastian

---

只是一个快速的问题，为什么你在这里使用apply = FALSE？apply = TRUE应该会给出相同的解决方案吗？您能详细说明一下apply = TRUE和apply = FALSE之间的区别吗？ - Vitalijs

@Vitalijs 不同之处在于 apply = TRUE 将函数应用于整个子集。如果我们有多个变量需要滞后，这更有效，因为使用 flag.data.frame 意味着我们只需要对数据进行一次分组/索引，并且可以在 C++ 中跨列应用滞后，而不是每次使用 lapply 和 flag.default 重新索引。 - Sebastian

Answer 3

最终我不得不将扩展显式化，并在将上述答案转换为函数时删除了if_else中的严格数据类型。这是最终形式。

getlag <- function(timevar, valuevar, laglength){
  df1 <- data.frame(counter = timevar, value = valuevar, indf = 1)
  alltimes <- data.frame(counter = seq(min(timevar), max(timevar)))
  df2 <- merge(alltimes, df1, all.x = TRUE)
  df2 <- df2 %>%
    mutate(lagvals = ifelse(counter - lag(counter, laglength) == laglength,
                            lag(value, laglength),
                            NA_real_)) %>%
    filter(!is.na(indf))
  return(df2$lagvals)
  }

测试用例如下：

testout <- group_by(testdf, group) %>%
  mutate(testout = getlag(counter, xval, 1))

- JenB