2017-02-22 8 views
6

ループよりもlapplyを好むとよく言われています。 例えば、Hadley WickhamがAdvance Rの本で指摘しているようないくつかの例外があります。lapply vs forループ - パフォーマンスR

http://adv-r.had.co.nz/Functionals.html)(場所の変更、再帰など)。 この場合の1つは次のとおりです。

ちょうど学ぶために、パフォーマンスのパーセプトロンアルゴリズムをベンチマーク の相対的なパフォーマンスのために書き直そうとしました。 ソース(https://rpubs.com/FaiHas/197581)。

ここにコードがあります。

# prepare input 
data(iris) 
irissubdf <- iris[1:100, c(1, 3, 5)] 
names(irissubdf) <- c("sepal", "petal", "species") 
head(irissubdf) 
irissubdf$y <- 1 
irissubdf[irissubdf[, 3] == "setosa", 4] <- -1 
x <- irissubdf[, c(1, 2)] 
y <- irissubdf[, 4] 

# perceptron function with for 
perceptron <- function(x, y, eta, niter) { 

    # initialize weight vector 
    weight <- rep(0, dim(x)[2] + 1) 
    errors <- rep(0, niter) 


    # loop over number of epochs niter 
    for (jj in 1:niter) { 

    # loop through training data set 
    for (ii in 1:length(y)) { 

     # Predict binary label using Heaviside activation 
     # function 
     z <- sum(weight[2:length(weight)] * as.numeric(x[ii, 
     ])) + weight[1] 
     if (z < 0) { 
     ypred <- -1 
     } else { 
     ypred <- 1 
     } 

     # Change weight - the formula doesn't do anything 
     # if the predicted value is correct 
     weightdiff <- eta * (y[ii] - ypred) * c(1, 
     as.numeric(x[ii, ])) 
     weight <- weight + weightdiff 

     # Update error function 
     if ((y[ii] - ypred) != 0) { 
     errors[jj] <- errors[jj] + 1 
     } 

    } 
    } 

    # weight to decide between the two species 

    return(errors) 
} 

err <- perceptron(x, y, 1, 10) 

### my rewriting in functional form auxiliary 
### function 
faux <- function(x, weight, y, eta) { 
    err <- 0 
    z <- sum(weight[2:length(weight)] * as.numeric(x)) + 
    weight[1] 
    if (z < 0) { 
    ypred <- -1 
    } else { 
    ypred <- 1 
    } 

    # Change weight - the formula doesn't do anything 
    # if the predicted value is correct 
    weightdiff <- eta * (y - ypred) * c(1, as.numeric(x)) 
    weight <<- weight + weightdiff 

    # Update error function 
    if ((y - ypred) != 0) { 
    err <- 1 
    } 
    err 
} 

weight <- rep(0, 3) 
weightdiff <- rep(0, 3) 

f <- function() { 
    t <- replicate(10, sum(unlist(lapply(seq_along(irissubdf$y), 
    function(i) { 
     faux(irissubdf[i, 1:2], weight, irissubdf$y[i], 
     1) 
    })))) 
    weight <<- rep(0, 3) 
    t 
} 

前述の の問題のため、一貫した改善は期待できませんでした。でも、 が、lapplyreplicateを使って急激に悪化したのを見て、私は本当に驚いていました。

私はおそらくの理由は何だろうか?microbenchmarkライブラリからmicrobenchmark機能を使用して

この結果を得ましたか メモリリークがありますか?

             expr  min   lq  mean  median   uq 
                 f() 48670.878 50600.7200 52767.6871 51746.2530 53541.2440 
    perceptron(as.matrix(irissubdf[1:2]), irissubdf$y, 1, 10) 4184.131 4437.2990 4686.7506 4532.6655 4751.4795 
perceptronC(as.matrix(irissubdf[1:2]), irissubdf$y, 1, 10) 95.793 104.2045 123.7735 116.6065 140.5545 
     max neval 
109715.673 100 
    6513.684 100 
    264.858 100 

は、第一の機能は、forループ

第ローランドによれば、ここRcpp

を用いC++に同じ関数であると機能lapply/replicate機能

秒です関数のプロファイリング 私は正しい方法でそれを解釈することができないのか分かりません。 時間のほとんどは、すべてのサブセット Function profiling

+2

正確に入力してください。あなたの関数 'f'に' apply'を呼び出すことはありません。 – Roland

+1

私はあなたが関数をプロファイリングする方法を学ぶことをお勧めします:http://adv-r.had.co.nz/Profiling.html – Roland

+0

コードにいくつかの誤りがあります。最初に 'irissubd [、4] < - 1'は' irissubdf $ y < - 1'でなければなりません。後でその名前を使うことができ、 'f'で使用する前に' weight'が定義されていません。あなたの 'lapply'コマンドと' replicate'コマンドで '<< - 'が正しいことをしていることは私には明らかではありませんが、それが何をしているのかは分かりません。これは両者の大きな違いかもしれません。 '<< - 'は環境に対処しなければならず、他の環境は処理しなければなりません。そして、私はどのような効果があるのか​​正確にはわかりませんが、もうリンゴと比較することはそれほどありません。 – Aaron

答えて

19

まずに費やされている私には同じように見え、forループはlapplyより任意の遅いことをすでに長い暴か神話です。 Rのforループは、より多くの演奏が行われており、少なくとも現在は少なくともlapplyの速さです。

つまり、ここではlapplyの使用を再考する必要があります。あなたのコードでは、ループ中にウェイトを更新する必要があるため、実装ではグローバル環境への割り当てが必要です。そしてそれはlapplyを考慮しない正当な理由です。

lapplyは、副作用(または副作用がない)に使用する関数です。関数lapplyはリスト内の結果を自動的に組み合わせ、作業する環境を混乱させません。これはループforとは異なります。 replicateも同様です。また、この質問を参照してください。それを使用してのあなたの方法は、より多くのオーバーヘッドが発生しますので、

Is R's apply family more than syntactic sugar?

あなたlapplyソリューションがはるかに遅くなる理由は、あります。

  • replicateは何もなく、内部sapplyではありませんので、あなたが実際にあなたの二重ループを実装するためにsapplylapplyを兼ね備えています。 sapplyは、結果を簡略化できるかどうかをテストする必要があるため、余分なオーバーヘッドが発生します。したがって、forループは、実際にはreplicateを使用するよりも速くなります。
  • lapply匿名関数内では、観測ごとにxとyの両方のデータフレームにアクセスする必要があります。これは、あなたのfor-loopで〜に対して〜を意味します。例えば、関数$が毎回呼び出されなければなりません。
  • あなたはこれらのハイエンド機能を使用するので、あなたの「lapply」ソリューションは、lapply解決のためにこれらの追加機能はmatchのような関数の呼び出し、structure[[namesを含める26を呼び出し、あなたのforソリューションに比べて、49個の関数を呼び出します、%in%sys.callduplicated、... あなたのforループでは、これらのチェックを行わないすべての機能は必要ありません。

あなたはこの余分なオーバーヘッドがどこから来るのか確認したい場合は、replicateunlistsapplysimplify2arrayの内部コードを見てください。

lapplyを使用して掲載結果を失う場所を特定するには、次のコードを使用します。この行を1行ずつ実行してください!

Rprof(interval = 0.0001) 
f() 
Rprof(NULL) 
fprof <- summaryRprof()$by.self 

Rprof(interval = 0.0001) 
perceptron(as.matrix(irissubdf[1:2]), irissubdf$y, 1, 10) 
Rprof(NULL) 
perprof <- summaryRprof()$by.self 

fprof$Fun <- rownames(fprof) 
perprof$Fun <- rownames(perprof) 

Selftime <- merge(fprof, perprof, 
        all = TRUE, 
        by = 'Fun', 
        suffixes = c(".lapply",".for")) 

sum(!is.na(Selftime$self.time.lapply)) 
sum(!is.na(Selftime$self.time.for)) 
Selftime[order(Selftime$self.time.lapply, decreasing = TRUE), 
     c("Fun","self.time.lapply","self.time.for")] 

Selftime[is.na(Selftime$self.time.for),] 
関連する問題