如何在 R 中使用 with() 函数而不是 apply()

How to use with() function in R instead of apply()

我正在尝试优化我使用 apply() 和类似函数(例如 lapply())编写的代码。不幸的是,我没有看到太多改进,所以搜索时我遇到了这个 post apply() is slow - how to make it faster or what are my alternatives? ,其中建议使用函数 with() 而不是 apply() ,这肯定要快得多。

我想要做的是将用户定义的函数应用于矩阵的每一行。此函数将行中的数据作为输入,进行一些计算并 returns 一个包含结果的向量。 我使用 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 是最有效的方法,有没有一种方法可以让我正确使用它而无需事后绑定结果?它完成了工作,但我觉得编码效率不高。

您提供的第一个和第三个函数一次应用于一行,因此在您的示例中调用了 10 次。第二个函数利用了 R 中的乘法和加法 已经 矢量化的事实,因此不需要使用任何形式的循环或层函数。该函数只被调用一次。如果您想使用当前代码,只需将 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
}