21

8 つのマルチコア プロセッサを搭載した Linux ボックスで R を実行していますが、最適化ルーチン自体を並列化することでスピードアップしたい最適化の問題があります。重要なことに、この問題には、(1) 複数のパラメーター、および (2)本質的に遅いモデル実行が含まれます。かなり一般的な問題です！

そのような場合の並列化されたオプティマイザーを知っている人はいますか?

より具体的には、ソルバーnlm()は、アルゴリズムがパラメーター空間でステップを実行するたびに複数のモデル評価 (パラメーター値ごとに 2 つ) を実行するのが好きなので、複数のモデル実行のインスタンスを並列化すると、いくつかのパラメーター値を超​​える状況で処理が大幅に高速化されます。フィットしていること。

パッケージを使用するコードは、ユーザーがこの並列化された最適化ルーチンの使用から移行するために最小限のコード変更をparallel行う必要がある方法で記述できるようです。つまり、これらのルーチンは基本的に何も変更せずに書き直すことができるように思われますが、勾配ベースの方法で一般的であるように、モデルを複数回呼び出すステップは並行して行われます。nlm()optim()

理想的には、 nlmPara() のようなものは次のようなコードを取るでしょう

fit <- nlm(MyObjFunc, params0);

マイナーな変更のみを必要とします。

fit <- nlmPara(MyObjFunc, params0, ncores=6);

考え/提案？

PS: モデルの実行を高速化するための措置を講じましたが、さまざまな理由で低速です (つまり、モデルの実行を高速化するためのアドバイスは必要ありません! ;-) )。

4

4 に答える 4

7

これは、少なくともある程度の約束がある大まかな解決策です。多くの/ほとんどの最適化ルーチンがユーザー指定の勾配関数を許可していることを指摘してくれた 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)))
于 2013-03-23T03:04:20.327 に答える
0

パッケージ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)
于 2013-03-20T09:46:17.743 に答える