如何使用该子集提取前n行并计算每个组的函数，然后按不同组计算平均值？

Question

这是我之前问题的后续：如何提取每个组的前n行并使用该子集计算函数？

另一篇相关文章：如何提取每组的前n行？

我有以下数据：

set.seed(1)
dt1 <- data.table(ticker="aa",letters=sample(LETTERS,10^6,T),x=rnorm(2000,100,10),y=rnorm(2000,80,20))
dt2 <- data.table(ticker="aapl",letters=sample(LETTERS,10^6,T),x=rnorm(2000,100,10),y=rnorm(2000,80,20))
dt3 <- data.table(ticker="abc",letters=sample(LETTERS,10^6,T),x=rnorm(2000,100,10),y=rnorm(2000,80,20))
myList <- list(dt1,dt2,dt3)

我想在特定索引处按组对这些数据应用一个函数，其中函数输出取决于子集化的数据帧。然后，我想用不同的分组变量对结果data.table进行分组，并取一个简单的平均值。

我是否希望首先在子集化的行上按组1计算我的函数，r bind列出结果，然后按组2计算平均值？

还是我想先rbindlist我的整个数据，预先选择子集行，然后按group1计算我的函数，然后按group2计算均值？

# data.table version of function
dt_calc_perf <- function(dt){
  buy <- ifelse(dt$x > mean(dt$y),1,0)
  dt$perf <- buy*(dt$x/dt$y-1)
  return(dt)
}
# vector return version of function
calc_perf <- function(dt){
  buy <- ifelse(dt$x > mean(dt$y),1,0)
  perf <- buy*(dt$x/dt$y-1)
  return(perf)
}

# which is faster?

# method 1
method1 <- function(){
  res1 <- rbindlist(lapply(1:length(myList), 
                           function(m) dt_calc_perf(myList[[m]][1:1000])))
  res1 <- res1[,list('perf'=mean(perf),'tickers'=paste(ticker,collapse=',')),
               by=letters]
}

# method 2
dt <- rbindlist(myList)
x <- dt[dt[,.I[1:1000],by=ticker]$V1]

method2 <- function(){
  res2 <- x[,list('letters'=letters,'perf'= calc_perf(.SD)),by=ticker]
  res2 <- res2[,list('perf'=mean(perf),'tickers'=paste(ticker,collapse=',')),
               by=letters]

}

all.equal(method1(),method2())
[1] TRUE

长度（我的列表） = 3：

 microbenchmark(method1(),method2())
Unit: milliseconds
      expr      min       lq     mean   median       uq       max neval
 method1() 2.874678 2.976673 3.181134 3.031414 3.103259 10.266646   100
 method2() 3.008534 3.150086 3.352862 3.215517 3.292495  9.901859   100

长度(myList) = 12:

> myList <- list(dt1,dt2,dt3,dt1,dt2,dt3,dt1,dt2,dt3,dt1,dt2,dt3)
> microbenchmark(method1(),method2())
Unit: milliseconds
      expr      min       lq      mean   median        uq       max neval
 method1() 9.284757 9.655745 10.346527 9.786392 10.016470 17.044078   100
 method2() 3.020508 3.176173  3.330252 3.239680  3.322644  9.895444   100

编辑::：

需要注意的一点是，我的< code>method函数最终将被输入到一个遗传优化算法中，其中< code>method将被多次调用。我的目标是能够通过子集和< code>ticker计算< code>calc_perf(实际上要复杂得多:inputs < code > dt outputs vector < code > perf )。然后将得到< code>dt按< code >字母分组，并计算< code >平均值(perf)。

Answer 1

首先，我认为应增加基准的子集计数，以便我们更好地看到瓶颈，因此：

sn <- 100000

其次，在进行基准测试时，我认为方法2中应包含仲裁列表，因此：

method2 <- function() {
  dt <- rbindlist(myList)
  x <- dt[dt[, .I[1:sn], by = ticker]$V1]
  res2 <- x[, list('letters' = letters, 'perf' = calc_perf(.SD[1:sn])),
            by = ticker]
  res2[, list('perf' = mean(perf),
              'tickers' = paste(ticker, collapse = ',')),
       by = letters]
}

我的方法，与方法1类似，但性能计算的实现方式不同：

method3 <- function() {
  require(hutils)
  dl <- lapply(myList, function(x) {
    x[1:sn][, perf := if_else(x > mean(y), x/y - 1, 0)]
  })
  x <- rbindlist(dl)
  x[, list('perf' = mean(perf),
           'tickers' = paste(ticker, collapse = ',')),
    by = letters]
}

基准：

# for data creation:
creatData <- function(x) {
  data.table(ticker = as.character(x), letters = sample(LETTERS, 10 ^ 6, T),
             x = rnorm(2000, 100, 10), y = rnorm(2000, 80, 20))
}
# create larger list:
set.seed(12)
myList <- lapply(1:40, creatData)

system.time(r1 <- method1()) # 1.84 - 2.55
system.time(r2 <- method2()) # 3.76 - 5.59
system.time(r3 <- method3()) # 1.46 - 1.62

all.equal(r1, r2) # T
all.equal(r1, r3) # T