我有一个包含多行的输入数据框.对于每一行,我想应用一个函数.输入数据框有1,000,000多行.如何使用加速零件加速lapply ?我想避免应用函数系列,因为有效的方法将函数应用于数据帧的每一行并返回数据帧列表,因为这些方法似乎在我的情况下很慢.
这是一个具有简单功能的可重现示例:
library(tictoc) # enable use of tic() and toc() to record time taken for test to compute
func <- function(coord, a, b, c){
X1 <- as.vector(coord[1])
Y1 <- as.vector(coord[2])
X2 <- as.vector(coord[3])
Y2 <- as.vector(coord[4])
if(c == 0) {
res1 <- mean(c((X1 - a) : (X1 - 1), (Y1 + 1) : (Y1 + 40)))
res2 <- mean(c((X2 - a) : (X2 - 1), (Y2 + 1) : (Y2 + 40)))
res <- matrix(c(res1, res2), ncol=2, nrow=1)
} else {
res1 <- mean(c((X1 - a) : (X1 - 1), (Y1 + 1) : (Y1 + 40)))*b
res2 <- mean(c((X2 - a) : (X2 - 1), (Y2 + 1) : (Y2 + 40)))*b
res <- matrix(c(res1, res2), ncol=2, nrow=1)
}
return(res)
}
## Apply the function
set.seed(1)
n = 10000000
tab <- as.matrix(data.frame(x1 = sample(1:100, n, replace = T), y1 = sample(1:100, n, replace = T), x2 = sample(1:100, n, replace = T), y2 = sample(1:100, n, replace = T)))
tic("test 1")
test <- do.call("rbind", lapply(split(tab, 1:nrow(tab)),
function(x) func(coord = x,
a = 40,
b = 5,
c = 1)))
toc()
## test 1: 453.76 sec elapsed
Run Code Online (Sandbox Code Playgroud)
这似乎是一个很好的机会,可以在矢量化计算中进行重构和制作,R可以更快地解决.(TL; DR:这使它快了大约1000倍.)
看起来这里的任务是采用两个整数范围的加权平均值,其中范围的书挡因行而异(基于X1,X2,Y1和Y2),但序列在每行中的长度相同.这有帮助,因为这意味着我们可以使用代数来简化计算.
对于a = 40的简单情况,第一个序列将是从x1-40到x-1,从y + 1到y1 + 40.平均值将是这两者之和除以80.总和将是40*X1 + 40*Y1 +(-40:-1)之和+(1:40)之和,最后两个项取消.因此,您可以简单地输出每对列的平均值,乘以b.
library(dplyr)
b = 5
quick_test <- tab_tbl %>%
as_data_frame() %>%
mutate(V1 = (x1+y1)/2 * b,
V2 = (x2+y2)/2 * b)
Run Code Online (Sandbox Code Playgroud)
使用n = 1E6(OP的10%),OP功能需要73秒.上述功能需要0.08秒并具有相同的输出.
对于a != 40需要更多代数的情况.V1这里以加权平均值结束,我们将序列(x1-a):(x1-1)和序列相加(y1+1):(y1+40),全部除以a+40(因为序列中有a术语,x1序列中有40个术语y1.我们实际上不需要加上这个序列;我们可以使用代数将其转换为更短的计算:https://en.wikipedia.org/wiki/Arithmetic_progression
sum of (x1-a):(x1-1)= x1*a + sum of (-a:-1)= x1*a + a*(-a + -1)/2=x1*a - (a*a + a)/2
这意味着我们可以完全复制任何积极的代码a:
a = 50
b = 5
tictoc::tic("test 2b")
quick_test2 <- quick_test <- tab %>%
as_data_frame() %>%
mutate(V1 = (a*x1 - (a*a + a)/2 + 40*y1 + 820)/(a+40)*b,
V2 = (a*x2 - (a*a + a)/2 + 40*y2 + 820)/(a+40)*b)
tictoc::toc()
Run Code Online (Sandbox Code Playgroud)
这大约快了1000倍.当n = 1E6,a = 41,b = 5,c = 1时,OP解决方案在我的2012笔记本电脑上花了154秒,而quick_test2上面花了0.23秒并且结果相同.
(小附录,你可以添加一个测试来设置b = 1,如果c == 0,然后你已经处理了if-else条件.)