web-dev-qa-db-ja.com

lapply vs forループ-パフォーマンスR

lapplyループよりもforを好むとよく言われます。たとえば、Hadley WickhamがAdvance 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
}

前述の問題のため、一貫した改善は期待していませんでした。しかし、lapplyとreplicateを使用して急激な悪化が見られたとき、私は本当に驚きました。

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

最初の関数はlapply/replicate関数です

2番目は、forループを持つ関数です

3番目は、Rcppを使用したC++の同じ関数です

ここで、ローランドによると、機能のプロファイリング。正しい方法で解釈できるかどうかはわかりません。ほとんどの時間はサブセット化に費やされているように見えます Function profiling

rperformancelapply
17
Federico Manigrasso

まず第一に、forループはlapplyよりも遅いというのは、すでに長い間明らかにされた神話です。 Rのforループのパフォーマンスが大幅に向上し、現在は少なくともlapplyと同じくらい高速です。

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

lapplyは、その副作用（または副作用の欠如）に使用する必要がある関数です。関数lapplyは、結果をリストに自動的に結合し、forループとは異なり、作業環境を混乱させません。 replicateについても同じことが言えます。この質問もご覧ください。

Rは構文糖よりもファミリーを適用していますか？

lapplyソリューションがはるかに遅い理由は、それを使用する方法により多くのオーバーヘッドが生じるためです。

  • replicateは内部でsapplyに他ならないため、実際にsapplyとlapplyを組み合わせて二重ループを実装します。 sapplyは、結果を単純化できるかどうかをテストする必要があるため、余分なオーバーヘッドを作成します。したがって、forループはreplicateを使用するよりも実際に高速になります。
  • lapply匿名関数内では、すべての観測についてxとyの両方のデータフレームにアクセスする必要があります。これは、たとえばforループの反対に、たとえば$関数を毎回呼び出す必要があることを意味します。
  • これらのハイエンド関数を使用するため、26のみを呼び出すforソリューションと比較して、 'lapply'ソリューションは49個の関数を呼び出します。lapplyソリューションのこれらの追加関数には、 match、structure、[[、names、%in%、sys.call、duplicated、...すべてforループはこれらのチェックを行わないため、ループには不要な関数。

この余分なオーバーヘッドの原因を確認するには、replicate、unlist、sapply、およびsimplify2arrayの内部コードを確認してください。

次のコードを使用すると、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),]
35
Joris Meys

実際、

私は最近解決した問題との違いをテストしました。

試してみてください。

私の結論では、違いはありませんが、私の場合のforループは、lapplyよりもわずかに高速でした。

Ps：私はほとんど同じロジックを使用し続けるようにしています。

ds <- data.frame(matrix(rnorm(1000000), ncol = 8))  
n <- c('a','b','c','d','e','f','g','h')  
func <- function(ds, target_col, query_col, value){
  return (unique(as.vector(ds[ds[query_col] == value, target_col])))  
}  

f1 <- function(x, y){
  named_list <- list()
  for (i in y){
    named_list[[i]] <- func(x, 'a', 'b', i)
  }
  return (named_list)
}

f2 <- function(x, y){
  list2 <- lapply(setNames(nm = y), func, ds = x, target_col = "a", query_col = "b")
  return(list2)
}

benchmark(f1(ds2, n ))
benchmark(f2(ds2, n ))

ご覧のとおり、データフレームに基づいてnamed_listを作成する簡単なルーチンを実行しました。func関数は抽出された列値を実行し、f1はforループを使用してデータフレームを反復処理し、f2はlapply関数を使用します。

私のコンピューターでは、次の結果が得られます。

test replications elapsed relative user.self sys.self user.child
1 f1(ds2, n)          100  110.24        1   110.112        0          0
  sys.child
1         0

&&

        test replications elapsed relative user.self sys.self user.child
1 f1(ds2, n)          100  110.24        1   110.112        0          0
  sys.child
1         0
1
Aureliano Guedes