我不确定这是“多线程”,但也许您打算包含多核解决方案?如果是这样,那么看看这个较早的答案:通过搜索“[r] [data.table] 并行”找到的R 中的数据子集执行计算
编辑:(在 4 核机器上速度加倍,但我的系统监视器建议在mclapply
通话期间仅使用 2 个内核。)从该线程复制的代码:http ://r.789695.n4.nabble.com/Access-to -local-variables-in-quot-j-quot-expressions-tt2315330.html#a2315337
calc.fake.dt.mclapply <- function (dt) {
mclapply(6*c(1000,1:4,6,8,10),
function(critical.age) {
dt$tmp <- pmax((dt$age < critical.age) * dt$x, 0)
dt[, cumsum.lag(tmp), by = grp]$V1})
}
mk.fake.df <- function (n.groups=10000, n.per.group=70) {
data.frame(grp=rep(1:n.groups, each=n.per.group),
age=rep(0:(n.per.group-1), n.groups),
x=rnorm(n.groups * n.per.group),
## These don't do anything, but only exist to give
## the table a similar size to the real data.
y1=rnorm(n.groups * n.per.group),
y2=rnorm(n.groups * n.per.group),
y3=rnorm(n.groups * n.per.group),
y4=rnorm(n.groups * n.per.group)) }
df <- mk.fake.df
df <- mk.fake.df()
calc.fake.dt.lapply <- function (dt) { # use base lapply for testing
lapply(6*c(1000,1:4,6,8,10),
function(critical.age) {
dt$tmp <- pmax((dt$age < critical.age) * dt$x, 0)
dt[, cumsum.lag(tmp), by = grp]$V1})
}
mk.fake.dt <- function (fake.df) {
fake.dt <- as.data.table(fake.df)
setkey(fake.dt, grp, age)
fake.dt
}
dt <- mk.fake.dt()
require(data.table)
dt <- mk.fake.dt(df)
cumsum.lag <- function (x) {
x.prev <- c(0, x[-length(x)])
cumsum(x.prev)
}
system.time(res.dt.mclapply <- calc.fake.dt.mclapply(dt))
user system elapsed
1.896 4.413 1.210
system.time(res.dt.lapply <- calc.fake.dt.lapply(dt))
user system elapsed
1.391 0.793 2.175