增长向量化

Vectorization of growth

我正在寻找一种通过在 R 中应用矢量化来实现以下简单增长率公式的解决方案:

gr <- function(x){
a <- matrix(,nrow=nrow(x),ncol=ncol(x))
   for (j in 1:ncol(x)){
      for (i in 2:nrow(x)){
        if (!is.na(x[i,j]) & !is.na(x[i-1,j]) & x[i-1,j] != 0){
           result[i,j] <- x[i,j]/x[i-1,j]-1 
        }
       }
    }
return(a)
}

我发现 xts 包可以生成时间序列的滞后,但最后我总是不得不与许多值进行比较(见上文),所以我不能简单地使用 ifelse。一个可能的问题是时间序列(例如价格指数)之间有零。这将在结果中创建 NaNs,我试图避免这种情况,并且之后不能简单地删除它(编辑:显然他们可以,请参阅下面的答案!)

简而言之:我想为给定的 table 值生成 table 的正确增长率。这是一个例子:

m <- matrix(c(1:3,NA,2.4,2.8,3.9,0,1,3,0,2,1.3,2,NA,7,3.9,2.4),6,3)

生成:

      [,1] [,2] [,3]
[1,]  1.0  3.9  1.3
[2,]  2.0  0.0  2.0
[3,]  3.0  1.0   NA
[4,]   NA  3.0  7.0
[5,]  2.4  0.0  3.9
[6,]  2.8  2.0  2.4

正确的结果,由gr(m)产生:

           [,1] [,2]       [,3]
[1,]        NA   NA         NA
[2,] 1.0000000   -1  0.5384615
[3,] 0.5000000   NA         NA
[4,]        NA    2         NA
[5,]        NA   -1 -0.4428571
[6,] 0.1666667   NA -0.3846154

但是如果 table 很大,这需要很长时间。有没有什么方法可以在不循环的情况下使用条件?

您可以通过在单个矢量化运算中执行整个计算来加快计算速度(每当除以 0 时,都需要一个额外的运算来修正结果):

out <- rbind(NA, tail(m, -1) / head(m, -1) - 1)
out[!is.finite(out)] <- NA
out
#           [,1] [,2]       [,3]
#             NA   NA         NA
# [2,] 1.0000000   -1  0.5384615
# [3,] 0.5000000   NA         NA
# [4,]        NA    2         NA
# [5,]        NA   -1 -0.4428571
# [6,] 0.1666667   NA -0.3846154

这比循环解决方案快得多,如 1000 x 1000 示例所示:

set.seed(144)
m <- matrix(rnorm(10000000), 10000, 1000)
system.time(j <- josilber(m))
#    user  system elapsed 
#   1.425   0.030   1.446 
system.time(g <- gr(m))
#    user  system elapsed 
#  34.551   0.263  36.581 

矢量化解决方案提供了 25 倍的加速。

这里有几种方法:

1) 没有包裹

rbind(NA, exp(diff(log(m)))-1)

给予:

          [,1] [,2]       [,3]
[1,]        NA   NA         NA
[2,] 1.0000000   -1  0.5384615
[3,] 0.5000000  Inf         NA
[4,]        NA    2         NA
[5,]        NA   -1 -0.4428571
[6,] 0.1666667  Inf -0.3846154

如果第一行 NA 不重要,那么可以简化为 exp(diff(log(m)))-1 .

2) zoo 另一种方法是使用zoo的geomemtric diff函数。转换为动物园,取几何差异并减去 1。如果第一行 NA 很重要,则将其与具有原始时间点的零宽度系列合并(否则省略合并语句,仅使用 g 作为答案):

library(zoo)

zm <- as.zoo(m)
g <- diff(zm, arithmetic = FALSE) - 1
merge(g, zoo(, time(zm))) # omit this line if 1st row of NAs not needed

giving:

        g.1 g.2        g.3
1        NA  NA         NA
2 1.0000000  -1  0.5384615
3 0.5000000 Inf         NA
4        NA   2         NA
5        NA  -1 -0.4428571
6 0.1666667 Inf -0.3846154