R data.table sliding window

Question

¿Cuál es la mejor forma (más rápida) de implementar una función de ventana deslizante con el paquete data.table?

Estoy tratando de calcular una mediana móvil pero tengo varias filas por fecha (debido a 2 factores adicionales), lo que creo que significa que la función rollapply del zoológico no funcionaría. Aquí hay un ejemplo usando un ingenuo para bucle:

library(data.table) 
df <- data.frame(
    id=30000, 
    date=rep(as.IDate(as.IDate("2012-01-01")+0:29, origin="1970-01-01"), each=1000), 
    factor1=rep(1:5, each=200), 
    factor2=1:5, 
    value=rnorm(30, 100, 10) 
) 

dt = data.table(df) 
setkeyv(dt, c("date", "factor1", "factor2")) 

get_window <- function(date, factor1, factor2) { 
    criteria <- data.table(
    date=as.IDate((date - 7):(date - 1), origin="1970-01-01"), 
    factor1=as.integer(factor1), 
    factor2=as.integer(factor2) 
) 
    return(dt[criteria][, value]) 
} 

output <- data.table(unique(dt[, list(date, factor1, factor2)]))[, window_median:=as.numeric(NA)] 

for(i in nrow(output):1) { 
    print(i) 
    output[i, window_median:=median(get_window(date, factor1, factor2))] 
} 

Answer 1

data.table no tiene ninguna característica especial para ventanas rodantes, actualmente. Más detalle aquí en mi respuesta a otra pregunta similar aquí:

Is there a fast way to run a rolling regression inside data.table?

mediana de rodadura es interesante. Se necesitaría una función especializada que hacer de manera eficiente (mismo enlace que en el comentario anterior):

Rolling median algorithm in C

Los data.table soluciones en la pregunta y respuestas aquí son todos muy ineficiente, con relación a una adecuada función especializada rollingmedian (que no está disponible para R afaik).

Answer 2

Esta solución funciona, pero lleva un tiempo.

df <- data.frame(
    id=30000, 
    date=rep(seq.Date(from=as.Date("2012-01-01"),to=as.Date("2012-01-30"),by="d"),each=1000), 
    factor1=rep(1:5, each=200), 
    factor2=1:5, 
    value=rnorm(30, 100, 10) 
) 

myFun <- function(dff,df){ 
    median(df$value[df$date>as.Date(dff[2])-8 & df$date<as.Date(dff[2])-1 & df$factor1==dff[3] & df$factor2==dff[4]]) 
} 

week_Med <- apply(df,1,myFun,df=df) 

week_Med_df <- cbind(df,week_Med) 

Answer 3

Me las arreglé para obtener el ejemplo en 1.4s creando un conjunto de datos rezagado y haciendo una gran unión.

df <- data.frame(
    id=30000, 
    date=rep(as.IDate(as.IDate("2012-01-01")+0:29, origin="1970-01-01"), each=1000), 
    factor1=rep(1:5, each=200), 
    factor2=1:5, 
    value=rnorm(30, 100, 10) 
) 

dt2 <- data.table(df) 
setkeyv(dt, c("date", "factor1", "factor2")) 

unique_set <- data.table(unique(dt[, list(original_date=date, factor1, factor2)])) 
output2 <- data.table() 
for(i in 1:7) { 
    output2 <- rbind(output2, unique_set[, date:=original_date-i]) 
}  

setkeyv(output2, c("date", "factor1", "factor2")) 
output2 <- output2[dt] 
output2 <- output2[, median(value), by=c("original_date", "factor1", "factor2")] 

Eso funciona bastante bien en este conjunto de datos de prueba pero en mi real falla con 8 GB de RAM. Voy a intentar moverme a una de las instancias de High Memory EC2 (con 17, 34 o 68 GB de RAM) para que funcione. Cualquier idea sobre cómo hacer esto de una manera menos intensiva en memoria sería apreciada