for 循环和 apply 函数系列之间的性能差异是什么？

人们常说，一个人应该更喜欢lapply over for循环。 但也有一些例外，例如 Hadley Wickham 在他的 Advance R 书中指出的那样。

(http://adv-r.had.co.nz/Functionals.html http://adv-r.had.co.nz/Functionals.html)（就地修改、递归等）。 以下是其中的一个案例。

只是为了学习，我尝试以函数形式重写感知器算法，以便进行基准测试 相对性能。 来源 （https://rpubs.com/FaiHas/197581 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 and replicate.

我使用以下方法得到了这个结果microbenchmark函数来自microbenchmark library

可能是什么原因？ 会不会是内存泄漏？

                                                      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功能

第二个是函数for loops

第三个是相同的功能C++ using Rcpp

这里根据 Roland 的功能分析。 我不确定我能以正确的方式解释它。 在我看来，大部分时间都花在子集化上函数分析 https://i.stack.imgur.com/N2Nez.png

首先，这是一个早已被揭穿的神话for循环比任何慢lapply. The forR 中的循环性能得到了提高，目前至少与lapply.

也就是说，你必须重新考虑你的使用lapply这里。您的实现需要分配给全局环境，因为您的代码要求您在循环期间更新权重。这是不考虑的正当理由lapply.

lapply是一个您应该使用的函数，因为它有副作用（或没有副作用）。功能lapply自动将结果合并到列表中，并且不会扰乱您的工作环境，这与for环形。同样适用于replicate。另请参阅这个问题：

R 的 apply 系列不仅仅是语法糖吗？ https://stackoverflow.com/questions/2275896/is-rs-apply-family-more-than-syntactic-sugar

原因是你的lapply解决方案要慢得多，是因为您使用它的方式会产生更多开销。

• replicate只不过是sapply在内部，所以你实际上结合了sapply and lapply来实现你的双循环。sapply会产生额外的开销，因为它必须测试结果是否可以简化。所以一个for循环实际上比使用更快replicate.
• 在你的里面lapply匿名函数，您必须为每个观察访问 x 和 y 的数据帧。这意味着 - 与你的 for 循环相反 - 例如函数$每次都必须调用。
• 由于您使用这些高端函数，因此与您的“lapply”解决方案相比，您的“lapply”解决方案调用了 49 个函数for只调用 26 的解决方案。这些额外的函数lapply解决方案包括调用类似的函数match, structure, [[, names, %in%, sys.call, duplicated, ... 您不需要的所有功能for循环，因为该循环不执行任何这些检查。

如果你想知道这个额外的开销从何而来，请查看内部代码replicate, unlist, sapply and simplify2array.

您可以使用以下代码来更好地了解您在何处失去性能lapply。一行一行地运行！

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),]