r - 如何使循环在 R 中运行得更快？

Question

我想使用 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)
        }
    }
) 

Answer 1

这是一个基于 Tommy 的回答但避免了所有循环的版本:

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 矩阵始终是列优先的)来挤出几毫秒。

编辑:我注意到自从 Tommy 回答后 moli 稍微改变了问题 - 所以你必须使用循环而不是 sum(...) 部分，因为 y[i] 是相关的，所以 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 }