首页 文章

R lag / lead不规则时间序列数据

提问于
浏览
1

我有不规则的时间序列数据框,有 time (秒)和 value 列 . 我想添加另一列 value_2 ,其中值由 delay 秒引导 . 所以 value_2 在时间 t 等于 valuet + 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很新,所以这段代码可能有很多问题 . 有什么可以改进的?

3 回答

  • 0

    你想要的不清楚,给出一个伪代码或一个公式 . 它看起来像你想要的......根据我的理解,你的最后一个值应该是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]
    
  • 0

    你可以尝试:

    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
    
  • 2

    这应该适用于您的数据 . 如果你想做一个普通的功能,你将不得不玩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) )
    

相关问题