Wie rolling Kovarianz effizienter berechnen

Question

Ich versuche, eine rollende Kovarianz zwischen einer Reihe von Daten (jede Spalte meiner x-Variable) und einer anderen (y-Variable) in R zu berechnen. Ich dachte, ich könnte eine der anwenden Funktionen, aber nicht finden, wie zwei Sätze von Eingängen gleichzeitig rollen. Hier ist, was ich versucht habe:

set.seed(1) 
x<-matrix(rnorm(500),nrow=100,ncol=5) 
y<-rnorm(100) 
rollapply(x,width=5,FUN= function(x) {cov(x,y)}) 
z<-cbind(x,y) 
rollapply(z,width=5, FUN=function(x){cov(z,z[,6])}) 

Aber keiner tut, was ich möchte. Eine Lösung, die ich gefunden ist eine für Schleife zu verwenden, aber frage mich, ob ich in R effizienter sein kann als:

dResult<-matrix(nrow=96,ncol=5) 
for(iLine in 1:96){ 
    for(iCol in 1:5){ 
     dResult[iLine,iCol]=cov(x[iLine:(iLine+4),iCol],y[iLine:(iLine+4)]) 
    } 
} 

das gibt mir das erwartete Ergebnis:

head(dResult) 


      [,1]  [,2]  [,3]  [,4]  [,5] 
[1,] 0.32056460 0.05281386 -1.13283586 -0.01741274 -0.01464430 
[2,] -0.03246014 0.78631603 -0.34309778 0.29919297 -0.22243572 
[3,] -0.16239479 0.56372428 -0.27476604 0.39007645 0.05461355 
[4,] -0.56764687 0.09847672 0.11204244 0.78044096 -0.01980684 
[5,] -0.43081539 0.01904417 0.01282632 0.35550327 0.31062580 
[6,] -0.28890607 0.03967327 0.58307743 0.15055881 0.60704533 

Answer 1

set.seed(1) 
x<-as.data.frame(matrix(rnorm(500),nrow=100,ncol=5)) 
y<-rnorm(100) 

library(zoo) 

covResult = sapply(x,function(alpha) { 

cov_value = rollapply(cbind(alpha,y),width=5,FUN = function(beta) cov(beta[,1],beta[,2]),by.column=FALSE,align="right") 

return(cov_value) 

}) 

head(covResult) 
#    V1   V2   V3   V4   V5 
#[1,] 0.32056460 0.05281386 -1.13283586 -0.01741274 -0.01464430 
#[2,] -0.03246014 0.78631603 -0.34309778 0.29919297 -0.22243572 
#[3,] -0.16239479 0.56372428 -0.27476604 0.39007645 0.05461355 
#[4,] -0.56764687 0.09847672 0.11204244 0.78044096 -0.01980684 
#[5,] -0.43081539 0.01904417 0.01282632 0.35550327 0.31062580 
#[6,] -0.28890607 0.03967327 0.58307743 0.15055881 0.60704533 

Sie auch:

library(PerformanceAnalytics) 
?chart.rollingCorrelation 

Answer 2

Gerade jetzt ich M läuft einige lange Simulationen, also kann ich R nicht benutzen, aber denke, das sollte funktionieren. Die äußere Anwendung nach Spalten übernimmt die Spalte, übergibt sie an die Rolle, wo sie verwendet wird, um die rollierende Fensterkovarianz mit y zu erzeugen. Hoffentlich: D

apply(x,2,function(x) rollapply(x,width=5,function(z) cov(x,y))) 

Answer 3

Dies ist eine Lösung mit rollapply() und sapply():

sapply(1:5, function(j) rollapply(1:100, 5, function(i) cov(x[i, j], y[i]))) 

Ich denke, dass es besser lesbar und R-ish als die Lösung mit for-Schleifen, aber ich habe mit microbenchmark und es scheint langsamer zu sein.

Answer 4

Wenn Sie etwas schneller benötigen, und du nicht der Nicht-Standardargumente zu cov benötigen, können Sie TTR::runCov verwenden können. Beachten Sie, dass es standardmäßig mit NA vorangeht.

Die Geschwindigkeitsdifferenz spielt bei größeren Daten eine größere Rolle. Hier ist ein Beispiel dafür, wie es zu benutzen:

cov_joshua <- function() { 
    apply(x, 2, function(x, y) TTR::runCov(x, y, 5), y = y) 
} 

Und hier ist ein Vergleich mit der derzeit akzeptierten Antwort der kleine Datenmenge mit der OP zur Verfügung gestellt:

cov_osssan <- function() { 
    f <- function(b) cov(b[,1], b[,2]) 
    apply(x, 2, function(a) { 
    rollapplyr(cbind(a,y), width=5, FUN = f, by.column=FALSE) 
    }) 
} 
require(zoo) # for cov_osssan 
require(microbenchmark) 
set.seed(1) 
nr <- 100 
nc <- 5 
x <- matrix(rnorm(nc*nr),nrow=nr,ncol=nc) 
y <- rnorm(nr) 
microbenchmark(cov_osssan(), cov_joshua()) 
# Unit: milliseconds 
#   expr  min  lq median  uq  max neval 
# cov_osssan() 22.881253 24.569906 25.625623 27.44348 32.81344 100 
# cov_joshua() 5.841422 6.170189 6.706466 7.47609 31.24717 100 
all.equal(cov_osssan(), cov_joshua()[-(1:4),]) # rm leading NA 
# [1] TRUE 

nun einen größeren Datensatz mit:

system.time(cov_joshua()) 
# user system elapsed 
# 2.117 0.032 2.158 
system.time(cov_osssan()) 
# ^C 
# Timing stopped at: 144.957 0.36 145.491 

Ich war es müde zu warten (nach ~ 2,5 Minuten) für cov_osssan abzuschließen.