R 滞后/超前不规则时间序列数据答案

【问题标题】：R lag/lead irregular time series dataR 滞后/超前不规则时间序列数据
【发布时间】：2016-04-20 19:50:32
【问题描述】：

我有带有time（秒）和value 列的不规则时间序列数据框。我想添加另一列value_2，其中值以delay 秒为单位。所以value_2 在时间t 等于value 在时间t + delay 或之后。

ts=data.frame(
  time=c(1,2,3,5,8,10,11,15,20,23),
  value=c(1,2,3,4,5,6,7,8,9,10)
)

ts_with_delayed_value <- add_delayed_value(ts, "value", 2, "time")

> ts_with_delayed_value
   time value value_2
1     1     1       3
2     2     2       4
3     3     3       4
4     5     4       5
5     8     5       6
6    10     6       8
7    11     7       8
8    15     8       9
9    20     9      10
10   23    10      10

我有我自己版本的这个函数add_delayed_value，这里是：

add_delayed_value <- function(data, colname, delay, colname_time) {
  colname_delayed <- paste(colname, sprintf("%d", delay), sep="_")
  data[colname_delayed] <- NaN

  for (i in 1:nrow(data)) {
    time_delayed <- data[i, colname_time] + delay
    value_delayed <- data[data[colname_time] >= time_delayed, colname][1]
    if (is.na(value_delayed)) {
      value_delayed <- data[i, colname]
    }
    data[i, colname_delayed] <- value_delayed
  }

  return(data)
}

有没有办法对这个例程进行矢量化以避免慢循环？

我对 R 很陌生，所以这段代码可能有很多问题。有什么可以改进的地方？

【问题讨论】：

给我们delayed_value的公式
@statquant：我刚刚更新了问题。

标签： r vectorization lag lead

【解决方案1】：

你可以试试：

library(dplyr)
library(zoo)
na.locf(ts$value[sapply(ts$time, function(x) min(which(ts$time - x >=2 )))])
[1]  3  4  4  5  6  8  8  9 10 10

【讨论】：

当min 占用一个空列时，这会爆炸。对于最新的时间条目，以下将返回一个空列：which(ts$time - latest_time >= 2)。这对您有何帮助？
哦，没关系 - 这只是一条警告信息。它确实奏效了。
话虽如此，当min 收到来自which 的空列时，是否可以静音？ > min(c()) 警告消息：在 min(c()) 中：min 没有非缺失参数；返回 Inf
另外，这种依赖library(dplyr) 也不是必须的，对吧？

【解决方案2】：

你要什么不清楚，给个伪代码或者公式。看起来这就是你想要的...... 据我了解，最后一个值应该是 NA

library(data.table)
setDT(ts,key='time')
ts_delayed = ts[,.(time_delayed=time+2)]
setkey(ts_delayed,time_delayed)
ts[ts_delayed,roll=-Inf]

【讨论】：

我没有读过这个问题，但如果这是答案，我猜 data.table 不需要。顺便说一句，您可能不想要dt = setDT(df)，因为现在dt 和df 是同一个对象。 set* 通过引用修改。
或：ts[, value2 := ts[.(time=time+2L), value, roll=-Inf, rollends=TRUE, mult="first", on="time"]]
大声笑刚刚得到“阿鲁内德”

【解决方案3】：

这应该适用于您的数据。如果你想创建一个通用函数，你将不得不使用lazyeval，老实说这可能不值得。

library(dplyr)
library(zoo)

carry_back = . %>% na.locf(na.rm = TRUE, fromLast = FALSE)


data_frame(time = 
             with(ts, 
                  seq(first(time), 
                      last(time) ) ) ) %>%
  left_join(ts) %>%
  transmute(value_2 = carry_back(value),
            time = time - delay) %>%
  right_join(ts) %>%
  mutate(value_2 = 
           value_2 %>%
           is.na %>%
           ifelse(last(value), value_2) )

【讨论】：

【解决方案4】：

collapse::flag支持不规则时间序列和面板的快速滞后，另见我的回答here。要获得准确的结果，您必须使用 data.table::nafill 和选项 "locf" 之类的函数来填充 flag 引入的缺失值。与之前的建议相比，这两个功能的组合可能是最简洁和最有效的解决方案。

【讨论】：