@@ -3,7 +3,11 @@ suppressMessages(library(Rcpp))
33suppressMessages(library(inline ))
44suppressMessages(library(rbenchmark ))
55
6- rcppGamma <- cxxfunction(signature(xs = " numeric" ), plugin = " Rcpp" , body = '
6+ # # NOTE: This is the old way to compile Rcpp code inline.
7+ # # The code here has left as a historical artifact and tribute to the old way.
8+ # # Please use the code under the "new" inline compilation section.
9+
10+ rcppGamma_old <- cxxfunction(signature(xs = " numeric" ), plugin = " Rcpp" , body = '
711 NumericVector x(xs);
812 int n = x.size();
913
@@ -20,7 +24,7 @@ rcppGamma <- cxxfunction(signature(xs="numeric"), plugin="Rcpp", body='
2024' )
2125
2226
23- gslGamma <- cxxfunction(signature(xs = " numeric" ), plugin = " RcppGSL" ,
27+ gslGamma_old <- cxxfunction(signature(xs = " numeric" ), plugin = " RcppGSL" ,
2428 include = ' #include <gsl/gsl_rng.h>
2529 #include <gsl/gsl_randist.h>' ,
2630 body = '
@@ -39,7 +43,7 @@ gslGamma <- cxxfunction(signature(xs="numeric"), plugin="RcppGSL",
3943' )
4044
4145
42- rcppNormal <- cxxfunction(signature(xs = " numeric" ), plugin = " Rcpp" , body = '
46+ rcppNormal_old <- cxxfunction(signature(xs = " numeric" ), plugin = " Rcpp" , body = '
4347 NumericVector x(xs);
4448 int n = x.size();
4549
@@ -56,7 +60,7 @@ rcppNormal <- cxxfunction(signature(xs="numeric"), plugin="Rcpp", body='
5660' )
5761
5862
59- gslNormal <- cxxfunction(signature(xs = " numeric" ), plugin = " RcppGSL" ,
63+ gslNormal_old <- cxxfunction(signature(xs = " numeric" ), plugin = " RcppGSL" ,
6064 include = ' #include <gsl/gsl_rng.h>
6165 #include <gsl/gsl_randist.h>' ,
6266 body = '
@@ -75,6 +79,83 @@ gslNormal <- cxxfunction(signature(xs="numeric"), plugin="RcppGSL",
7579' )
7680
7781
82+ # # NOTE: Within this section, the new way to compile Rcpp code inline has been
83+ # # written. Please use the code next as a template for your own project.
84+
85+ cppFunction('
86+ NumericVector rcppGamma(NumericVector x){
87+ int n = x.size();
88+
89+ const double y = 1.234;
90+ for (int i=0; i<n; i++) {
91+ x[i] = R::rgamma(3.0, 1.0/(y*y+4));
92+ }
93+
94+ // Return to R
95+ return x;
96+ }' )
97+
98+ # # This approach is a bit sloppy. Generally, you will want to use
99+ # # sourceCpp() if there are additional includes that are required.
100+ cppFunction('
101+ NumericVector gslGamma(NumericVector x){
102+ int n = x.size();
103+
104+ gsl_rng *r = gsl_rng_alloc(gsl_rng_mt19937);
105+ const double y = 1.234;
106+ for (int i=0; i<n; i++) {
107+ x[i] = gsl_ran_gamma(r,3.0,1.0/(y*y+4));
108+ }
109+ gsl_rng_free(r);
110+
111+ // Return to R
112+ return x;
113+ }' , includes = ' #include <gsl/gsl_rng.h>
114+ #include <gsl/gsl_randist.h>' ,
115+ depends = " RcppGSL" )
116+
117+
118+ cppFunction('
119+ NumericVector rcppNormal(NumericVector x){
120+ int n = x.size();
121+
122+ const double y = 1.234;
123+ for (int i=0; i<n; i++) {
124+ x[i] = R::rnorm(1.0/(y+1),1.0/sqrt(2*y+2));
125+ }
126+
127+ // Return to R
128+ return x;
129+ }' )
130+
131+
132+ # # Here we demonstrate the use of sourceCpp() to show the continuity
133+ # # of the code artifact.
134+
135+ sourceCpp(code = '
136+ #include <RcppGSL.h>
137+ #include <gsl/gsl_rng.h>
138+ #include <gsl/gsl_randist.h>
139+
140+ using namespace Rcpp;
141+
142+ // [[Rcpp::depends("RcppGSL")]]
143+
144+ // [[Rcpp::export]]
145+ NumericVector gslNormal(NumericVector x){
146+ int n = x.size();
147+
148+ gsl_rng *r = gsl_rng_alloc(gsl_rng_mt19937);
149+ const double y = 1.234;
150+ for (int i=0; i<n; i++) {
151+ x[i] = 1.0/(y+1)+gsl_ran_gaussian(r,1.0/sqrt(2*y+2));
152+ }
153+ gsl_rng_free(r);
154+
155+ // Return to R
156+ return x;
157+ }' )
158+
78159x <- rep(NA , 1e6 )
79160res <- benchmark(rcppGamma(x ),
80161 gslGamma(x ),
0 commit comments