Pregunta

¿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 zoo rollapply no funcionaría.A continuación se muestra un ejemplo que utiliza un bucle for ingenuo:

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))]
}
¿Fue útil?

Solución

data.table Actualmente, no tiene ninguna característica especial para ventanas móviles.Más detalles aquí en mi respuesta a otra pregunta similar aquí:

Hay una rápido ¿Manera de ejecutar una regresión continua dentro de data.table?

La mediana móvil es interesante.Se necesitaría una función especializada para hacerlo de manera eficiente (mismo enlace que en el comentario anterior):

Algoritmo de mediana móvil en C

El data.table Las soluciones en las preguntas y respuestas aquí son todas muy ineficientes, en relación con una adecuada especializada. rollingmedian función (que no está disponible para R afaik).

Otros consejos

Me las arreglé para reducir el ejemplo a 1.4s creando un conjunto de datos retrasado 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")]

que funciona bastante bien en este conjunto de datos de prueba, pero en mi real, falla con 8 GB de RAM.Voy a intentar avanzar a una de las instancias de alta memoria EC2 (con 17, 34 o 68 GB RAM) para que funcione.Cualquier idea sobre cómo hacer esto en una forma más inteligente de memoria sería apreciada

Esta solución funciona pero toma 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)

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top