如何将R包中的功能添加到rcpp代码中

时间:2018-07-27 22:03:31

标签: r rcpp

我正在编写rcpp代码,我想在“ invgamma”包中使用函数dinvgamma(rinvgamma)。以下是我的所有代码。我尝试将包“ invgamma”放入环境中,然后将其内部的函数称为Rcpp :: Function。

#include <Rcpp.h>
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <R_ext/Utils.h>
using namespace Rcpp;
// [[Rcpp::export]]

RcppExport SEXP updatesigama2_mu(SEXP sigma2_mu, 
                                 SEXP mu, 
                                 SEXP u0, 
                                 SEXP v0, 
                                 SEXP K, 
                                 SEXP SS,
                                 SEXP acc,
                                 SEXP sigma2_mu_list)
{
  BEGIN_RCPP

  Rcpp::Environment invgamma("package:invgamma");
  Rcpp::Function dinvgamma = invgamma["dinvgamma"];
  Rcpp::Function rinvgamma = invgamma["rinvgamma"];


  double xacc = Rcpp::as<double>(acc);
  Rcpp::NumericVector xsigma2_mu_list(sigma2_mu_list);

  Rcpp::NumericVector xmu(mu);//vector mu
  double xsigma2_mu = Rcpp::as<double>(sigma2_mu);
  int xK = Rcpp::as<int>(K);
  int xSS = Rcpp::as<int>(SS);// time for irrecation 
  double xu0 = Rcpp::as<double>(u0);
  double xv0 = Rcpp::as<double>(v0);
  Rcpp::RNGScope scope;
  int c = 0; int d = 0;
  c = xu0 + 0.5*xK + 1;
  d = xv0 + 0.5*sum(xmu);
  for (int ss = 0; ss<xSS; ss++){//iteration
    Rcpp::NumericVector tmp = rinvgamma(1,0,1);//proposal distribution Normal(0,10)
    Rcpp::NumericVector u = Rcpp::runif(1);
    Rcpp::NumericVector a = dinvgamma(tmp[0], c, pow(d,-1),d, false ) * dinvgamma(xsigma2_mu,1,0,1,false)/
      (dinvgamma(xsigma2_mu,c,pow(d,-1),d,false)*dinvgamma(tmp[0],1,0,1,false))
    xsigma2_mu_list[1] = tmp[0];
    xsigma2_mu_list[2] = a[0];
    if ( u[0] <= a[0] ){
      xsigma2_mu = tmp[0];
      xacc += 1;
    }
  }

  return Rcpp::List::create(Rcpp::Named("sigma2_mu") = xsigma2_mu,
                            Rcpp::Named("acc") = xacc,
                            Rcpp::Named("sigma2_mu_list") = xsigma2_mu_list);

  END_RCPP
}

我将其用作以下形式,但不起作用。它会错过某些东西吗?

Rcpp::NumericVector a = dinvgamma(tmp[0], c, pow(d,-1),d, false ) * dinvgamma(xsigma2_mu,1,0,1,false)/
          (dinvgamma(xsigma2_mu,c,pow(d,-1),d,false)*dinvgamma(tmp[0],1,0,1,false))

1 个答案:

答案 0 :(得分:2)

加载某些程序包中定义的R函数没有原则性问题。但是,必须附加该程序包才能使用它的环境。请参见示例中的函数rfunc()。对于逆Gamma,更容易根据Gamma函数定义自己的函数。请参见示例中的函数sugar()

示例:

#include <Rcpp.h>
// [[Rcpp::export]]
Rcpp::List rfunc() {
  Rcpp::Environment invgamma("package:invgamma");
  Rcpp::Function dinvgamma = invgamma["dinvgamma"];
  Rcpp::Function rinvgamma = invgamma["rinvgamma"];
  Rcpp::NumericVector tmp = rinvgamma(5, 1);
  Rcpp::NumericVector a = dinvgamma(tmp, 1);
  return Rcpp::List::create(Rcpp::Named("tmp") = tmp,
                Rcpp::Named("a") = a);
}


Rcpp::NumericVector rinvgamma(R_xlen_t n,
                  double shape,
                  double rate = 1.0) {
  return 1.0/Rcpp::rgamma(n, shape, rate);
}

Rcpp::NumericVector dinvgamma(Rcpp::NumericVector x,
                  double shape,
                  double rate = 1.0,
                  bool log = false) {
  Rcpp::NumericVector log_f = Rcpp::dgamma(1.0/x, shape, rate, true) - 2 * Rcpp::log(x);
  if (log) 
    return log_f;
  return Rcpp::exp(log_f);
}

// [[Rcpp::export]]
Rcpp::List sugar() {
  Rcpp::NumericVector tmp = rinvgamma(5, 1);
  Rcpp::NumericVector a = dinvgamma(tmp, 1);
  return Rcpp::List::create(Rcpp::Named("tmp") = tmp,
                Rcpp::Named("a") = a);
}


/*** R
library(invgamma)
set.seed(42)
rfunc()
set.seed(42)
sugar()
microbenchmark::microbenchmark(rfunc(), sugar())
*/

输出:

> library(invgamma)

> set.seed(42)

> rfunc()
$tmp
[1]  0.5156511  5.5426504  1.8711424 41.7271256  2.3376817

$a
[1] 0.5408323347 0.0271775313 0.1673728698 0.0005607317 0.1193024224


> set.seed(42)

> sugar()
$tmp
[1]  0.5156511  5.5426504  1.8711424 41.7271256  2.3376817

$a
[1] 0.5408323347 0.0271775313 0.1673728698 0.0005607317 0.1193024224


> microbenchmark::microbenchmark(rfunc(), sugar())
Unit: microseconds
    expr     min       lq      mean   median      uq      max neval
 rfunc() 115.098 117.1595 130.80325 117.9270 119.429 1342.420   100
 sugar()   7.333   8.3810  26.03649   9.2195  10.023 1657.404   100

使用Rcpp糖的性能提升非常可观!