Я ищу более эффективный способ изменения данных. Табличные данные в R.
В настоящий момент я перехожу, чтобы выполнить повторную форму нескольких предсказаний временных рядов.
Я получаю правильный ответ, который мне нужен, однако считаю, что методология очень неэлегантна /(un-data.table). Поэтому я ищу сообщество SO, чтобы узнать, есть ли более элегантное решение.
Ниже приведены настройки данных, а также две попытки получить желаемый ответ.
# load libraries
require(data.table)
require(lubridate)
# set up data assumptions
id_vec <- letters
len_id_vec <- length(id_vec)
num_orig_dates <- 7
set.seed(123)
# create original data frame
orig <- data.table(ID=rep(id_vec,each=num_orig_dates),
date=rep(c(Sys.Date() %m+% months(0: (num_orig_dates-1))),times=len_id_vec),
most_recent_bal=unlist(lapply(round(runif(len_id_vec)*100),function(y){
y*cumprod(1+rnorm(num_orig_dates,0.001,0.002))})))
# add 24 months ahead predictions of balances using a random walk from the original dates
nrow_orig <- nrow(orig)
for(i in seq(24)){
orig[,paste0('pred',i,'_bal'):=most_recent_bal*(1+rnorm(nrow_orig,0.001,0.003))]
orig[,paste0('pred',i,'_date'):=date %m+% months(i)]
}
# First attempt
t0 <- Sys.time()
tmp1 <- rbindlist(lapply(unique(orig$ID),function(x){
orig1 <- orig[ID==x,]
bal_cols <- c('most_recent_bal',paste0('pred',seq(24),'_bal'))
date_cols <- c('date',paste0('pred',seq(24),'_date'))
# Go through each original date to realign predicted date and predicted balance
date_vec <- orig1$date
tmp <- rbindlist(lapply(date_vec,function(y){
tmp <- data.table(dates=as.Date(as.vector(t(orig1[date==y,date_cols,with=FALSE]))),
bals=as.vector(t(orig1[date==y,bal_cols,with=FALSE])))
tmp[,type:='prediction']
tmp[,date_prediction_run:=y]
# collect historical information too for plotting perposes.
tmp1 <- orig1[date<=y,c('date','most_recent_bal'),with=FALSE]
if(nrow(tmp1)!=0){
setnames(tmp1,c('date','most_recent_bal'),c('dates','bals'))
tmp1[,type:='history']
tmp1[,date_prediction_run:=y]
tmp <- rbind(tmp,tmp1)
}
tmp
}))
tmp[,ID:=x]
}))
t1 <- Sys.time()
t1-t0 #Time difference of 1.117216 secs
# Second Attempt: a slightly more data.table way which is faster but still very inelegant....
t2 <- Sys.time()
bal_cols <- c('most_recent_bal',paste0('pred',seq(24),'_bal'))
date_cols <- c('date',paste0('pred',seq(24),'_date'))
tmp1a <- rbindlist(lapply(unique(orig$ID),function(x){
tmp <- cbind(melt(orig[ID==x,c('date',bal_cols),with=FALSE],
measure.vars = bal_cols,value.name='bals')[,-('variable'),with=FALSE],
data.table(dates=melt(orig[ID==x,date_cols,with=FALSE],
measure.vars = date_cols)[,value]))
setnames(tmp,'date','date_prediction_run')
tmp[,type:='prediction']
tmp1 <- orig[ID==x,orig[ID==x & date<=.BY,c('date','most_recent_bal'),with=FALSE],by=date]
setnames(tmp1,c('date_prediction_run','dates','bals'))
tmp1[,type:='history']
setcolorder(tmp1,colnames(tmp1)[match(colnames(tmp),colnames(tmp1))])
tmp <- rbind(tmp,tmp1)
tmp[,ID:=x]
tmp
}))
t3 <- Sys.time()
t3-t2 # Time difference of 0.2309799 secs