不規則時間序列的滾動回歸

Question

摘要 (tldr)

我需要對不規則的時間序列（即間隔甚至可能不是周期性的，從0, 1, 2, 3...到...7, 20, 24, 28... ）執行滾動回歸簡單的數字，不一定需要日期/時間，但滾動窗口需要按時間。 因此，如果我有一個時間序列不規則采樣 600 秒且窗口為 30，則每 30 秒執行一次回歸，而不是每 30 個樣本。

我讀過例子，雖然我可以按時間復制滾動總和和中位數，但我似乎無法弄清楚回歸。

問題

首先，我已經閱讀了一些關於在不規則時間序列數據上執行滾動函數的其他問題，例如： 優化滾動函數在不規則時間序列上使用基於時間的窗口，以及這個： 不規則時間序列上的滾動窗口.

問題是，到目前為止，提供的示例對於sum或median等方程很簡單，但我還沒有弄清楚如何執行簡單的滾動回歸，即使用lm ，這仍然基於相同的警告，即窗口基於不規則的時間序列。 此外，我的時間序列要簡單得多； 沒有日期是必要的，它只是時間“流逝”。

無論如何，正確處理對我來說很重要，因為在不規則的時間 - 例如，時間間隔中的跳躍 - 可能會高估或低估滾動回歸中的系數，因為樣本窗口將包括額外的時間。

所以我想知道是否有人可以幫助我創建一個以最簡單的方式執行此操作的函數？ 該數據集基於隨時間測量變量，即 2 個變量： time和response 。 時間每隔x時間單位測量一次（秒、分鍾，所以不是日期/時間格式），但有時它會變得不規則。

對於函數中的每一行，它應該基於n 個時間單位的寬度執行線性回歸。 寬度不應超過n 個單位，但可以降低（即減少）以適應不規則的時間采樣。 例如，如果寬度指定為 20 秒，但時間每 6 秒采樣一次，則窗口將四舍五入為 18 秒，而不是 24 秒。

我看過這里的問題： 如何計算 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

Answer 2

為了完整起見，這里有一個使用data.table在 non-equi join 中聚合的答案。

盡管有許多類似的問題，例如， r 使用基於值（不是行數或日期/時間變量）的窗口計算滾動平均值，但由於 OP 正在尋找滾動回歸的系數，因此該問題本身就值得回答。

library(data.table)
ws <- 10   # size of sliding window in time units
setDT(sample)[.(start = x - ws, end = x), on = .(x > start, x <= end),
              as.list(coef(lm(y ~ x.x))), by = .EACHI]

 xx (Intercept) xx 1: -10 0 50.00000 NA 2: -9 1 50.00000 -1.0000000 3: -8 2 50.00000 -1.0000000 4: -7 3 50.00000 -1.0000000 5: -6 4 50.00000 -1.0000000 6: -5 5 49.61905 -0.7142857 7: -4 6 49.50000 -0.6428571 8: -3 7 49.50000 -0.6428571 9: -2 8 49.55556 -0.6666667 10: -1 9 49.63636 -0.6969697 11: 0 10 49.20000 -0.6000000 12: 1 11 48.88485 -0.5515152 13: 2 12 48.83636 -0.5515152 14: 3 13 49.20000 -0.6000000 15: 4 14 50.12121 -0.6969697 16: 5 15 49.20000 -0.6000000 17: 6 16 48.64242 -0.5515152 18: 7 17 48.59394 -0.5515152 19: 8 18 49.20000 -0.6000000 20: 9 19 50.60606 -0.6969697 21: 10 20 49.20000 -0.6000000 22: 11 21 48.40000 -0.5515152 23: 12 22 48.35152 -0.5515152 24: 13 23 49.20000 -0.6000000 25: 14 24 51.09091 -0.6969697 26: 15 25 49.20000 -0.6000000 27: 16 26 48.15758 -0.5515152 28: 17 27 48.10909 -0.5515152 29: 18 28 49.20000 -0.6000000 30: 19 29 51.57576 -0.6969697 31: 22 32 49.18487 -0.6050420 32: 23 33 50.13889 -0.6388889 33: 24 34 52.47170 -0.7169811 34: 25 35 48.97561 -0.5975610 35: 26 36 46.77358 -0.5283019 36: 27 37 45.75000 -0.5000000 37: 28 38 46.34454 -0.5210084 38: 29 39 50.57143 -0.6428571 39: 30 40 47.95556 -0.5666667 40: 31 41 47.43030 -0.5515152 41: 32 42 47.38182 -0.5515152 42: 33 43 49.20000 -0.6000000 43: 34 44 53.03030 -0.6969697 44: 37 47 49.26050 -0.6050420 45: 38 48 50.72222 -0.6388889 46: 39 49 54.22642 -0.7169811 xx (Intercept) xx

請注意，時間序列有規律地間隔的第 10 到 30 行與 OP 的rollme相同。

對as.list()的調用強制coef(lm(...))的結果出現在單獨的列中。

---

上面的代碼使用右對齊的滾動窗口。 但是，代碼也可以很容易地調整為支持左對齊窗口：

# left aligned window
setDT(sample)[.(start = x, end = x + ws), on = .(x >= start, x < end),
              as.list(coef(lm(y ~ x.x))), by = .EACHI]

Answer 3

使用runner可以在不規則的時間序列中應用任何 R 函數。 用戶必須將數據指定為x參數，並將日期向量指定為idx參數（以使 Windows 時間相關）。 窗口寬度k可以是整數k = 30或像 seq.POSIXt k = "30 secs"字符。

1. 第一個示例顯示如何從 lm 函數中獲取兩個參數 - 輸出將是一個矩陣

library(runner)

runner(
  x = sample,
  k = "30 secs",
  idx = sample$datetime,
  function(x) {
    coefficients(lm(y ~ x, data = x))
  }
)

2. 或者可以為每個參數單獨執行runner

library(runner)

sample$intercept <- runner(
  sample,
  k = "30 secs",
  idx = sample$datetime,
  function(x) {
    coefficients(lm(y ~ x, data = x))[1]
  }
)

sample$slope <- runner(
  sample,
  k = "30 secs",
  idx = sample$datetime,
  function(x) {
    coefficients(lm(y ~ x, data = x))[2]
  }
)

head(sample, 15)

#               datetime  x  y intercept      slope
# 1  2020-04-13 09:27:20  0 50  50.00000         NA
# 2  2020-04-13 09:27:21  1 49  50.00000 -1.0000000
# 3  2020-04-13 09:27:25  2 48  50.00000 -1.0000000
# 4  2020-04-13 09:27:29  3 47  50.00000 -1.0000000
# 5  2020-04-13 09:27:29  4 46  50.00000 -1.0000000
# 6  2020-04-13 09:27:32  5 47  49.61905 -0.7142857
# 7  2020-04-13 09:27:34  6 46  49.50000 -0.6428571
# 8  2020-04-13 09:27:38  7 45  49.50000 -0.6428571
# 9  2020-04-13 09:27:38  8 44  49.55556 -0.6666667
# 10 2020-04-13 09:27:41  9 43  49.63636 -0.6969697
# 11 2020-04-13 09:27:44 10 44  49.45455 -0.6363636
# 12 2020-04-13 09:27:47 11 43  49.38462 -0.6153846
# 13 2020-04-13 09:27:48 12 42  49.38462 -0.6153846
# 14 2020-04-13 09:27:49 13 41  49.42857 -0.6263736
# 15 2020-04-13 09:27:50 14 40  49.34066 -0.6263736

---

帶有日期時間列的數據

sample <- structure(
  list(
    datetime = c(3, 1, 4, 4, 0, 3, 2, 4, 0, 3, 3, 3, 1, 1, 1, 3, 0, 2, 4, 2, 2, 
                 3, 0, 1, 2, 4, 0, 1, 4, 4, 1, 2, 1, 3, 0, 4, 4, 1, 3, 0, 0, 2, 
                 1, 0, 2, 0) + Sys.time(),
    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)
)