自相关图仅为负值

Question

我想在R中为一个时间序列的负值做一个acf图。我不能事先通过仅为负值对数据进行子集化来做到这一点，因为那时自相关将消除负值之间的任意数量的正天数并且是不合理的高，而是我想在整个时间运行自相关系列然后筛选出第一天给出的结果是否定的。

例如，理论上，我可以在数据帧中创建具有原始序列和所有滞后时间序列的数据帧，然后过滤原始序列中的负值，然后绘制相关性。但是，我想使用acf图自动执行此操作。

以下是我的时间序列示例：

> dput(exampleSeries)
c(0, 0, -0.000687, -0.004489, -0.005688, 0.000801, 0.005601, 
0.004546, 0.003451, -0.000836, -0.002796, 0.005581, -0.003247, 
-0.002416, 0.00122, 0.005337, -0.000195, -0.004255, -0.003097, 
0.000751, -0.002037, 0.00837, -0.003965, -0.001786, 0.008497, 
0.000693, 0.000824, 0.005681, 0.002274, 0.000773, 0.001141, 0.000652, 
0.001559, -0.006201, 0.000479, -0.002041, 0.002757, -0.000736, 
-2.1e-05, 0.000904, -0.000319, -0.000227, -0.006589, 0.000998, 
0.00171, 0.000271, -0.004121, -0.002788, -9e-04, 0.001639, 0.004245, 
-0.00267, -0.004738, 0.001192, 0.002175, 0.004666, 0.006005, 
0.001218, -0.003188, -0.004363, 0.000462, -0.002241, -0.004806, 
0.000463, 0.000795, -0.005715, 0.004635, -0.004286, -0.008908, 
-0.001044, -0.000842, -0.00445, -0.006094, -0.001846, 0.005013, 
-0.006599, 0.001914, 0.00221, 6.2e-05, -0.001391, 0.004369, -0.005739, 
-0.003467, -0.002103, -0.000882, 0.001483, 0.003074, 0.00165, 
-0.00035, -0.000573, -0.00316, -0.00102, -0.00144, 0.003421, 
0.005436, 0.001994, 0.00619, 0.005319, 7.3e-05, 0.004513)

Answer 1

我试图实现你的描述。

correl <- function(x, lag.max = 10){
  library(dplyr)
  m <- matrix(ncol = lag.max, nrow = length(x))
  for(i in 1:lag.max){
    m[,i] <- lag(x, i)
    }
  m <- m[x<0,]
  res <- apply(m, 2, function(y) cor(y, x[x<0], use = "complete.obs"))
  barplot(res)
}

correl(exampleSeries)

Answer 2

也许只是写自己的功能？类似的东西：

negativeACF <- function(x, num.lags = 10)
{
  n    <- length(x)
  acfs <- sapply(0:num.lags, function(i) cor(x[-i:-1], x[(-n-1+i):-n]))
  names(acfs) <- 0:num.lags
  acfs[acfs < 0]
}

results <- negativeACF(exampleSeries, num.lags=20)
barplot(results)

Answer 3

是的，我最终编写了自己的函数，只是用我自己的值替换R acf对象中的值，这些值只是相关性。所以：

genACF <- function(series, my.acf, lag.max = NULL, neg){

    x <- na.fail(as.ts(series))
    x.freq <- frequency(x)
    x <- as.matrix(x)
    if (!is.numeric(x)) 
        stop("'x' must be numeric")
    sampleT <- as.integer(nrow(x))
    nser <- as.integer(ncol(x))

    if (is.null(lag.max)) 
        lag.max <- floor(10 * (log10(sampleT) - log10(nser)))
    lag.max <- as.integer(min(lag.max, sampleT - 1L))
    if (is.na(lag.max) || lag.max < 0) 
        stop("'lag.max' must be at least 0")

    if(neg){

        indices <- which(series < 0)

    }else{

        indices <- which(series > 0)

    }

    series <- scale(series, scale = FALSE)  
    series.zoo <- zoo(series)
    for(i in 0:lag.max){

        lag.series <- lag(series.zoo, k = -i, na.pad = TRUE)
        temp.corr <- cor(series.zoo[indices], lag.series[indices], use = 'complete.obs', method = 'pearson')
        my.acf[i+1] <- temp.corr

    }
    my.acf[1] <- 0
    return(my.acf)

}

plotMyACF <- function(series, main, type = 'correlation', neg = TRUE){

    series.acf <- acf(series, plot = FALSE)
    my.acf <- genACF(series, series.acf$acf, neg = neg)
    series.acf$acf <- my.acf

    plot(series.acf, xlim = c(1, dim(series.acf$acf)[1] - (type == 'correlation')), xaxt = "n", main = main)
    if (dim(series.acf$acf)[1] < 25){

        axis(1, at = 1:(dim(series.acf$acf)[1] - 1))

    }else{

        axis(1)

    }

}

我得到的是这样的：