我正在尝试优化我使用apply()和类似函数(例如lapply())编写的代码。不幸的是,我没有看到太多改进所以搜索我遇到了这篇文章apply() is slow - how to make it faster or what are my alternatives?,其中一个建议是使用函数with()而不是apply(),这当然要快得多。
我想要做的是将用户定义的函数应用于矩阵的每一行。此函数将行中的数据作为输入,进行一些计算并返回带有结果的向量。 一个玩具示例,我使用apply()函数,with()和矢量化版本:
#Generate a matrix 10x3
prbl1=matrix(runif(30),nrow=10)
prbl2=data.frame(prbl1)
prbl3=prbl2
#function for the apply()
fn1=function(row){
x=row[1]
y=row[2]
z=row[3]
k1=2*x+3*y+4*z
k2=2*x*3*y*4*z
k3=2*x*y+3*x*z
return(c(k1,k2,k3))
}
#function for the with()
fn2=function(x,y,z){
k1=2*x+3*y+4*z
k2=2*x*3*y*4*z
k3=2*x*y+3*x*z
return(c(k1,k2,k3))
}
#Vectorise fn2
fn3=Vectorize(fn2)
#apply the functions:
rslt1=t(apply(prbl1,1,fn1))
rslt2=t(with(prbl2,fn2(X1,X2,X3)))
rslt2=cbind(rslt2[1:10],rslt2[11:20],rslt2[21:30])
rslt3=t(with(prbl3,fn3(X1,X2,X3)))
所有三个产生相同的输出,矩阵10x3这是我想要的。然而,请注意 rslt2 我需要绑定结果,因为使用with()的输出是一个长度为300的向量。我怀疑这是因为函数没有被矢量化(如果我理解正确的话)。在rslt3中,我使用的是fn2的矢量化版本,它以预期的方式生成输出。
当我比较三者的表现时,我得到:
library(rbenchmark)
benchmark(rslt1=t(apply(prbl1,1,fn1)),
rslt2=with(prbl2,fn2(X1,X2,X3)),
rslt3=with(prbl3,fn3(X1,X2,X3)),
replications=1000000)
test replications elapsed relative user.self sys.self user.child sys.child
1 rslt1 1000000 103.51 7.129 102.63 0.02 NA NA
2 rslt2 1000000 14.52 1.000 14.41 0.01 NA NA
3 rslt3 1000000 123.44 8.501 122.41 0.05 NA NA
其中with()没有矢量化肯定更快。
我的问题:由于rslt2是最有效的方法,有没有一种方法可以正确使用它,而不需要事后绑定结果?它完成了工作,但我觉得编码效率不高。
答案 0 :(得分:2)
您提供的第一个和第三个函数一次应用一行,因此在您的示例中调用10次。第二个功能是利用R中的乘法和加法已经矢量化的事实,因此不需要使用任何形式的循环或ply函数。该函数只调用一次。如果您想使用当前代码,您只需将fn2中的c
更改为cbind
。
fn2=function(x,y,z){
k1=2*x+3*y+4*z
k2=2*x*3*y*4*z
k3=2*x*y+3*x*z
return(cbind(k1,k2,k3))
}
with
做的所有事情都是评估给出的列表,data.frame或环境中给出的表达式。因此with(prbl2,fn2(X1,X2,X3))
完全等同于fn2(prbl2$X1, prbl2$X2, prbl2$X3)
。
这是你真正的功能吗?如果是,那么问题就解决了。如果没有,那么它取决于你的真实函数是否完全由已经被矢量化的操作和函数组成,或者可以用矢量化等价物替换。
根据评论修改的功能:
fn1 <- function(row){
x <- row[1]
y <- row[2]
z <- row[3]
k1 <- 2*x+3*y+4*z
k2 <- 2*x*3*y*4*z
k3 <- 2*x*y+3*x*z
if (k1>0 & k2>0 &k3>0){
return(cbind(k1,k2,k3))
} else {
k1 <- 5*x+3*y+4*z
k2 <- 5*x*3*y*4*z
k3 <- 5*x*y+3*x*z
if (k1<0 || k2<0 || k3<0) {
return(cbind(0,0,0))
} else {
return(cbind(k1,k2,k3))
}
}
}
fn2 <- function(mat) {
x <- mat[, 1]
y <- mat[, 2]
z <- mat[, 3]
k1 <- 2*x+3*y+4*z
k2 <- 2*x*3*y*4*z
k3 <- 2*x*y+3*x*z
l1 <- 5*x+3*y+4*z
l2 <- 5*x*3*y*4*z
l3 <- 5*x*y+3*x*z
out <- array(0, dim = dim(mat))
useK <- k1 > 0 & k2 > 0 & k3 > 0
useL <- !useK & l1 >= 0 & l2 >= 0 & l3 >= 0
out[useK, ] <- cbind(k1, k2, k3)[useK, ]
out[useL, ] <- cbind(l1, l2, l3)[useL, ]
out
}