lapply vs for loop - Performance R

时间:2017-02-22 14:02:23

标签: r performance lapply

通常说人们应该更喜欢lapply超过for次循环。 例如Hadley Wickham在他的Advance R书中指出了一些例外。

http://adv-r.had.co.nz/Functionals.html)(就地修改,递归等)。 以下是这种情况之一。

为了学习,我试图以功能形式重写感知器算法以进行基准测试 相对表现。 来源(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

第一个功能是lapply / replicate功能

第二个是带有for循环的函数

第三个是使用C++

Rcpp中的相同功能

根据罗兰的功能概况。 我不确定我能以正确的方式解释它。 在我看来,大部分时间花在子集上 Function profiling

2 个答案:

答案 0 :(得分:33)

首先,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中相反 - 例如,每次都必须调用函数$
  • 因为您使用了这些高端功能,所以您需要使用这些功能。与只调用26的for解决方案相比,解决方案调用49个函数。lapply解决方案的这些额外函数包括调用matchstructure,{{1}等函数}},[[names%in%sys.call,... 您duplicated循环不需要的所有功能都不会执行任何这些检查。

如果您想查看额外开销的来源,请查看forreplicateunlistsapply的内部代码。

您可以使用以下代码更好地了解使用simplify2array丢失效果的位置。逐行运行!

lapply

答案 1 :(得分:1)

实际上,

我确实测试了一个最近解决的问题的差异。

只需尝试一下。

我的结论没有什么区别,但是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