3

モデルのライブラリからアンサンブルを選択するためのカルアナらの方法を複製しようとしています（pdf）。この方法の中核となるのは、モデルをアンサンブルに追加するための欲張りアルゴリズムです（モデルは複数回追加できます）。この欲張り最適化アルゴリズムの実装を作成しましたが、非常に低速です。

library(compiler)
set.seed(42)
X <- matrix(runif(100000*10), ncol=10)
Y <- rnorm(100000)

greedOpt <- cmpfun(function(X, Y, iter=100){
  weights <- rep(0, ncol(X))

  while(sum(weights) < iter) {

    errors <- sapply(1:ncol(X), function(y){
      newweights <- weights
      newweights[y] <- newweights[y] + 1  
      pred <- X %*% (newweights)/sum(newweights)
      error <- Y - pred
      sqrt(mean(error^2))
    })

    update <- which.min(errors)
    weights[update] <- weights[update]+1
  }
  return(weights/sum(weights))
})

system.time(a <- greedOpt(X,Y))

Rがループをうまく実行しないことは知っていますが、ループなしでこのタイプの段階的検索を実行する方法は考えられません。

この機能を改善するための提案はありますか？

4

2 に答える 2

3

この関数の Rcpp バージョンを書いてみました。

library(Rcpp)
cppFunction('
  NumericVector greedOptC(NumericMatrix X, NumericVector Y, int iter) {
    int nrow = X.nrow(), ncol = X.ncol();
    NumericVector weights(ncol);
    NumericVector newweights(ncol);
    NumericVector errors(nrow);
    double RMSE;
    double bestRMSE;
    int bestCol;

    for (int i = 0; i < iter; i++) {
      bestRMSE = -1;
      bestCol = 1;
      for (int j = 0; j < ncol; j++) {
        newweights = weights + 0;
        newweights[j] = newweights[j] + 1;
        newweights = newweights/sum(newweights);

        NumericVector pred(nrow);
        for (int k = 0; k < ncol; k++){
          pred = pred + newweights[k] * X( _, k);
        }

        errors = Y - pred;
        RMSE = sqrt(mean(errors*errors));

        if (RMSE < bestRMSE || bestRMSE==-1){
          bestRMSE = RMSE;
          bestCol = j;
        }
      }

      weights[bestCol] = weights[bestCol] + 1;
    }

    weights = weights/sum(weights);
    return weights;
  }
')

R バージョンの 2 倍以上の速度です。

set.seed(42)
X <- matrix(runif(100000*10), ncol=10)
Y <- rnorm(100000)
> system.time(a <- greedOpt(X, Y, 1000))
   user  system elapsed 
  36.19    6.10   42.40 
> system.time(b <- greedOptC(X, Y, 1000))
   user  system elapsed 
  16.50    1.44   18.04
> all.equal(a,b)
[1] TRUE

悪くはありませんが、R から Rcpp に移行する際には、さらに高速化を期待していました。これは私が書いた最初の Rcpp 関数の 1 つなので、おそらくさらに最適化することができます。

于 2013-02-19T00:05:20.127 に答える
3

これは、あなたのものより 30% 速い R の実装です。Rcpp バージョンほど高速ではありませんが、Rcpp と組み合わせるとさらに高速化するアイデアが得られるかもしれません。主な改善点は次の 2 つです。

  1. ループはsapply行列式に置き換えられました
  2. 行列の乗算は再帰に置き換えられました
greedOpt <- cmpfun(function(X, Y, iter = 100L){

  N           <- ncol(X)
  weights     <- rep(0L, N)
  pred        <- 0 * X
  sum.weights <- 0L

  while(sum.weights < iter) {

      sum.weights   <- sum.weights + 1L
      pred          <- (pred + X) * (1L / sum.weights)
      errors        <- sqrt(colSums((pred - Y) ^ 2L))
      best          <- which.min(errors)
      weights[best] <- weights[best] + 1L
      pred          <- pred[, best] * sum.weights
  }
  return(weights / sum.weights)
})

また、アトラス ライブラリにアップグレードしてみてください。大幅な改善が見られる場合があります。

于 2013-02-19T02:03:30.127 に答える