Question

这篇文章是关于使用Rcpp包来加速R代码以避免递归循环。

我的输入由以下示例（长度7）定义，该示例是我使用的data.frame（长度51673）的一部分：

S=c(906.65,906.65,906.65,906.65,906.65,906.65,906.65)
T=c(0.1371253,0.1457896,0.1248953,0.1261278,0.1156931,0.0985253,0.1332596)
r=c(0.013975,0.013975,0.013975,0.013975,0.013975,0.013975,0.013975)             
h=c(0.001332596,0.001248470,0.001251458,0.001242143,0.001257921,0.001235755,0.001238440)       
P=c(3,1,5,2,1,4,2)
A= data.frame(S=S,T=T,r=r,h=h,P=P)

         S         T        r           h   Per 
1   906.65 0.1971253 0.013975 0.001332596   3   
2   906.65 0.1971253 0.013975 0.001248470   1   
3   906.65 0.1971253 0.013975 0.001251458   5   
4   906.65 0.1971253 0.013975 0.001242143   2   
5   906.65 0.1971253 0.013975 0.001257921   1   
6   906.65 0.1971253 0.013975 0.001235755   4  
7   906.65 0.1971253 0.013975 0.001238440   2

参数是：

w=0.001; b=0.2; a=0.0154; c=0.0000052; neta=-0.70

我有以下要使用的函数代码：

F<-function(x,w,b,a,c,neta,S,T,r,P){
    u=1i*x 
    nu=(1/(neta^2))*(((1-2*neta)^(1/2))-1)
    # Recursion back to time t
    # Terminal condition for the A and B 
    A_Q=0
    B_Q=0
    steps<-round(T*250,0)  

    for (j in 1:steps){
      A_Q= A_Q+ r*u + w*B_Q-(1/2)*log(1-2*a*(neta^4)*B_Q)
      B_Q= b*B_Q+u*nu+ (1/neta^2)*(1-sqrt((1-2*a*(neta^4)*B_Q)*( 1- 2*c*B_Q - 2*u*neta)))
    }
    F= exp(log(S)*u + A_Q + B_Q*h[P])
  return(F)
}

S = A$S ; r= A$r ; T= A$T ; P=A$P;  h= A$h

然后我想使用我的Data.set应用前一个函数a长度为N = 100000的向量：

  Z=length(S); N=100000  ; alpha=2 ; delta= 0.25     
  lambda=(2*pi)/(N*delta) 

res = matrix(nrow=N, ncol=Z)
  for (i in 1:N){
    for (j in 1:Z){
      res[i,j]= Re(F(((delta*(i-1))-(alpha+1)*1i),w,b,a,c,neta,S[j],T[j],r[j],P[j]))
    }
  }

但这需要花费很多时间：N = 100执行这行代码需要20秒，但我想执行N = 100000次，总运行时间可能需要数小时。如何使用Rcpp微调上面的代码，以减少执行时间并获得高效的程序？

是否可以缩短执行时间，如果是这样，请提出一个解决方案，即使没有Rcpp。

感谢。

Answer 1

利用Armadillo library中的F和vec类（通过cx_vec访问），您的函数RcppArmadillo可以很容易地转换为C ++包） - 它对矢量化计算有很大的支持。

#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]

// [[Rcpp::export]]
arma::cx_vec Fcpp(const arma::cx_vec& x, double w, double b, double a, double c,
                  double neta, const arma::vec& S, const arma::vec& T, 
                  const arma::vec& r, Rcpp::IntegerVector P, Rcpp::NumericVector h) {

  arma::cx_vec u = x * arma::cx_double(0.0,1.0);

  double nu = (1.0/std::pow(neta,2.0)) * (std::sqrt(1.0-2.0*neta)-1.0);
  arma::cx_vec A_Q(r.size());
  arma::cx_vec B_Q(r.size()); 
  arma::vec steps = arma::round(T*250.0);

  for (size_t j = 0; j < steps.size(); j++) {
    for (size_t k = 0; k < steps[j]; k++) {
      A_Q = A_Q + r*u + w*B_Q - 
              0.5*arma::log(1.0 - 2.0*a*std::pow(neta,4.0)*B_Q);
      B_Q = b*B_Q + u*nu + (1.0/std::pow(neta,2.0)) * 
              (1.0 - arma::sqrt((1.0 - 2.0*a*std::pow(neta,4.0)*B_Q) *
                (1.0 - 2.0*c*B_Q - 2.0*u*neta)));
    }
  }

  arma::vec hP = Rcpp::as<arma::vec>(h[P-1]);
  arma::cx_vec F = arma::exp(arma::log(S)*u + A_Q + B_Q*hP);

  return F;
}

需要注意的几个小改动：

我使用arma::函数进行矢量化计算，例如arma::log，arma::exp，arma::round，arma::sqrt以及各种重载运算符（ *，+，-）;但使用std::pow和std::sqrt进行标量计算。在R中，这是从我们这里抽象出来的，但在这里我们必须区分这两种情况。
您的函数F有一个循环 - for (i in 1:steps) - 但C ++版本有两个，这是因为两种语言之间的循环语义不同。
大多数输入向量是arma::类（与使用Rcpp::NumericVector和Rcpp::ComplexVector相反），例外是P和h，因为Rcpp向量提供类似R的元素访问 - 例如h[P-1]。还要注意P需要偏移1（在C ++中基于0的索引），然后使用hP转换为Armadillo向量（Rcpp::as<arma::vec>），因为编译器会抱怨您尝试将cx_vec乘以NumericVector（B_Q*hP）。
我添加了一个函数参数h - 依靠全局变量h的存在并不是一个好主意，你在F中进行了这种操作。如果需要在函数体中使用它，则应将其传递给函数。

我将您的函数名称更改为Fr，并使基准测试更容易一些，我只是将您的双循环包裹起来，将矩阵res填充到函数Fr和{ {1}}：

Fcpp

我比较了loop_Fr <- function(mat = res) { for (i in 1:N) { for (j in 1:Z) { mat[i,j]= Re(Fr(((delta*(i-1))-(alpha+1)*1i),w,b,a,c,neta,S[j],T[j],r[j],P[j],h)) } } return(mat) } loop_Fcpp <- function(mat = res) { for (i in 1:N) { for (j in 1:Z) { mat[i,j]= Re(Fcpp(((delta*(i-1))-(alpha+1)*1i),w,b,a,c,neta,S[j],T[j],r[j],P[j],h)) } } return(mat) } ## R> all.equal(loop_Fr(),loop_Fcpp()) [1] TRUE，N = 100和N = 1000的两个函数（永远都是这样） - 相应地调整了N = 100000和lambda，但保留了所有内容否则一样。一般来说，res比我计算机上的Fcpp快约10倍：

Fr

N <- 100
lambda <- (2*pi)/(N*delta)
res <- matrix(nrow=N, ncol=Z)
##
R> microbenchmark::microbenchmark(loop_Fr(), loop_Fcpp(),times=50L)
Unit: milliseconds
        expr       min        lq    median        uq       max neval
   loop_Fr() 142.44694 146.62848 148.97571 151.86318 186.67296    50
 loop_Fcpp()  14.72357  15.26384  15.58604  15.85076  20.19576    50

N <- 1000
lambda <- (2*pi)/(N*delta) 
res <- matrix(nrow=N, ncol=Z)
##
R> microbenchmark::microbenchmark(loop_Fr(), loop_Fcpp(),times=50L)
Unit: milliseconds
        expr       min        lq    median        uq       max neval
   loop_Fr() 1440.8277 1472.4429 1491.5577 1512.5636 1565.6914    50
 loop_Fcpp()  150.6538  153.2687  155.4156  158.0857  181.8452    50

您问题中提供的其他变量：

N <- 100000
lambda <- (2*pi)/(N*delta)
res <- matrix(nrow=N, ncol=Z)
##
R> microbenchmark::microbenchmark(loop_Fr(), loop_Fcpp(),times=2L)
Unit: seconds
        expr       min        lq    median        uq       max neval
   loop_Fr() 150.14978 150.14978 150.33752 150.52526 150.52526     2
 loop_Fcpp()  15.49946  15.49946  15.75321  16.00696  16.00696     2

使用Rcpp的R代码的效率和速度

1 个答案: