在R函数中并行化内部for循环

时间:2017-02-13 10:02:26

标签: r for-loop foreach parallel-processing

我正在R中构建马尔可夫链蒙特卡罗采样器,其背后的想法是我有一群链并行(独立)更新并且在某些时候它们相互作用。 我想要做的是并行化独立更新,因为整个代码需要很长时间才能执行。 但是,foreach似乎不合适,因为它必须返回值,我只需要更新它们,有没有人遇到这个问题并想出一个智能解决方案?

population_MCMC <- function(niter, burnin,thin ,th0, T_N ,Sig, y0, log_target)
{ 
  # th0 will be updated at each step, th will contain the output of interest (that is, when T_N = 1)
  th <- matrix(nrow= ceiling((niter-burnin)/thin), ncol=2)

  nacp = 0 # number of accepted moves

  for(i in 1:(niter))
  {
      for(j in 1:length(T_N)){ # <-- THIS IS THE FOR LOOP I WANT TO PARALLELIZE!

          #this is the local change
          delta = as.vector(rmvnorm(1, mean = th0[j,], sig = Sig))
          lacp <- log_target(th = delta, y_obs = y_obs, y0 = y0, t_n=T_N[j])
          lacp <- lacp - log_target(th = th0[j,], y_obs = y_obs, y0 = y0, t_n=T_N[j])
          #cat(lacp,"\n")
          lgu <- log(runif(1))  
          if(!(is.na(lacp)) & lgu < lacp)
          {
            th0[j,] <- delta
            nacp = nacp + 1
          }
      }

    # Try to exchange theta_l and theta_m where m = l+1 or m= l-1 if l=! 1 and l=! length(T_N)
    ..... some other markovian stuff .....

    if(i>burnin & (i-burnin)%%thin==0){
      th[(i-burnin)/thin,] = th0[length(T_N),]
    }

    if(i%%1000==0) cat("*** Iteration number ", i,"/", niter, "\n")
  }
  cat("Acceptance rate =", nacp/niter, "\n")
  return(th)
}

编辑:如果它对基准测试有用,你可以在这里获得我的代码的运行版本

https://github.com/mariob6/progetto_bayes/blob/master/population_basedMC.R 需要此源文件 https://github.com/mariob6/progetto_bayes/blob/master/simple_oscillator.R

1 个答案:

答案 0 :(得分:0)

只要工作人员有足够的任务并且他们需要合理的计算时间,并行内循环就没有任何特殊问题。并行化外部循环通常更有效,但如果外部循环无法安全地并行化,那么就可以并行化内部循环。

重构代码以允许正确更新数据结构可能会非常棘手。在这种情况下,我建议foreach循环的主体返回一个列表,该列表指示应如何更新相应的“th0”行,以便组合功能(在主服务器上执行)可以执行实际更新。

这是一个展示这种技术的精简示例:

example <- function() {
  th0 <- matrix(0, 4, 4)
  nacp <- 0

  updatemaster <- function(ignore, ...) {
    for (r in list(...)) {
      if (! is.null(r$delta)) {
        cat('updating row', r$j, '\n')
        th0[r$j,] <<- r$delta
        nacp <<- nacp + 1
      } else {
        cat('not updating row', r$j, '\n')
      }
    }
    NULL  # combine function called strictly for side effect
  }

  for (i in 1:2) {
    ignore <-
      foreach(j=1:nrow(th0), .combine='updatemaster',
              .init=NULL, .multicombine=TRUE) %dopar% {
        delta <- rnorm(ncol(th0))
        if (rnorm(1) >= 0)
          list(j=j, delta=delta)
        else
          list(j=j, delta=NULL)
      }

    print(th0)
    print(nacp)
  }
}

suppressMessages(library(doSNOW))
cl <- makeSOCKcluster(2)
registerDoSNOW(cl)
example()

这可以通过仅向每个工作者发送一个“th0”块然后在外部循环的每次迭代中重复使用它来改进。这可以显着降低开销,但也会变得更加复杂。