RStudio与RcppGSL功能崩溃

时间:2018-04-01 01:52:08

标签: r rcpp

我正在努力加速我的一个R程序,用Rcpp解决得分方程的向量。由于计算这些得分方程的中间步骤需要插值和数值积分,因此我使用了RcppGSL。我已经达到了能够针对给定的一组参数值正确评估得分方程的程度,但是当我尝试用多根或nleqslv求解R中的方程时,RStudio在参数估计即将跳跃之前就崩溃了。似乎存在某种类型的内存泄漏,我敢打赌它与GSL例程(即插值所需的分配)有关。下面的“插值部分”中是否存在某些似乎错误的内容?我对Rcpp和C ++整体都很陌生,所以我很感谢你帮忙解决这个问题!

我在下面做了一个最小的例子 - 我正在使用的实际函数有更多的得分方程,并且有多个插值/积分步骤。

#include <RcppGSL.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_interp.h>
#include <gsl/gsl_multiroots.h>
#include <gsl/gsl_statistics_double.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_errno.h>

// score equation u1
double u1Ex(Rcpp::NumericVector xVals, double a, double b, int nObs)
{
    std::vector<double> scoreVals(nObs);
    double scoreValSum, val;
    int ind;
    for(ind = 0; ind < nObs; ind++)
        {
            scoreVals[ind] = xVals[ind];
        }
    scoreValSum =  std::accumulate(scoreVals.begin(), scoreVals.end(), 0.0);
    val = scoreValSum*a + pow(b,2)/2 - 5;
    return val;
}



// score equation u2
double u2Ex(Rcpp::NumericVector xvals, double a, double b, int nObs)
{
    std::vector<double> scoreVals(nObs);
    double scoreValSum, val;
    int ind;
    for(ind = 0; ind < nObs; ind++)
        {
            scoreVals[ind] = -log(xvals[ind]);
        }
    scoreValSum =  std::accumulate(scoreVals.begin(), scoreVals.end(), 0.0);
    val = scoreValSum*a + b;
    return val;
}


// function that returns values of these score equations
// [[Rcpp::export]] 
Rcpp::NumericVector spModelExample(Rcpp::NumericVector params, Rcpp::NumericVector xInterp, Rcpp::NumericVector yInterp, const Rcpp::NumericVector xVals, int nObs)
{
    double a(1), b(1);
    int i, j;

    // INTERPOLATION SECTION

    // set up vectors for interpolation
    Rcpp::NumericVector yInterpTrue(11), Lambda01(11);

    // compute function that involves parameter
    for(i = 0; i < 11; i++)
    {
        yInterpTrue[i] = params[1]*yInterp[i];  
    }

    // interpolation initiation
    gsl_interp_accel *acc01 = gsl_interp_accel_alloc();
    gsl_interp *interpLambda01 = gsl_interp_alloc(gsl_interp_linear, xInterp.size());
    gsl_interp_init(interpLambda01, xInterp.begin(), yInterpTrue.begin(), xInterp.size());

    double result01;
    for(j = 0; j < 11; j++)
        {
            // integration
            gsl_interp_eval_integ_e(interpLambda01,xInterp.begin(),yInterpTrue.begin(),0,xInterp[j],acc01, &result01);
            Lambda01[j]=result01;
        }

    gsl_interp_free(interpLambda01);
    gsl_interp_accel_free(acc01); 

    // END INTERPOLATION SECTION

    // initialize all parameters
    a = params[0];
    b = params[1];


    double u1Out = u1Ex(xVals, a, b, nObs);
    Rprintf("u1, = %f \n", u1Out);         

    double u2Out = u2Ex(xVals, a, b, nObs);
    Rprintf("u2 = %f \n", u2Out);


    // final score vector
    Rcpp::NumericVector scoreVec(2);
    scoreVec[0] = u1Out;
    scoreVec[1] = u2Out;

    return scoreVec;

}

当我运行以下R代码时,我成功地获得了解决方案,但是如果我运行它5-10次,RStudio将崩溃。我怀疑这与我对更复杂的函数的问题有类似的原因(请注意,IDSplineScore是包含我的Rcpp函数的包的名称。)

library(Rcpp)
library(RcppGSL)
library(IDSplineScore)
library(rootSolve)

set.seed(500)
xi.vals <- runif(100,0,10)
startval <- c(1.1,1.1)
x.interp <- seq(0,50,5)
y.interp <- 120-2*x.interp+rnorm(11,0,5)

multiroot(f = spModelExample, start = startval, verbose=TRUE, 
          xVals = xi.vals,
          xInterp = as.double(x.interp),
          yInterp = as.double(y.interp),
          nObs = as.integer(length(xi.vals)))

如果它有用,sessionInfo()如下:

> sessionInfo()
R version 3.3.2 (2016-10-31)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: OS X Yosemite 10.10.5

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
[1] rootSolve_1.7       IDSplineScore_0.0.3 RcppGSL_0.3.3      
[4] Rcpp_0.12.15       

loaded via a namespace (and not attached):
[1] tools_3.3.2

谢谢!

0 个答案:

没有答案