我想根据前一行和同一列的值增量增长一个新列。你可以用循环来做到这一点，如下所示：
df <- data.frame(a = 2000:2010,
b = 10:20,
c = seq(1000, 11000, 1000),
x = 1000)
for(i in 2:nrow(df)) df$x[i] <- (df$c[i]) * df$a[i-1] / df$x[i-1] + df$b[i] * df$a[i]
df
a b c x
1 2000 10 1000 1000.00
2 2001 11 2000 26011.00
3 2002 12 3000 24254.79
4 2003 13 4000 26369.16
5 2004 14 5000 28435.80
6 2005 15 6000 30497.85
7 2006 16 7000 32556.20
8 2007 17 8000 34611.93
9 2008 18 9000 36665.87
10 2009 19 10000 38718.65
11 2010 20 11000 40770.76
(如您所见，第 x 列中的新值使用上一行第 x 列的值。
但是，当我为 Shiny 应用程序执行此操作时，我需要快速计算，因此使用循环不是最佳选择。有没有一种方法可以避免循环，理想情况下利用dplyr的管道？ 这个回复(参考计算中的前一行(提出了一种使用 sapply 的方法 - 但是，我无法在数学上做到这一点......
有几个选项。
使用矢量
在每个循环中，执行df$x的成本很高，因为执行此操作需要内存。相反，您可以预先分配向量并子集向量。
#easiest - extract the vectors before the loop
C <- df[['c']] #used big C because c() is a function
a <- df[['a']]
b <- df[['b']]
x <- df[['x']]
for(i in seq_along(x)[-1]) x[i] <- C[i] * a[i-1] / x[i-1L] + b[i] * a[i]
使用函数
将循环转换为函数将提高性能，因为编译优化。
f_recurse = function(a, b, C, x){
for (i in seq_along(x)[-1]) x[i] <- C[i] * a[i-1] / x[i-1L] + b[i] * a[i]
x
}
f_recurse(df$a, df$b, df$c, df$x)
使用 Rcpp
最后，如果响应还是太滞后，可以尝试使用Rcpp。请注意，Rcpp更新，因此当我返回向量时，真的没有必要 -df$x也已更新。
library(Rcpp)
cppFunction('
NumericVector f_recurse_rcpp(IntegerVector a, IntegerVector b, NumericVector C, NumericVector x){
for (int i = 1; i < x.size(); ++i){
x[i] = C[i] * a[i-1] / x[i - 1] + b[i] * a[i];
}
return(x);
}
')
f_recurse_rcpp(df$a, df$b, df$c, df$x)
性能
总的来说，我们的性能提高了近 1,000 倍。下表来自bench::mark，该表还检查了相等性。
# A tibble: 4 x 13
expression min median `itr/sec` mem_alloc
<bch:expr> <bch:t> <bch:t> <dbl> <bch:byt>
1 OP 8.27ms 8.8ms 106. 62.04KB
2 extract 6.21ms 7.49ms 126. 46.16KB
3 f_recurse(df$a, df$b, df$c, df$x) 13.1us 28.8us 33295. 0B
4 f_recurse_rcpp(df$a, df$b, df$c, df$x) 8.6us 10us 98240. 2.49KB
下面是一个包含 1,000 行 data.frame 然后是 10,000 行
的示例df <- data.frame(a = sample(1000L),
b = sample(1001:2000),
c = seq(1000, 11000, length.out = 1000),
x = rep(3, 1000L))
# A tibble: 4 x 13
expression min median `itr/sec` mem_alloc
<bch:expr> <bch:t> <bch:tm> <dbl> <bch:byt>
1 OP 23.9ms 24.38ms 39.4 7.73MB
2 extract 6.5ms 7.71ms 123. 69.84KB
3 f_recurse(df$a, df$b, df$c, df$x) 265.7us 271.9us 3596. 23.68KB
4 f_recurse_rcpp(df$a, df$b, df$c, df$x) 17.4us 18.9us 51845. 2.49KB
df <- data.frame(a = sample(10000L),
b = sample(10001:20000),
c = seq(1000, 11000, length.out = 10000),
x = rep(3, 10000L))
# A tibble: 4 x 13
expression min median `itr/sec` mem_alloc
<bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt>
1 OP 353.17ms 412.62ms 2.42 763.38MB
2 extract 8.75ms 8.95ms 107. 280.77KB
3 f_recurse(df$a, df$b, df$c, df$x) 2.58ms 2.61ms 376. 234.62KB
4 f_recurse_rcpp(df$a, df$b, df$c, df$x) 98.6us 112.7us 8169. 2.49KB