增长矢量化

Question

我正在寻找通过在 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，这是我试图避免的，之后不能简单地删除（编辑：显然他们可以，请参阅下面的答案！）

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

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

但这对于大桌子来说需要很长时间。有没有办法使用条件而不需要如此广泛地循环？

Answer 1

您可以通过在单个矢量化操作中执行整个计算来加快这一速度（每当您除以 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 倍的加速。

Answer 2

这里有几种方法：

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