使用自定义函数加速应用,转换为 lapply?
Speed up apply with custom function, convert to lapply?
我正在尝试加快涉及通过自定义函数将两个数据框中的行相乘的工作流程。
现在我正在使用带有自定义函数的 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 的非常快的矩阵运算...
您可以一次创建所有的 xb 模型
xb <- as.matrix(d2[, -1]) %*% t(as.matrix(d1)) + d2[, 1]
这将生成一个 3*1000 矩阵。
然后你可以用
得到概率
prob <- exp(xb[1, ]) / (1 + colSums(exp(xb)))
这一切在我的机器上花费的时间几乎为零!
我正在尝试加快涉及通过自定义函数将两个数据框中的行相乘的工作流程。
现在我正在使用带有自定义函数的 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 的非常快的矩阵运算...
您可以一次创建所有的 xb 模型
xb <- as.matrix(d2[, -1]) %*% t(as.matrix(d1)) + d2[, 1]
这将生成一个 3*1000 矩阵。
然后你可以用
得到概率prob <- exp(xb[1, ]) / (1 + colSums(exp(xb)))
这一切在我的机器上花费的时间几乎为零!