[英]R: Rolling calculation of column values (avoid loop)
我想根據前一行和同一列的值逐步增加一個新列。 你可以用一個循環來做,就像這樣:
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
更新到位,因此當我返回一個向量時,實際上沒有必要 - 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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.