这是我上一个问题的后续: 如何提取每组的前 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 计算我的函数,rbindlist 结果,然后按组 2 计算平均值?
还是我想先重新列出我的整个数据,预先选择子集行,然后按组 1 计算我的函数,然后按组 2 计算平均值?
# 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
长度(myList( = 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
编辑:::
需要注意的一件事是,我的method
函数最终将被输入到遗传优化算法中,其中method
将被调用多次。我的目标是能够按子集和ticker
计算calc_perf
(实际上更复杂:输入dt
输出向量perf
(。然后按letters
对结果dt
进行分组并计算mean(perf)
。
首先,我认为应该增加基准的子集计数,这样我们才能更好地看到瓶颈,因此:
sn <- 100000
其次,在对标时,我认为rbindlist
应该包含在method2
中,所以:
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]
}
我的方法,类似于method1
,但性能计算的实现方式不同:
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