不规则时间序列的滚动回归

Question

摘要(tldr)

我需要对不规则时间序列执行滚动回归(即间隔甚至可能不是周期性的，并且从0, 1, 2, 3... 到 ...7, 20, 24, 28...)，这是简单的数字，不一定需要日期/时间，但滚动窗口需要按时间。因此，如果我有一个不规则采样 600 秒的时间序列且窗口为 30，则每 30 秒执行一次回归，而不是每 30 个样本执行一次回归。

我读过示例，虽然我可以按时间复制滚动总和和中位数，但我似乎无法弄清楚回归。

问题

首先，我阅读了一些有关对不规则时间序列数据执行滚动函数的其他问题，例如:optimized rolling functions on irregular time series with time-based window ，这个:Rolling window over irregular time series 。

问题是，到目前为止，提供的示例对于像 sum 或 median 这样的方程来说很简单，但我还没有弄清楚如何执行简单的滚动回归，即使用 lm ，仍然基于窗口基于不规则时间序列的相同警告。而且，我的时间序列要简单得多；不需要日期，只是“流逝”的时间。

无论如何，正确地做到这一点对我来说很重要，因为时间不规则 - 例如，时间间隔的跳跃 - 可能会高估或低估滚动回归中的系数，因为样本窗口将包括 额外时间。

所以我想知道是否有人可以帮助我创建一个以最简单的方式执行此操作的函数？该数据集基于随着时间的推移测量变量，即 2 个变量:时间和响应。时间每隔x个耗时单位(秒、分钟，因此不是日期/时间格式)进行测量，但偶尔会变得不规则。

对于函数中的每一行，它应该基于 n 个时间单位的宽度执行线性回归。宽度不应超过 n 个单位，但可以降低(即减小)以适应不规则的时间采样。例如，如果宽度指定为 20 秒，但每 6 秒采样一次时间，则窗口将舍入为 18，而不是 24 秒。

我在这里查看了这个问题:How to calculate the average slope within a moving window in R ，我在不规则时间序列上测试了该代码，但看起来它是基于规则时间序列的。

示例数据:

sample <- 
structure(list(x = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 
29, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 47, 48, 
49), y = c(50, 49, 48, 47, 46, 47, 46, 45, 44, 43, 44, 43, 42, 
41, 40, 41, 40, 39, 38, 37, 38, 37, 36, 35, 34, 35, 34, 33, 32, 
31, 30, 29, 28, 29, 28, 27, 26, 25, 26, 25, 24, 23, 22, 21, 20, 
19)), .Names = c("x", "y"), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -46L))

我当前的代码(基于我之前提到的问题)。我知道它不是按时间子集:

library(zoo)
clm <- function(z) coef(lm(y ~ x, as.data.frame(z)))
rollme <- rollapplyr(zoo(sample), 10, clm, by.column = F, fill = NA)

预期输出(手动计算)如下。输出与常规滚动回归不同 - 一旦时间间隔在 29(秒)处跳过，数字就会不同:

    NA
    NA
    NA
    NA
    NA
    NA
    NA
    NA
    NA
    -0.696969697
    -0.6
    -0.551515152
    -0.551515152
    -0.6
    -0.696969697
    -0.6
    -0.551515152
    -0.551515152
    -0.6
    -0.696969697
    -0.6
    -0.551515152
    -0.551515152
    -0.6
    -0.696969697
    -0.6
    -0.551515152
    -0.551515152
    -0.6
    -0.696969697
    -0.605042017
    -0.638888889
    -0.716981132
    -0.597560976
    -0.528301887
    -0.5
    -0.521008403
    -0.642857143
    -0.566666667
    -0.551515152
    -0.551515152
    -0.6
    -0.696969697
    -0.605042017
    -0.638888889
    -0.716981132

我希望我提供了足够的信息，但是请让我知道(或者在某个地方给我一个很好的例子的指南)让我尝试这个？

我尝试过的其他事情: 我尝试将时间转换为 POSIXct 格式，但我不知道如何对此执行 lm:

require(lubridate)    
x <- as.POSIXct(strptime(sample$x, format = "%S"))

更新:添加了 tldr 部分。

Answer 1

试试这个:

# time interval is 1    
sz=10
    pl2=list()
    for ( i in 1:nrow(sample)){
      if (i<sz) period=sz else
      period=length(sample$x[sample$x>(sample$x[i]-sz) & sample$x<=sample$x[i]])-1
      pl2[[i]]=seq(-period,0)
    }

#update for time interval > 1
sz=10
tint=1
pl2=list()
for ( i in 1:nrow(sample)){
  if (i<sz) period=sz else
  period=length(sample$x[sample$x>(sample$x[i]-sz*tint) & sample$x<=sample$x[i]])-1
  pl2[[i]]=seq(-period,0)
}

rollme3 <- rollapplyr(zoo(sample), pl2, clm, by.column = F, fill = NA)

> tail(rollme3)
   (Intercept)          x
41    47.38182 -0.5515152
42    49.20000 -0.6000000
43    53.03030 -0.6969697
44    49.26050 -0.6050420
45    50.72222 -0.6388889
46    54.22642 -0.7169811