R lag/lead нерегулярные временные ряды данные

Question

У меня есть нерегулярные временные рамки данных с 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, поэтому у этого кода, вероятно, много проблем. Что можно улучшить по этому поводу?

Answer 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 

Answer 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] 

Answer 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))