Encontrar lag en el que la correlación cruzada es máxima ccf()

Question

Tengo 2 series de tiempo y estoy usando ccf para encontrar la correlación cruzada entre ellas. ccf(ts1, ts2) enumera las correlaciones cruzadas para todos los retardos de tiempo. ¿Cómo puedo encontrar el retraso que da como resultado la máxima correlación sin mirar manualmente los datos?

Answer 1

Publicación de la respuesta http://r.789695.n4.nabble.com/ccf-function-td2288257.html

Find_Max_CCF<- function(a,b) 
{ 
d <- ccf(a, b, plot = FALSE) 
cor = d$acf[,,1] 
lag = d$lag[,,1] 
res = data.frame(cor,lag) 
res_max = res[which.max(res$cor),] 
return(res_max) 
} 

Answer 2

que pensé en hacer de nuevo la función anterior, pero tenerlo encontrar la correlación máximo absoluto que devuelve la correlación originales (positivo o negativo). También llegué al máximo (casi) el número de retrasos.

Find_Abs_Max_CCF<- function(a,b) 
{ 
d <- ccf(a, b, plot = FALSE, lag.max = length(a)-5) 
cor = d$acf[,,1] 
abscor = abs(d$acf[,,1]) 
lag = d$lag[,,1] 
res = data.frame(cor,lag) 
absres = data.frame(abscor,lag) 
absres_max = res[which.max(absres$abscor),] 
return(absres_max) 
} 

Answer 3

He modificado la solución original, así, con el fin de bucle sobre la función y la salida de los valores correspondientes a un vector de caracteres de índices (x):

abs.max.ccf <- function(x,a,b) { 
    d <- ccf(a, b, plot=FALSE, lag.max=length(a)-5) 
    cor <- d$acf[,,1] 
    abscor <- abs(d$acf[,,1]) 
    lag <- d$lag[,,1] 
    abs.cor.max <- abscor[which.max(abscor)] 
    abs.cor.max.lag <- lag[which.max(abscor)] 
    return(c(x, abs.cor.max, abs.cor.max.lag)) 
} 

Quité el data.frame parte dentro de la función, ya que es innecesariamente lenta. Para un bucle sobre cada columna en un data.frame y devolver los resultados a un nuevo data.frame, utilizo este método:

max.ccf <- lapply(colnames(df), function(x) unlist(abs.max.ccf(x, df$y, df[x]))) 
max.ccf <- data.frame(do.call(rbind, max.ccf)) 
colnames(max.ccf) <- c('Index','Cor','Lag') 

Answer 4

Debido 3 es más de 4, también tenía una puñalada en la modificación de esta función, esta vez mediante la aplicación de una idea de here:

ccfmax <- function(a, b, e=0) 
{ 
d <- ccf(a, b, plot = FALSE, lag.max = length(a)/2) 
cor = d$acf[,,1] 
abscor = abs(d$acf[,,1]) 
lag = d$lag[,,1] 
res = data.frame(cor, lag) 
absres = data.frame(abscor, lag) 
maxcor = max(absres$abscor) 
absres_max = res[which(absres$abscor >= maxcor-maxcor*e & 
         absres$abscor <= maxcor+maxcor*e),] 
return(absres_max) 
} 

Esencialmente se añade un término "error", por lo que si hay varios valores cercanos al máximo, todos ellos consiguen devueltos, por ejemplo:

ayy <- jitter(cos((1:360)/5), 100) 
bee <- jitter(sin((1:360)/5), 100) 

ccfmax(ayy, bee, 0.02) 
      cor lag 
348 0.9778319 -8 
349 0.9670333 -7 
363 -0.9650827 7 
364 -0.9763180 8 

Si no se proporciona ningún valor para e, se toma como cero y la función se comporta como la publicada nvogen.