使用自定义函数加速应用，转换为 lapply？答案

【问题标题】：Speed up apply with custom function, convert to lapply?使用自定义函数加速应用，转换为 lapply？
【发布时间】：2020-01-25 16:38:21
【问题描述】：

我正在尝试加快工作流程，该工作流程涉及通过自定义函数将两个数据帧中的行相乘。

现在我正在使用带有自定义函数的 apply()。我的理解是 lapply() 或 sapply() 会更快（并最终允许并行化，尽管我更喜欢不依赖于并行处理的加速），但我无法弄清楚 lapply() 或 sapply( ) 语法我应该与我的自定义函数一起使用。如果有更简单的方法来矢量化自定义函数并完全避免 *apply()，那将是首选。

我的用例中的行数将达到 100 万或更多，列数将在 15 左右，但这里有一个 MWE 说明了速度问题：

# Two data frames that will be used in the calculation. d2 can be a matrix, but d1 must be a data frame.
d1 <- data.frame(V1 = runif(1000), V2 = runif(1000), V3 = runif(1000), V4 = runif(1000))
d2 <- data.frame(Va = runif(3), V1 = runif(3), V2 = runif(3), V3 = runif(3), V4 = runif(3))

# Custom function that is applied to each row in d1
manualprob <- function(x){

    xb1 <- as.numeric(rowSums(d2[1,2:ncol(d2)] * x) + d2[1,1])
    xb2 <- as.numeric(rowSums(d2[2,2:ncol(d2)] * x) + d2[2,1])
    xb3 <- as.numeric(rowSums(d2[3,2:ncol(d2)] * x) + d2[3,1])

    denom <- 1 + exp(xb1) + exp(xb2) + exp(xb3)
    prob <- exp(xb1)/denom

    return(prob)
    }

# apply() used below, but it is too slow
start_time <- proc.time()

d1$prob <- as.vector(apply(d1, 1, manualprob))

proc.time() - start_time
   user  system elapsed 
  1.081   0.007   1.088

【问题讨论】：

标签： r apply lapply sapply

【解决方案1】：

最好的办法是转换为矩阵并使用 R 非常快速的矩阵运算...

您可以一次性创建所有 xb 人物

xb <- as.matrix(d2[, -1]) %*% t(as.matrix(d1)) + d2[, 1]

这会产生一个 3*1000 的矩阵。

然后你可以得到概率

prob <- exp(xb[1, ]) / (1 + colSums(exp(xb)))

这一切在我的机器上花费的时间几乎为零！

【讨论】：

完美！谢谢！