我在有8个多核处理器的linux机器上运行R,并且有一个优化问题,我想通过并行化优化例程本身来加快速度。重要的是,这个问题涉及(1)多个参数,(2)模型运行固有的缓慢。一个相当常见的问题!
有没有人知道针对这种情况的并行优化器?
更具体地说,每次算法在参数空间中执行一步时,像nlm()
这样的求解器都会运行多个模型评估(每个参数值两个),因此在这些情况下,当符合多个参数值时,将多个模型运行的实例并行化将大大加快速度。
看起来,使用parallel
包的代码可以这样编写,用户只需做最少的代码修改,就可以从使用nlm()
或optim()
转移到这个并行优化例程。也就是说,似乎可以重写这些例程,基本上不需要更改,除了多次调用模型的步骤将并行完成,这在基于梯度的方法中很常见。
理想情况下,像nlmPara()这样的代码应该包含如下代码
fit <- nlm(MyObjFunc, params0);
并且仅需要较小的修改,例如,
fit <- nlmPara(MyObjFunc, params0, ncores=6);
想法/建议?
PS:我已经采取措施来加速这些模型运行,但它们由于各种原因而变得缓慢(例如,我不需要关于加速模型运行的建议!;-) )。
发布于 2013-03-23 11:04:20
这是一个粗略的解决方案,至少有一些希望。非常感谢Ben Bolker指出,许多/大多数优化例程都允许用户指定的梯度函数。
具有更多参数值的测试问题可能会显示出更显着的改进,但在8核机器上,使用并行化梯度函数的运行时间大约是串行版本的70%。注意,这里使用的粗糙梯度近似似乎会减慢收敛速度,因此会增加一些时间。
## Set up the cluster
require("parallel");
.nlocalcores = NULL; # Default to "Cores available - 1" if NULL.
if(is.null(.nlocalcores)) { .nlocalcores = detectCores() - 1; }
if(.nlocalcores < 1) { print("Multiple cores unavailable! See code!!"); return()}
print(paste("Using ",.nlocalcores,"cores for parallelized gradient computation."))
.cl=makeCluster(.nlocalcores);
print(.cl)
# Now define a gradient function: both in serial and in parallel
mygr <- function(.params, ...) {
dp = cbind(rep(0,length(.params)),diag(.params * 1e-8)); # TINY finite difference
Fout = apply(dp,2, function(x) fn(.params + x,...)); # Serial
return((Fout[-1]-Fout[1])/diag(dp[,-1])); # finite difference
}
mypgr <- function(.params, ...) { # Now use the cluster
dp = cbind(rep(0,length(.params)),diag(.params * 1e-8));
Fout = parCapply(.cl, dp, function(x) fn(.params + x,...)); # Parallel
return((Fout[-1]-Fout[1])/diag(dp[,-1])); #
}
## Lets try it out!
fr <- function(x, slow=FALSE) { ## Rosenbrock Banana function from optim() documentation.
if(slow) { Sys.sleep(0.1); } ## Modified to be a little slow, if needed.
x1 <- x[1]
x2 <- x[2]
100 * (x2 - x1 * x1)^2 + (1 - x1)^2
}
grr <- function(x, slow=FALSE) { ## Gradient of 'fr'
if(slow) { Sys.sleep(0.1); } ## Modified to be a little slow, if needed.
x1 <- x[1]
x2 <- x[2]
c(-400 * x1 * (x2 - x1 * x1) - 2 * (1 - x1),
200 * (x2 - x1 * x1))
}
## Make sure the nodes can see these functions & other objects as called by the optimizer
fn <- fr; # A bit of a hack
clusterExport(cl, "fn");
# First, test our gradient approximation function mypgr
print( mypgr(c(-1.2,1)) - grr(c(-1.2,1)))
## Some test calls, following the examples in the optim() documentation
tic = Sys.time();
fit1 = optim(c(-1.2,1), fr, slow=FALSE); toc1=Sys.time()-tic
fit2 = optim(c(-1.2,1), fr, gr=grr, slow=FALSE, method="BFGS"); toc2=Sys.time()-tic-toc1
fit3 = optim(c(-1.2,1), fr, gr=mygr, slow=FALSE, method="BFGS"); toc3=Sys.time()-tic-toc1-toc2
fit4 = optim(c(-1.2,1), fr, gr=mypgr, slow=FALSE, method="BFGS"); toc4=Sys.time()-tic-toc1-toc2-toc3
## Now slow it down a bit
tic = Sys.time();
fit5 = optim(c(-1.2,1), fr, slow=TRUE); toc5=Sys.time()-tic
fit6 = optim(c(-1.2,1), fr, gr=grr, slow=TRUE, method="BFGS"); toc6=Sys.time()-tic-toc5
fit7 = optim(c(-1.2,1), fr, gr=mygr, slow=TRUE, method="BFGS"); toc7=Sys.time()-tic-toc5-toc6
fit8 = optim(c(-1.2,1), fr, gr=mypgr, slow=TRUE, method="BFGS"); toc8=Sys.time()-tic-toc5-toc6-toc7
print(cbind(fast=c(default=toc1,exact.gr=toc2,serial.gr=toc3,parallel.gr=toc4),
slow=c(toc5,toc6,toc7,toc8)))
发布于 2014-04-08 05:24:16
由于您还没有接受答案,因此这个想法可能会有所帮助:对于全局优化,DEoptim()
包有一个用于并行优化的内置选项。好的是,它很容易使用,文档也写得很好。
c.f.http://www.jstatsoft.org/v40/i06/paper (当前已关闭)
http://cran.r-project.org/web/packages/DEoptim/index.html
注意:差分Evolglobal优化器可能仍然会遇到局部优化。
发布于 2013-03-20 17:46:18
我使用doSNOW包在8核上运行了一段代码。我可以只复制并粘贴代码中引用这个包的部分。希望它能帮上忙!
# use multicore libraries
# specify number of cores to use
cores<- 8
cluster <- makeCluster(cores, type="SOCK")
registerDoSNOW(cluster)
# check how many cores will be used
ncores <- getDoParWorkers()
print(paste("Computing algorithm for ", cores, " cores", sep=""))
fph <- rep(-100,12)
# start multicore cicle on 12 subsets
fph <- foreach(i=1:12, .combine='c') %dopar% {
PhenoRiceRun(sub=i, mpath=MODIS_LOCAL_DIR, masklocaldir=MASK_LOCAL_DIR, startYear=startYear, tile=tile, evismoothopt=FALSE)
}
stopCluster(cluster) # check if gives error
gc(verbose=FALSE)
https://stackoverflow.com/questions/15397390
复制相似问题