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

我有一个较大的矩阵/数据帧（2500x20），需要按列列出最大值减去所有以前单元格的最小值的滚动偏差-不包括当前值

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

（小）来源（提供）：

预期成果：

      [,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)  

库（data.table）
我的测试这个怎么样

> 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 

我通过创建嵌套循环解决了问题。我被教导，诉诸循环几乎总是对性能有害，但我找不到更好的方法。我需要一个用于最小/最大操作的帮助函数，因为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)

rolling\u范围您可能需要指定使用的包sorry，在代码中添加了库（data.table）-我忽略了移位。不幸的是，这对2500x20数据没有影响
> 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

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)