我可以使用Rcpp加速我的R代码吗?

时间:2018-07-22 18:24:32

标签: r performance for-loop matrix rcpp

我定义了一个R函数,其中包含一个矩阵,一个向量和一个参数a。我需要为a的不同值计算函数的结果。用R编写代码很简单,但是当矩阵为“大”且参数值的数量很大时,速度很慢。

我可以在R中定义函数并在Rcpp中进行for循环吗?

它可以加快计算速度吗?

foo中的R函数的一个最小示例是

f <- function(X,y,a){
  p = ncol(X)
  res = (crossprod(X) + a*diag(1,p))%*%crossprod(X,y)
  }

set.seed(0)
X <- matrix(rnorm(50*5),50,5)
y <- rnorm(50)
a <- seq(0,1,0.1)

result <- matrix(NA,ncol(X),length(a))

for(i in 1:length(a)){                  # Can I do this part in Rcpp?
  result[,i] <- f(X,y,a[i])
  }

result

2 个答案:

答案 0 :(得分:6)

我只是建议避免在循环中重新计算X'XX'y ,因为它们是不变的。

f <- function (XtX, Xty, a) (XtX + diag(a, ncol(XtX))) %*% Xty

set.seed(0)
X <- matrix(rnorm(50*5),50,5)
y <- rnorm(50)
a <- seq(0,1,0.1)

result1 <- matrix(NA, ncol(X), length(a))

XtX <- crossprod(X)
Xty <- crossprod(X, y)

for(i in 1:length(a)) {
  result1[,i] <- f(XtX, Xty, a[i])
  }

## compare with your `result`
all.equal(result, result1)
#[1] TRUE

小时后...

当我回来时,我看到了更多需要简化的东西。

(XtX + diag(a, ncol(XtX))) %*% Xty = XtX %*% Xty + diag(a, ncol(XtX)) %*% Xty
                                   = XtX %*% Xty + a * Xty

实际上,XtX %*% Xty也是循环不变的。

f <- function (XtX.Xty, Xty, a) XtX.Xty + a * Xty

set.seed(0)
X <- matrix(rnorm(50*5),50,5)
y <- rnorm(50)
a <- seq(0,1,0.1)

result2 <- matrix(NA, ncol(X), length(a))

XtX <- crossprod(X)
Xty <- c(crossprod(X, y))  ## one-column matrix to vector
XtX.Xty <- c(XtX %*% Xty)  ## one-column matrix to vector

for(i in 1:length(a)) {
  result2[,i] <- f(XtX.Xty, Xty, a[i])
  }

## compare with your `result`
all.equal(result, result2)
#[1] TRUE

事实证明,我们可以摆脱循环:

## "inline" function `f`
for(i in 1:length(a)) {
  result2[,i] <- XtX.Xty + a[i] * Xty
  }

## compare with your `result`
all.equal(result, result2)
#[1] TRUE

## do it with recycling rule
for(i in 1:length(a)) {
  result2[,i] <- a[i] * Xty
  }
result2 <- XtX.Xty + result2

## compare with your `result`
all.equal(result, result2)
#[1] TRUE

## now use `tcrossprod`
result2 <- XtX.Xty + tcrossprod(Xty, a)

## compare with your `result`
all.equal(result, result2)
#[1] TRUE

我完全同意您的观点,您在问题中的示例代码只是"foo"。并且您在发布时可能没有仔细考虑过。但是,足以表明在编写循环(R循环或C / C ++ / FORTRAN循环)时,我们应该始终设法将那些循环不变式拉出循环以降低计算复杂性。

您所关心的是使用Rcpp(或任何编译语言)加快速度。您想对不容易向量化的R代码段进行向量化。但是,"%*%"crossprodtcrossprod映射到BLAS(FORTRAN代码),而不是R级计算。您可以轻松地将所有向量化。

不要总是把R循环的解释开销(归因于R是一种解释语言)归咎于性能不佳。如果每次迭代都在进行一些“繁重”的计算,例如大矩阵计算(使用BLAS)或拟合统计模型(例如lm),则这种开销是微不足道的。实际上,如果您确实想用编译语言编写这样的循环,请使用lapply函数。该函数在C级别实现循环,并为每次迭代调用R函数。另外,Ralf's answer是等效的Rcpp。我认为,用R代码编写的循环嵌套更有可能效率低下。

答案 1 :(得分:3)

李哲源的回答正确地确定了您的情况下应该采取的措施。至于您最初的问题,答案有两个:是的,您可以使用Rcpp将循环移至C ++。不,您不会获得性能:

#include <Rcpp.h>

// [[Rcpp::export]]
Rcpp::NumericMatrix fillMatrix(Rcpp::NumericMatrix X,
                   Rcpp::NumericVector y,
                   Rcpp::NumericVector a,
                   Rcpp::Function f) {
  Rcpp::NumericMatrix result = Rcpp::no_init(X.cols(), a.length());
  for (int i = 0; i < a.length(); ++i) {
    result(Rcpp::_, i) = Rcpp::as<Rcpp::NumericVector>(f(X, y, a[i]));
  }
  return result;
}

/*** R
f <- function(X,y,a){
  p = ncol(X)
  res = (crossprod(X) + a*diag(1,p))%*%crossprod(X,y)
  }

X <- matrix(rnorm(500*50),500,50)
y <- rnorm(500)
a <- seq(0,1,0.01)

system.time(fillMatrix(X, y, a, f))
#   user  system elapsed 
#  0.052   0.077   0.075 
system.time({result <- matrix(NA,ncol(X),length(a))

for(i in 1:length(a)){
  result[,i] <- f(X,y,a[i])
  }
})
#   user  system elapsed 
#  0.060   0.037   0.049 
*/

因此,在这种情况下,Rcpp解决方案实际上比R解决方案要慢。为什么?因为实际工作是在函数f中完成的。这两种解决方案都是相同的,但是Rcpp解决方案具有从C ++回调到R的额外开销。请注意,for loops in R are not necessarily slow。顺便说一句,这里是一些基准数据:

          expr      min       lq     mean   median       uq      max neval
 fillMatrixR() 41.22305 41.86880 46.16806 45.20537 49.11250 65.03886   100
 fillMatrixC() 44.57131 44.90617 49.76092 50.99102 52.89444 66.82156   100