Fenêtre coulissante R data.table

Question

Quel est le meilleur moyen (le plus rapide) d'implémenter une fonction de fenêtre coulissante avec le package data.table ?

J'essaie de calculer une médiane mobile mais j'ai plusieurs lignes par date (en raison de 2 facteurs supplémentaires), ce qui, je pense, signifie que la fonction zoo rollapply ne fonctionnerait pas.Voici un exemple utilisant une boucle for naïve :

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 n'a actuellement aucune fonctionnalité spéciale pour les fenêtres déroulantes.Plus de détails ici dans ma réponse à une autre question similaire ici :

Y a-t-il un rapide comment exécuter une régression continue dans data.table ?

La médiane mobile est intéressante.Il faudrait une fonction spécialisée pour le faire efficacement (même lien que dans le commentaire précédent) :

Algorithme médian roulant en C

Le data.table les solutions dans les questions et réponses ici sont toutes très inefficaces, par rapport à un système spécialisé approprié. rollingmedian fonction (qui n'est pas disponible pour R afaik).

Answer 2

J'ai réussi à obtenir l'exemple jusqu'à 1.4s en créant un jeu de données décalé et en faisant une énorme jointure.

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")]

Cela fonctionne assez bien sur cet ensemble de données de test, mais sur mon vrai, il échoue avec 8 Go de RAM.Je vais essayer de passer à l'une des instances EC2 haute mémoire (avec 17, 34 ou 68 Go de RAM) pour le faire fonctionner.Toutes les idées sur la manière de faire cela de manière moins intensive de mémoire seraient appréciées

Answer 3

Cette solution fonctionne mais cela prend un moment.

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)