[英]How to make a loop run faster in R?
我想使用arms()
每次获取一个样本,并在函数中进行如下循环。 它运行非常缓慢。 我怎样才能使其运行更快? 谢谢。
library(HI)
dmat <- matrix(0, nrow=100,ncol=30)
system.time(
for (d in 1:100){
for (j in 1:30){
y <- rep(0, 101)
for (i in 2:100){
y[i] <- arms(0.3, function(x) (3.5+0.000001*d*j*y[i-1])*log(x)-x,
function(x) (x>1e-4)*(x<20), 1)
}
dmat[d, j] <- sum(y)
}
}
)
这是基于汤米答案的版本,但避免了所有循环:
library(multicore) # or library(parallel) in 2.14.x
set.seed(42)
m = 100
n = 30
system.time({
arms.C <- getNativeSymbolInfo("arms")$address
bounds <- 0.3 + convex.bounds(0.3, dir = 1, function(x) (x>1e-4)*(x<20))
if (diff(bounds) < 1e-07) stop("pointless!")
# create the vector of z values
zval <- 0.00001 * rep(seq.int(n), m) * rep(seq.int(m), each = n)
# apply the inner function to each grid point and return the matrix
dmat <- matrix(unlist(mclapply(zval, function(z)
sum(unlist(lapply(seq.int(100), function(i)
.Call(arms.C, bounds, function(x) (3.5 + z * i) * log(x) - x,
0.3, 1L, parent.frame())
)))
)), m, byrow=TRUE)
})
在多核计算机上,这将非常快,因为它将负载分散到各个核中。 在单核计算机上(或针对Windows用户),您可以用mclapply
替换上面的lapply
并且与Tommy的答案相比,只会稍微提高一点速度。 但是请注意,并行版本的结果将有所不同,因为它将使用不同的RNG序列。
请注意,任何需要评估R函数的C代码本质上都会很慢(因为解释后的代码很慢)。 我添加了arms.C
只是为了消除所有R-> C开销,以使moli开心;),但这没有任何区别。
您可以通过使用以列为主的处理方式来压缩几毫秒(问题代码是以行为主的,由于R矩阵始终以列为主,因此需要重新复制)。
编辑:自汤米回答以来,我注意到莫利稍微改变了问题-因此,由于y[i]
是依赖的,因此您必须使用循环,而不是sum(...)
部分,因此function(z)
看起来像
function(z) { y <- 0
for (i in seq.int(99))
y <- y + .Call(arms.C, bounds, function(x) (3.5 + z * y) * log(x) - x,
0.3, 1L, parent.frame())
y }
嗯,一种有效的方法是摆脱arms
内部的开销。 即使您的结果始终相同,它indFunc
一些检查并每次都调用indFunc
。 也可以在循环外进行其他一些评估。 这些优化使我的机器上的时间从54秒减少到6.3秒左右。 ...答案是相同的。
set.seed(42)
#dmat2 <- ##RUN ORIGINAL CODE HERE##
# Now try this:
set.seed(42)
dmat <- matrix(0, nrow=100,ncol=30)
system.time({
e <- new.env()
bounds <- 0.3 + convex.bounds(0.3, dir = 1, function(x) (x>1e-4)*(x<20))
f <- function(x) (3.5+z*i)*log(x)-x
if (diff(bounds) < 1e-07) stop("pointless!")
for (d in seq_len(nrow(dmat))) {
for (j in seq_len(ncol(dmat))) {
y <- 0
z <- 0.00001*d*j
for (i in 1:100) {
y <- y + .Call("arms", bounds, f, 0.3, 1L, e)
}
dmat[d, j] <- y
}
}
})
all.equal(dmat, dmat2) # TRUE
为什么不这样呢?
dat <- expand.grid(d=1:10, j=1:3, i=1:10)
arms.func <- function(vec) {
require(HI)
dji <- vec[1]*vec[2]*vec[3]
arms.out <- arms(0.3,
function(x,params) (3.5 + 0.00001*params)*log(x) - x,
function(x,params) (x>1e-4)*(x<20),
n.sample=1,
params=dji)
return(arms.out)
}
dat$arms <- apply(dat,1,arms.func)
library(plyr)
out <- ddply(dat,.(d,j),summarise, arms=sum(arms))
matrix(out$arms,nrow=length(unique(out$d)),ncol=length(unique(out$j)))
但是,它仍然是单核且耗时的。 但这不是R慢,而是其手臂功能。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.