Rlag/lead不规则时间序列数据
R lag/lead irregular time series data
我有不规则的时间序列数据框,其中包含 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 的新手,所以这段代码可能有很多问题。它有什么可以改进的地方吗?
你可以试试:
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
你要的不清楚,给个伪代码或者公式。看起来这就是你想要的......
据我了解,最后一个值应该是 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]
这应该适用于您的数据。如果你想做一个通用的函数,你将不得不使用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) )
collapse::flag
支持不规则时间序列和面板的快速滞后,另见我的回答。要获得准确的结果,您必须使用 data.table::nafill
等带有选项 "locf"
的函数来填充 flag
引入的缺失值。与之前建议的方案相比,这两个功能的组合可能是最简约和最有效的解决方案。
我有不规则的时间序列数据框,其中包含 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 的新手,所以这段代码可能有很多问题。它有什么可以改进的地方吗?
你可以试试:
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
你要的不清楚,给个伪代码或者公式。看起来这就是你想要的...... 据我了解,最后一个值应该是 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]
这应该适用于您的数据。如果你想做一个通用的函数,你将不得不使用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) )
collapse::flag
支持不规则时间序列和面板的快速滞后,另见我的回答data.table::nafill
等带有选项 "locf"
的函数来填充 flag
引入的缺失值。与之前建议的方案相比,这两个功能的组合可能是最简约和最有效的解决方案。