迭代地计算 data.table 的列，一次一行（递归列定义）

Question

背景/示例

大家好，

我正在尝试使用 data.table 中的现有列来计算新列。但是，这些列依赖于前一行的值。例如，说我的列 R_t = A_t + B_t + R_t-1。我有两列组成我的密钥，scenario 和 t。我一直在尝试这样做：

当前解决方案：

for(i in 1:maxScenario){

for(j in 2:nrow(dt)) {

dt[scenario == i & t == j, "R"] <- dt[scenario == i & t == j - 1, "R"]
+ dt[scenario == i & t == j, "A"] + dt[scenario == i & t == j, "B"]

} # end for loop for t

} # end for loop for scenario

这里的区别是，在“j - 1 而不是 j for R 来检索上一行的值。

问题

我意识到这会增加大量计算时间，并且是一种非常粗略的方法。 data.table 包中是否有更好的方法来执行此操作？我曾尝试使用 shift() 但在那里遇到了问题。使用 shift() 不会“重新计算”基于 A 和 B 的列。

我曾考虑使用递归公式，但我不确定这会对效率和运行时间产生什么影响。理想情况下，我希望运行大约 10 万个场景，并且需要在随机场景完成后进行这些计算。

谢谢！

编辑：示例

这是一个小例子的尝试。每行的 R 值取决于前一行的值。

t  R  A  B
1  0  1  2
2  3  2  3
3  8  2  5
4  15 8  5
5  28 10 8   

编辑 2：进一步说明

我终于能够将我的实际问题函数转化为代数：

R_t = λ * P_t + λ * R_t-1 - min{λ * P_t + λ * R_t-1, D_t} - A(t) * max{λ * P_{t + λ * Rt-1 - Dt - Mt, 0} 其中 Pt 、Dt 和 Mt 是其他已知列，A(t) 是指示函数，当 t % 4 为 != 0 时返回 0，否则返回 1。}

有没有办法将 shift() 和 cumsum() 与这样的嵌套方程一起使用？

Answer 1

这是一个使用Rcpp 和data.table 的选项，因为它更容易在cpp 中思考/编码，用于递归方程：

DT[, A := +(t %% 4 == 0)]

library(Rcpp)    
cppFunction('NumericVector recur(double lambda, NumericVector P, 
    NumericVector D, NumericVector M, NumericVector A) {
        int sz = P.size(), t;
        NumericVector R(sz);

        for (t=1; t<sz; t++) {
            R[t] = lambda * P[t] + lambda * R[t-1] -
                std::min(lambda * P[t] + lambda * R[t-1], D[t]) -
                A[t] * std::max(lambda * P[t] * lambda * R[t-1] - D[t] - M[t], 0.0);
        }

    return(R);
}')

DT[, R := recur(lambda, P, D, M, A)]

输出：

     t            P           D          M A           R
 1:  1  1.262954285  0.25222345 -0.4333103 0  0.00000000
 2:  2 -0.326233361 -0.89192113 -0.6494716 0  0.72880445
 3:  3  1.329799263  0.43568330  0.7267507 0  0.59361856
 4:  4  1.272429321 -1.23753842  1.1519118 1  1.89610128
 5:  5  0.414641434 -0.22426789  0.9921604 0  1.37963924
 6:  6 -1.539950042  0.37739565 -0.4295131 0  0.00000000
 7:  7 -0.928567035  0.13333636  1.2383041 0  0.00000000
 8:  8 -0.294720447  0.80418951 -0.2793463 1  0.00000000
 9:  9 -0.005767173 -0.05710677  1.7579031 0  0.05422319
10: 10  2.404653389  0.50360797  0.5607461 0  0.72583032
11: 11  0.763593461  1.08576936 -0.4527840 0  0.00000000
12: 12 -0.799009249 -0.69095384 -0.8320433 1 -1.23154792
13: 13 -1.147657009 -1.28459935 -1.1665705 0  0.09499689
14: 14 -0.289461574  0.04672617 -1.0655906 0  0.00000000
15: 15 -0.299215118 -0.23570656 -1.5637821 0  0.08609900
16: 16 -0.411510833 -0.54288826  1.1565370 1  0.38018234

数据：

library(data.table)    
set.seed(0L)
nr <- 16L
DT <- data.table(t=1L:nr, P=rnorm(nr), D=rnorm(nr), M=rnorm(nr))
lambda <- 0.5

Answer 2

这将创建一个新列 R2，其值与 R 相同

DT[, R2 := shift( cumsum(A+B), type = "lag", fill = 0 ) ][]

#    t  R  A B R2
# 1: 1  0  1 2  0
# 2: 2  3  2 3  3
# 3: 3  8  2 5  8
# 4: 4 15  8 5 15
# 5: 5 28 10 8 28

Answer 3

据我所知，没有办法使用来自data.table 的内置函数迭代计算行。我什至相信那里有一个重复的问题，有一个类似的问题（尽管我现在找不到）。

但是，我们可以通过注意公式中可以使用的技巧来加快计算速度。首先获取提供的示例中的结果，我们可以注意到这只是cumsum(shift(A, 1, fill = 0) + shift(B, 1, fill = 0))

dt <- fread('t  R  A  B
1  0  1  2
2  3  2  3
3  8  2  5
4  15 8  5
5  28 10 8') 
dt[, R2 := cumsum(shift(A, 1, fill = 0) + shift(B, 1, fill = 0))]
dt
   t  R  A B R2
1: 1  0  1 2  0
2: 2  3  2 3  3
3: 3  8  2 5  8
4: 4 15  8 5 15
5: 5 28 10 8 28

但是对于描述的确切问题 R_t = A_t + B_t + R_t-1我们必须更聪明一点

dt[, R3 := cumsum(A + B) - head(A + B, 1)]
dt
   t  R  A B R2 R3
1: 1  0  1 2  0  0
2: 2  3  2 3  3  5
3: 3  8  2 5  8 12
4: 4 15  8 5 15 25
5: 5 28 10 8 28 43

按照上面的描述。注意我删除了第一行，假设R<sub>0</sub> = 0，否则就直接变成cumsum(A + B)

编辑

由于问题是询问一些可能更复杂的情况，我将使用一个较慢（但更通用）的示例添加一个示例。这里的想法是使用set 函数，以避免中间的浅处理（参见help(set) 或help("datatable-optimize")）。

dt[, R4 := 0]
for(i in seq.int(2, dt[, .N])){
  #dummy complicated scenario
  f <- dt[seq(i), lm(A ~ B - 1)]
  set(dt, i, 'R4', unname(unlist(coef(f))))
}
dt
t  R  A B R2 R3        R4
1: 1  0  1 2  0  0 0.0000000
2: 2  3  2 3  3  5 0.6153846
3: 3  8  2 5  8 12 0.4736842
4: 4 15  8 5 15 25 0.9206349
5: 5 28 10 8 28 43 1.0866142