R: utilizzando data.table: = operazioni per calcolare nuove colonne

Question

Prendiamo i seguenti dati:

dt <- data.table(TICKER=c(rep("ABC",10),"DEF"), 
     PERIOD=c(rep(as.Date("2010-12-31"),10),as.Date("2011-12-31")), 
     DATE=as.Date(c("2010-01-05","2010-01-07","2010-01-08","2010-01-09","2010-01-10","2010-01-11","2010-01-13","2010-04-01","2010-04-02","2010-08-03","2011-02-05")), 
     ID=c(1,2,1,3,1,2,1,1,2,2,1),VALUE=c(1.5,1.3,1.4,1.6,1.4,1.2,1.5,1.7,1.8,1.7,2.3)) 
setkey(dt,TICKER,PERIOD,ID,DATE) 

Ora, per ogni combinazione ticker/periodo, ho bisogno di quanto segue in una nuova colonna:

• PRIORAVG: la media dell'ultimo VALORE di ciascun ID, escluso l'ID corrente, a condizione che non abbia più di 180 giorni.
• PREV: il valore precedente dello stesso ID.

Il risultato dovrebbe apparire così:

 TICKER  PERIOD  DATE ID VALUE PRIORAVG PREV 
[1,] ABC 2010-12-31 2010-01-05 1 1.5  NA NA 
[2,] ABC 2010-12-31 2010-01-08 1 1.4  1.30 1.5 
[3,] ABC 2010-12-31 2010-01-10 1 1.4  1.45 1.4 
[4,] ABC 2010-12-31 2010-01-13 1 1.5  1.40 1.4 
[5,] ABC 2010-12-31 2010-04-01 1 1.7  1.40 1.5 
[6,] ABC 2010-12-31 2010-01-07 2 1.3  1.50 NA 
[7,] ABC 2010-12-31 2010-01-11 2 1.2  1.50 1.3 
[8,] ABC 2010-12-31 2010-04-02 2 1.8  1.65 1.2 
[9,] ABC 2010-12-31 2010-08-03 2 1.7  1.70 1.8 
[10,] ABC 2010-12-31 2010-01-09 3 1.6  1.35 NA 
[11,] DEF 2011-12-31 2011-02-05 1 2.3  NA NA 

Nota la PRIORAVG nel braccio 9 è uguale a 1.7 (che è uguale al VALUE nel braccio 5, che è l'unica osservazione preliminare in passato 180 giorni da un altro ID)

Ho scoperto il pacchetto data.table, ma non riesco a capire completamente la funzione :=. Quando lo tengo semplice, sembra funzionare. Per ottenere il valore precedente per ogni ID (ho basato questo sulla soluzione a this question):

dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),roll=TRUE,mult="last"][,VALUE]] 

Questa grande opera, e richiede solo 0,13 secondi per eseguire questa operazione sul mio insieme di dati con ~ 250k righe; la mia funzione di scansione vettoriale ottiene risultati identici ma è circa 30.000 volte più lenta.

Ok, quindi ho il mio primo requisito. Andiamo al secondo requisito più complesso. In questo momento il metodo a digiuno finora per me sta usando un paio di scansioni vettoriali e lanciando la funzione attraverso la funzione plyradply per ottenere il risultato per ogni riga.

calc <- function(df,ticker,period,id,date) { 
    df <- df[df$TICKER == ticker & df$PERIOD == period 
     & df$ID != id & df$DATE < date & df$DATE > date-180, ] 
    df <- df[order(df$DATE),] 
    mean(df[!duplicated(df$ID, fromLast = TRUE),"VALUE"]) 
} 

df <- data.frame(dt) 
adply(df,1,function(x) calc(df,x$TICKER,x$PERIOD,x$ID,x$DATE)) 

ho scritto la funzione per un data.frame e non sembra di lavorare con un data.table. Per un sottoinsieme di 5000 righe ci vogliono circa 44 secondi ma i miei dati sono formati da> 1 milione di righe. Mi chiedo se questo può essere reso più efficiente attraverso l'utilizzo di :=.

dt[J("ABC"),last(VALUE),by=ID][,mean(V1)] 

Questo funziona per selezionare la media degli ultimi VALUE per ciascun ID per ABC.

dt[,PRIORAVG:=dt[J(TICKER,PERIOD),last(VALUE),by=ID][,mean(V1)]] 

Questo, tuttavia, non funziona come previsto, come prende la media di tutti i valori per tutte le ultime ticker/periodi anziché soltanto per i ticker/periodo. Quindi finisce con tutte le righe con lo stesso valore medio. Sto facendo qualcosa di sbagliato o si tratta di una limitazione di :=?

Answer 1

Ottima domanda. Prova questo:

dt 
    TICKER  PERIOD  DATE ID VALUE 
[1,] ABC 2010-12-31 2010-01-05 1 1.5 
[2,] ABC 2010-12-31 2010-01-08 1 1.4 
[3,] ABC 2010-12-31 2010-01-10 1 1.4 
[4,] ABC 2010-12-31 2010-01-13 1 1.5 
[5,] ABC 2010-12-31 2010-01-07 2 1.3 
[6,] ABC 2010-12-31 2010-01-11 2 1.2 
[7,] ABC 2010-12-31 2010-01-09 3 1.6 
[8,] DEF 2011-12-31 2011-02-05 1 2.3 

ids = unique(dt$ID) 
dt[,PRIORAVG:=NA_real_] 
for (i in 1:nrow(dt)) 
    dt[i,PRIORAVG:=dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]), 
         mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"]] 
dt 
    TICKER  PERIOD  DATE ID VALUE PRIORAVG 
[1,] ABC 2010-12-31 2010-01-05 1 1.5  NA 
[2,] ABC 2010-12-31 2010-01-08 1 1.4  1.30 
[3,] ABC 2010-12-31 2010-01-10 1 1.4  1.45 
[4,] ABC 2010-12-31 2010-01-13 1 1.5  1.40 
[5,] ABC 2010-12-31 2010-01-07 2 1.3  1.50 
[6,] ABC 2010-12-31 2010-01-11 2 1.2  1.50 
[7,] ABC 2010-12-31 2010-01-09 3 1.6  1.35 
[8,] DEF 2011-12-31 2011-02-05 1 2.3  NA 

Poi quello che avevi già con una leggera semplificazione ...

dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),VALUE,roll=TRUE,mult="last"]] 

    TICKER  PERIOD  DATE ID VALUE PRIORAVG PREV 
[1,] ABC 2010-12-31 2010-01-05 1 1.5  NA NA 
[2,] ABC 2010-12-31 2010-01-08 1 1.4  1.30 1.5 
[3,] ABC 2010-12-31 2010-01-10 1 1.4  1.45 1.4 
[4,] ABC 2010-12-31 2010-01-13 1 1.5  1.40 1.4 
[5,] ABC 2010-12-31 2010-01-07 2 1.3  1.50 NA 
[6,] ABC 2010-12-31 2010-01-11 2 1.2  1.50 1.3 
[7,] ABC 2010-12-31 2010-01-09 3 1.6  1.35 NA 
[8,] DEF 2011-12-31 2011-02-05 1 2.3  NA NA 

Se questo va bene come un prototipo poi una grande miglioramento della velocità sarebbe quello di mantenere il ciclo, ma utilizzare set() invece di :=, per ridurre le spese generali:

for (i in 1:nrow(dt)) 
    set(dt,i,6L,dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]), 
        mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"]) 
dt 
    TICKER  PERIOD  DATE ID VALUE PRIORAVG PREV 
[1,] ABC 2010-12-31 2010-01-05 1 1.5  NA NA 
[2,] ABC 2010-12-31 2010-01-08 1 1.4  1.30 1.5 
[3,] ABC 2010-12-31 2010-01-10 1 1.4  1.45 1.4 
[4,] ABC 2010-12-31 2010-01-13 1 1.5  1.40 1.4 
[5,] ABC 2010-12-31 2010-01-07 2 1.3  1.50 NA 
[6,] ABC 2010-12-31 2010-01-11 2 1.2  1.50 1.3 
[7,] ABC 2010-12-31 2010-01-09 3 1.6  1.35 NA 
[8,] DEF 2011-12-31 2011-02-05 1 2.3  NA NA 

che dovrebbe essere molto più veloce di le scansioni vettoriali ripetute mostrate nella domanda.

Oppure l'operazione può essere vettorializzata. Ma sarebbe meno facile scrivere e leggere a causa delle funzionalità di questa attività.

Btw, non ci sono dati nella domanda che verifichino il requisito di 180 giorni. Se ne aggiungi qualcuno e visualizzi di nuovo l'output previsto, aggiungerò il calcolo dell'età utilizzando l'ambito ereditato di join che ho menzionato nei commenti.