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

R 如何提取前n行并使用该子集计算每个组的函数,然后计算不同组的平均值?,r,data.table,R,Data.table,这是我上一个问题的后续问题: 另一个相关职位: 我有以下数据: 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

这是我上一个问题的后续问题:

另一个相关职位:

我有以下数据:

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)
长度(myList)=12:

>myList微基准(method1(),method2())
单位:毫秒
expr最小lq平均uq最大neval
方法1()9.284757 9.655745 10.346527 9.786392 10.016470 17.044078 100
方法2()3.020508 3.176173 3.330252 3.239680 3.322644 9.895444 100
编辑:::


需要注意的是,我的
方法
函数最终将被输入到遗传优化算法中,其中
方法
将被多次调用。我的目标是能够计算
计算性能
(实际上要复杂得多:输入
dt
输出向量
性能
)的子集和
股票代码。然后将产生的
dt
字母进行分组,并计算
平均值(perf)

首先,我认为应该增加基准测试的子集计数,这样我们可以更好地看到瓶颈,因此:

sn <- 100000
我的方法类似于
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]
}

method3对不起,我不清楚你在问什么……最有效的方法是什么?我缺少更快的实现吗?您的数据已经按票证分割了吗?或者您正在拆分它,因为方法1我的数据存储在一个列表中。列表中的每一项都是一个数据。特定股票的表格我同意增加子集是一件好事,可以进行潜在的更改,以便更好地看到瓶颈。但是,我不想在
method2
中包含
rbindlist
。我的
方法
函数最终将被输入到遗传算法优化中。我试图最小化
方法中绝对必要的数量,因为优化会产生大量的函数调用。我将编辑这个问题accordingly@road_to_quantdom你的真实数据有多大?您能
rbindlist
全部列出吗?真实的计算性能有多复杂?也许该函数只是需要优化?rbindlist
ed数据为7400万行。这仍然是较大数据的一个子集(尽管其本身就足够了),我不确定是否能够
rbindlist
整个数据
calc_perf
需要创建3列向量,以及
dt
中其他4列的信息。似乎将我的函数更改为使用
:=
是提高速度的最佳方法。将一个需要输入
dt
的函数更改为一个需要如此多列向量列表的函数,感觉很奇怪names@road_to_quantdom也许您可以为
计算性能
函数优化创建单独的问题,提供真实的代码?如果您将示例尽可能贴近实际,并提供您正在进行的实际操作,那么它也会有所帮助
> 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
sn <- 100000
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]
}
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