如何使循環在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

這是基於湯米答案的版本，但避免了所有循環：

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 }

Answer 2

嗯，一種有效的方法是擺脫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

Answer 3

為什么不這樣呢？

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慢，而是其手臂功能。