R：矩阵上的绝对滚动偏差（偏移量为 1）

Question

我有一个大型矩阵/数据框 (2500x20)，并且需要按列显示最大值的滚动偏差减去所有先前单元格的最小值 - 不包括当前单元格。

我按列应用我的功能。我的函数将整个列（作为向量）移动 1:length，生成列表列表。我需要这个作为矩阵来应用 max(x)-min(x) 函数。这适用于一个小矩阵，并且对于我需要的大小来说运行时间太长。

（小）来源（提供）：

      [,1] [,2] [,3] [,4] [,5]
 [1,]   55    9   99    0   NA
 [2,]   54    7   98    1   NA
 [3,]   56   12   97    2   NA
 [4,]   53    8   96    3    1
 [5,]   57   22   95    4    0
 [6,]   52   51   94    5   -1
 [7,]   58    6   93    6   NA
 [8,]   51    6   93    7    0
 [9,]   59   51   92    8    2
[10,]   50   78   91    9   NA
[11,]   60   12   90   10   NA
[12,]   49    5   89   11   -2

预期结果：

      [,1] [,2] [,3] [,4] [,5]
 [1,]    0    0    0    0    0
 [2,]    0    0    0    0    0
 [3,]    1    2    1    1    0
 [4,]    2    5    2    2    0
 [5,]    3    5    3    3    0
 [6,]    4   15    4    4    1
 [7,]    5   44    5    5    2
 [8,]    6   45    6    6    2
 [9,]    7   45    6    7    2
[10,]    8   45    7    8    3
[11,]    9   72    8    9    3
[12,]   10   72    9   10    3

第一个结果行将始终为 0，因为它没有可以计算的先前行。
第二个结果行将始终为零，因为前一行是最大值和最小值。
最后一个源行永远不会影响结果。

到目前为止我所拥有的：

library(data.table)

mytest <- matrix(c(
55, 9,99, 0,NA,
54, 7,98, 1,NA,
56,12,97, 2,NA,
53, 8,96, 3, 1,
57,22,95, 4, 0,
52,51,94, 5,-1,
58, 6,93, 6,NA,
51, 6,93, 7, 0,
59,51,92, 8, 2,
50,78,91, 9,NA,
60,12,90,10,NA,
49, 5,89,11,-2
), ncol=5, byrow = TRUE)

rolling_deviation <- function (a_column){
    tmp1 = shift(a_column, 1:(length(a_column)-1), NA, "lag")
    tmp2 = matrix(unlist(tmp1), ncol = length(a_column), byrow = TRUE)
    apply(tmp2,2,function(x){
        x = x[!is.na(x)]
        ifelse(length(x)==0, 0, max(x) - min(x))
    })
}

apply(mytest,2,rolling_deviation)  

我需要这个来更快地计算，随着观察的增加会有更多的行。

Answer 1

我通过创建嵌套循环解决了我的问题。我被告知诉诸循环几乎总是对性能不利，但我找不到更好的方法。我的最小/最大操作需要一个辅助函数，因为 NA 参数很可能不是我的目的的错误。

rolling_range <- function(in_mat){
    ignore_na = function(op, a,b){
        if(is.na(a)){
            return(b)
        }else if(is.na(b)){
            return(a)
        }else{
            return(op(a,b))
        }
    }
    out_mat.min = matrix(NA, nrow = nrow(in_mat), ncol = ncol(in_mat))
    out_mat.max = matrix(NA, nrow = nrow(in_mat), ncol = ncol(in_mat))
    out_mat.result = matrix(0, nrow = nrow(in_mat), ncol = ncol(in_mat))
    for(m in 1:ncol(in_mat)){
        for(n in 2:nrow(in_mat)){
            out_mat.min[n,m] = ignore_na(`min`, out_mat.min[(n-1),m], in_mat[(n-1),m])
            out_mat.max[n,m] = ignore_na(`max`, out_mat.max[(n-1),m], in_mat[(n-1),m])
            out_mat.result[n,m] = ifelse(is.na(out_mat.min[n,m]) || is.na(out_mat.max[n,m]), 0, out_mat.max[n,m] - out_mat.min[n,m] )
        }
    }
    return(out_mat.result)
}

rolling_range(mytest)

Answer 2

这个怎么样？

> system.time(outcome<- apply(mytest,2,rolling_deviation)) 
   user  system elapsed 
  0.014   0.002   0.038 

> system.time(outcome1<- setDT(data.frame(mytest))[, lapply(.SD, rolling_deviation)])
   user  system elapsed 
  0.002   0.000   0.002 

结果是一样的：

> outcome
      [,1] [,2] [,3] [,4] [,5]
 [1,]    0    0    0    0    0
 [2,]    0    0    0    0    0
 [3,]    1    2    1    1    0
 [4,]    2    5    2    2    0
 [5,]    3    5    3    3    0
 [6,]    4   15    4    4    1
 [7,]    5   44    5    5    2
 [8,]    6   45    6    6    2
 [9,]    7   45    6    7    2
[10,]    8   45    7    8    3
[11,]    9   72    8    9    3
[12,]   10   72    9   10    3

> outcome1
    X1 X2 X3 X4 X5
 1:  0  0  0  0  0
 2:  0  0  0  0  0
 3:  1  2  1  1  0
 4:  2  5  2  2  0
 5:  3  5  3  3  0
 6:  4 15  4  4  1
 7:  5 44  5  5  2
 8:  6 45  6  6  2
 9:  7 45  6  7  2
10:  8 45  7  8  3
11:  9 72  8  9  3
12: 10 72  9 10  3