簡體   English   中英

R:列值的滾動計算(避免循環)

[英]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 請注意, 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.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM