比 R 的 `simplify2array` 更快？

Question

我经常有这样的代码

rbind.oc.by <- function (indata, INDICES, FUN, ...) {
    result <- by( indataframe, INDICES, FUNIN, ... )
    t(simplify2array(result))
}

mynewdata <- rbind.oc.by( dataframe, dataframe$variable, function(dd) { with(dd, ... } )

所以，我正在测试它：

set.seed(0)
if (!exists("X")) {
    X <- lapply( 1:10000000, function(i) {
        c(a=rnorm(1), b=rnorm(1), x="A", y= as.logical(rnorm(1)))
    })
}

## R CMD Rprof testprof.out                                                                                                         
Rprof("testprof.out")

intimealloc <- function() {
    as.data.frame(do.call("rbind", X))
}
v1 <- intimealloc()

firstalloc <- function() {
    simplify2array( t( X ))
}
v2 <- firstalloc()

Rprof(NULL)

simplify2array()

相当不错，比

do.call("rbind")

快大约8倍。 然而，我仍然想知道是否有一种方法可以编写更快的专用版本

simplify2array()

，它依赖于结果为 NULL 或全部相同的数据帧这一事实。 大概不是，但我想我会问。

Answer 1

您可以尝试

unlist() |> array() |> t()

消除可能的开销（请参阅下面的 lapply2）。但是，您可以使用

by()

或

split() |> lapply() |> simplify2array() |> t()

代替

split() |> sapply() |> t()

，因为

sapply()

就像集成了

lapply()

的

simplify2array()

一样。不知道为什么

vapply

看起来更慢，但是当你查看 uq 和 max 时，它的传播更小：

基准

$ Rscript --vanilla foo.R
Unit: milliseconds
    expr      min       lq     mean   median        uq       max neval cld
      by 797.7415 815.5982 871.1987 858.3829  901.6655  999.4441    10   a
  lapply 769.1458 795.3367 853.0496 850.1459  869.8640  982.7607    10   a
 lapply2 790.1099 810.6512 926.7983 855.6525 1072.4285 1160.0298    10   a
  sapply 783.4590 796.9926 867.9458 839.7738  888.2652 1031.2070    10   a
  vapply 778.5111 831.9483 855.6110 864.7271  882.6614  899.1652    10   a

代码

set.seed(42)
mtcarsh <- mtcars[sample.int(nrow(mtcars), 1e3, replace=TRUE), ]
n <- length(unique(mtcarsh$am))
m <- ncol(mtcarsh)
microbenchmark::microbenchmark(
  by=by(mtcarsh, mtcarsh$am, colMeans) |> do.call(what='rbind'),
  lapply=split(mtcarsh, mtcarsh$am) |> lapply(colMeans) |> simplify2array() |> t(),
  lapply2=split(mtcarsh, mtcarsh$am) |> lapply(colMeans) |> unlist() |> 
    array(c(m, n), list(colnames(mtcarsh), unique(mtcarsh$am))) |> t(),
  sapply=split(mtcarsh, mtcarsh$am) |> sapply(colMeans) |> t(),
  vapply=split(mtcarsh, mtcarsh$am) |> vapply(colMeans, FUN.VALUE=numeric(m)) |> t(),
  check='equal', times=3L
)