[英]Speed up iterative loop calculation with R
我必須加快我的腳本。 我有一些周期,如:
DT <- data.frame(Index=1:20, A=c(10:29))
cost1 <- 3
cost2 <- 0.05
cost3 <- 50
DT$S[1] <- cost1
for (j in 2:(20)) {
DT$S[j] <- DT$S[j-1]-cost3+DT$S[j-1]*cost2/12
}
其中cost1和cost2是常量。 是否可以避免編寫循環?
您的方法的主要問題是您反復調用data.frame( DT$S
)的元素,但在此計算中不需要。 如果我們用vector替換它並在最后將結果添加到data.frame,它會快得多。 我們也可以簡化公式。
n <- 1e4
DT <- data.frame(Index = 1:n, A = seq(10, by = 1, length.out = n))
cost1 <- 3
cost2 <- 0.05
cost3 <- 50
your <- function() {
DT$S[1] <- cost1
for (j in 2:(n)) {
DT$S[j] <- DT$S[j - 1] - cost3 + DT$S[j - 1]*cost2/12
}
}
your()
我的功能:
my <- function() {
cc <- (1 + cost2/12)
r <- vector('numeric', length = n)
r[1] <- cost1
for (j in 2:(n)) {
# r[j] <- r[j - 1] - cost3 + r[j - 1] * cost2/12
r[j] <- r[j - 1] * cc - cost3
}
r
}
DT$S2 <- my()
all.equal(DT$S, DT$S2)
# [1] TRUE
microbenchmark::microbenchmark(your(), my(), times = 2)
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# your() 487.229621 487.229621 490.86917 490.86917 494.508715 494.508715 2 b
# my() 1.515178 1.515178 1.59408 1.59408 1.672982 1.672982 2 a
總和可以擴展為
## S1 = c1
## S2 = S1 * c2 - c3 = c1 * c2 - c3
## S3 = S2 * c2 - c3 = c1 *c2^2 - c3 *c2 - c3
## S4 = S3 * c2 - c3 = c1 *c2^3 - c3 *c2^2 - c3 * c2 - c3
並實施為
f5 <- function(n) {
c1 <- 3
c2 <- 1 + 0.05 / 12
c3 <- 50
p <- cumprod(c(1, rep(c2, n - 1)))
c1 * p - c3 * cumsum(c(0, p[-length(p)]))
}
相比my()
實現為
my <- function(n) {
cost1 <- 3
cost2 <- 0.05
cost3 <- 50
cc <- (1 + cost2/12)
r <- vector('numeric', length = n)
r[1] <- cost1
for (j in 2:n)
r[j] <- r[j - 1] * cc - cost3
r
}
我們有數值等價和改進的性能
> n <- 1e4
> all.equal(my(n), f5(n))
[1] TRUE
> microbenchmark(my(n), f5(n), times=5)
Unit: microseconds
expr min lq mean median uq max neval
my(n) 2495.459 2504.392 2516.5754 2505.541 2529.837 2547.648 5
f5(n) 559.813 561.670 569.0204 563.739 565.325 594.555 5
但是大數n
數值問題(也適用於所有其他實現)
> x = f5(1e6)
> x[which.min(x) + (-3):3]
[1] -1.778181e+308 -1.785590e+308 -1.793030e+308 -Inf -Inf
[6] -Inf -Inf
> which.min(x)
[1] 168445
您的列S
由一階線性遞歸定義。 第i個術語可以用i
表示,參見例如這些幻燈片 。
> DT <- data.frame(Index=1:20)
> cost1 <- 3; cost2 <- 0.05; cost3 <- 50
> DT$S[1] <- cost1
> for (j in 2:(20)) {
+ DT$S[j] <- DT$S[j-1]-cost3+DT$S[j-1]*cost2/12
+ }
> DT$S
[1] 3.00000 -46.98750 -97.18328 -147.58821 -198.20316 -249.02901 -300.06663 -351.31691
[9] -402.78073 -454.45898 -506.35256 -558.46236 -610.78929 -663.33424 -716.09814 -769.08188
[17] -822.28639 -875.71258 -929.36138 -983.23372
> s <- 1+cost2/12
> s_powers <- s^(1:(N-1))
> cost1*s_powers - cost3*(1-s_powers)/(1-s)
[1] -46.98750 -97.18328 -147.58821 -198.20316 -249.02901 -300.06663 -351.31691 -402.78073
[9] -454.45898 -506.35256 -558.46236 -610.78929 -663.33424 -716.09814 -769.08188 -822.28639
[17] -875.71258 -929.36138 -983.23372
讓我們比較四種方式。
f1 <- function(){ # your way
DT$S[1] <- cost1
for (j in 2:N) {
DT$S[j] <- DT$S[j-1]-cost3+DT$S[j-1]*cost2/12
}
}
f2 <- function(){ # group the two DT$S[j-1] (cause DT$S[j-1] is slow)
DT$S[1] <- cost1
for (j in 2:N) {
DT$S[j] <- (1+cost2/12)*DT$S[j-1]-cost3
}
}
f3 <- function(){ # avoid DT$S[j-1] (@minem's answer)
u <- numeric(N)
u[1] <- cost1
for (j in 2:N) {
u[j] <- (1+cost2/12)*u[j-1]-cost3
}
DT$S <- u
}
f4 <- function(){ # express DT$S[j] in function of j
s <- 1+cost2/12
s_powers <- s^(1:(N-1))
u2N <- cost1*s_powers - cost3*(1-s_powers)/(1-s)
DT$S <- c(cost1, u2N)
}
讓我們比較一下:
> library(microbenchmark)
> N <- 2000
> DT <- data.frame(Index=1:N)
> microbenchmark(
+ f1 = f1(),
+ f2 = f2(),
+ f3 = f3(),
+ f4 = f4()
+ )
Unit: microseconds
expr min lq mean median uq max neval cld
f1 65802.386 67920.918 73168.4472 69025.145 70347.8050 180938.153 100 c
f2 52641.373 54790.698 58553.8418 55916.565 57021.0145 163660.112 100 b
f3 375.736 396.932 458.5317 418.798 459.6295 974.593 100 a
f4 220.890 235.170 266.3977 240.971 259.9360 1318.199 100 a
獲勝者是f4
,不使用復發的人。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.