data.table

Question

我有点被这个问题搞糊涂了。我有一个 beta 分布参数的数据 table，数据中的每一行 table 对应于该分布的相对概率以表示实际结果。

我想计算多个样本值的累积分布函数。使用 sapply，代码如下所示：

beta_dists <- data.table(data.frame(probs = c(0.4,0.3,0.3), a = c(0.0011952,0.001,0.00809), b = c(837,220,624), scale = c(1.5e9,115e6,1.5e6)))
xx <- seq(0,1.5e9,length = 2^12)

system.time(FX <- sapply(xx, function(x) (beta_dists[x < scale,.(FX = sum(probs * (1 - pbeta(x / scale, a, b))))])$FX))

但是，这很慢，而且看起来不是很优雅......有什么想法可以让它变得更好吗？

Answer 1

我唯一的想法是换一种方式，即压缩包含样本值的数据 table：

dt <- data.table(x = xx, res = 0)
f <- function(x) {
  beta_dists[x < scale, sum(probs * (1 - pbeta(x / scale, a, b)))]
}
system.time(dt[, res := vapply(x, f, 0)])

好像稍微快点。例如，当我将您的样本量增加到 2^14 时，您的原始代码运行在我的机器上运行了 7 秒，但我建议的代码在 5 秒内完成。

我认为最慢的部分是 pbeta() 函数，但我可能错了。

Answer 2

这里建议通过将 xx 转换为 data.table 以在 i 中使用来使用非等值连接：

ans <- beta_dists[dtx, on=.(scale > x), allow.cartesian=TRUE,
    sum(probs * (1 - pbeta(x / x.scale, a, b))), by=.EACHI]$V1

检查：

#last element is NA in ans whereas its NULL in FX
identical(unlist(FX), head(ans$V1, -1))
#[1] TRUE

时间码：

opmtd <- function() {
    sapply(xx, function(x) (beta_dists[x < scale,.(FX = sum(probs * (1 - pbeta(x / scale, a, b))))])$FX)
}

nonequiMtd <- function() {
    beta_dists[dtx, on=.(scale > x), allow.cartesian=TRUE, sum(probs * (1 - pbeta(x / x.scale, a, b))), by=.EACHI]   
}

vapplyMtd <- function() {
    dt[, res := vapply(x, f, 0)]
}

library(microbenchmark)
microbenchmark(opmtd(), nonequiMtd(), vapplyMtd(), times=3L)

时间：

Unit: milliseconds
         expr        min         lq       mean     median         uq        max neval
      opmtd() 2589.67889 2606.77795 2643.77975 2623.87700 2670.83018 2717.78336     3
 nonequiMtd()   19.59376   21.12739   22.28428   22.66102   23.62954   24.59805     3
  vapplyMtd() 1928.25841 1939.91866 1960.31181 1951.57891 1976.33852 2001.09812     3

数据：

library(data.table)
beta_dists <- data.table(probs = c(0.4,0.3,0.3), a = c(0.0011952,0.001,0.00809), b = c(837,220,624), scale = c(1.5e9,115e6,1.5e6))
xx <- seq(0, 1.5e9, length = 2^12)
dtx <- data.table(x=xx)

data.table - 应用值向量

data.table - apply vector of values

r

sapply