我正在尝试获取基于滞后/转发的功能应用程序。我广泛使用data.table
,我什至有工作代码,但是知道data.table
我认为必须有一种更简单的方法来实现同样的功能,并可能提高性能(我在函数内部创建了很多变量)。以下是函数的工作代码(可在https://gist.github.com/tomaskrehlik/5262087#file-gistfile1-r中获得)
# Lag-function lags the given variable by the date_variable
lag_variable <- function(data, variable, lags, date_variable = c("Date")) {
if (lags == 0) {
return(data)
}
if (lags>0) {
name <- "lag"
} else {
name <- "forward"
}
require(data.table)
setkeyv(data, date_variable)
if (lags>0) {
data[,index:=seq(1:.N)]
} else {
data[,index:=rev(seq(1:.N))]
}
setkeyv(data, "index")
lags <- abs(lags)
position <- which(names(data)==variable)
for ( j in 1:lags ) {
lagname <- paste(variable,"_",name,j,sep="")
lag <- paste("data[, ",lagname,":=data[list(index-",j,"), ",variable,", roll=TRUE][[",position,"L]]]", sep = "")
eval(parse( text = lag ))
}
setkeyv(data, date_variable)
data[,index:=NULL]
}
# window_func applies the function to the lagged or forwarded variables created by lag_variable
window_func <- function(data, func.name, variable, direction = "window", steps, date_variable = c("Date"), clean = TRUE) {
require(data.table)
require(stringr)
transform <- match.fun(func.name)
l <- length(names(data))
if (direction == "forward") {
lag_variable(data, variable, -steps, date_variable)
cols <- which((!(is.na(str_match(names(a), paste(variable,"_forward(",paste(1:steps,collapse="|"),")",sep=""))[,1])))*1==1)
} else {
if (direction == "backward") {
lag_variable(data, variable, steps, date_variable)
cols <- which((!(is.na(str_match(names(a), paste(variable,"_lag(",paste(1:steps,collapse="|"),")",sep=""))[,1])))*1==1)
} else {
if (direction == "window") {
lag_variable(data, variable, -steps, date_variable)
lag_variable(data, variable, steps, date_variable)
cols <- which((!(is.na(str_match(names(a), paste(variable,"_lag(",paste(1:steps,collapse="|"),")",sep=""))[,1])))*1==1)
cols <- c(cols,which((!(is.na(str_match(names(a), paste(variable,"_forward(",paste(1:steps,collapse="|"),")",sep=""))[,1])))*1==1))
} else {
stop("The direction must be either backward, forward or window.")
}
}
}
data[,transf := apply(data[,cols, with=FALSE], 1, transform)]
if (clean) {
data[,cols:=NULL,with=FALSE]
}
return(data)
}
# Typical use:
# I have a data.table DT with variables Date (class IDate), value1, value2
# I want to get cumulative sum of next five days
# window_func(DT, "sum", "value1", direction = "forward", steps = 5)
编辑:示例数据可以通过以下方式创建:
a <- data.table(Date = 1:1000, value = rnorm(1000))
对于每个 Date (这里是整数只是一个例子,并不重要),我想创建下十个观察值的总和。要运行代码并获取输出,请执行以下操作:
window_func(data = a, func.name = "sum", variable = "value",
direction = "forward", steps = 10, date_variable = "Date", clean = TRUE)
该函数首先获取变量并创建十个滞后变量(使用 function lag_variable
),然后按列应用函数并自行清理。代码很臃肿,因为我有时只需要在滞后观察上使用函数,有时在前向观察上使用函数,有时在两者上都使用函数,这称为窗口。
有什么建议可以更好地实施吗?我的代码似乎太大了。