Início / coding / Perguntas / 79279702
Accepted
ivo Welch
Asked: 2024-12-14 06:17:01 +0800 CST

Mais rápido que o `simplify2array` do R?

  • 772

Muitas vezes tenho um código que se parece com

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, ... } )

Então, estou testando:

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()é muito bom, cerca de 8 vezes mais rápido que do.call("rbind"). ainda assim, ainda estou me perguntando se há uma maneira de escrever uma versão especializada mais rápida que simplify2array()se baseie no fato de que os resultados são NULL ou todos no mesmo quadro de dados. presumivelmente não, mas pensei em perguntar.

1 respostas

  1. Best Answer

    Você pode tentar unlist() |> array() |> t()remover possíveis overheads (veja lapply2 abaixo) ou ou unlist() |> matrix(byrow=TRUE)para evitar transposição (veja lapply3 ). No entanto, em vez de by()você pode usar split() |> lapply() |> simplify2array() |> t()or split() |> sapply() |> t(), já que sapply()é como lapply()com integrado simplify2array(), or vapply():

    Referência

    $ Rscript --vanilla foo.R
Unit: milliseconds
    expr      min       lq     mean   median       uq      max neval cld
      by 759.6597 775.2684 833.4783 828.0770 854.1466 983.1176    10   a
  lapply 747.4017 753.7931 812.9594 824.6948 842.5910 893.2388    10   a
 lapply2 763.0132 769.7017 819.1545 811.0160 856.1791 904.2550    10   a
 lapply3 759.2881 777.8115 822.4855 826.9304 833.3351 945.4514    10   a
  sapply 764.3702 785.1906 805.3541 802.4946 821.7591 858.9353    10   a
  vapply 744.5296 746.5801 780.0658 767.1196 810.6612 840.4624    10   a

    insira a descrição da imagem aqui

    Depende exatamente do que você faz *apply()e se a troca é benéfica para escrever código personalizado.

    Código

    set.seed(42)
mtcarsh <- mtcars[sample.int(nrow(mtcars), 1e6, 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(),
  lapply3=split(mtcarsh, mtcarsh$am) |> lapply(colMeans) |> unlist() |> 
    matrix(c(n, m), byrow=TRUE) |> `dimnames<-`(list(unique(mtcarsh$am), colnames(mtcarsh))),
  sapply=split(mtcarsh, mtcarsh$am) |> sapply(colMeans) |> t(),
  vapply=split(mtcarsh, mtcarsh$am) |> vapply(colMeans, FUN.VALUE=numeric(m)) |> t(),
  check='equal', times=10L
)
    • 1

relate perguntas