Rcpp Version 0.12.12
RcppInlineWithLibsExamples.r
Go to the documentation of this file.
1 #!/usr/bin/env r
2 #
3 # Copyright (C) 2009 - 2016 Dirk Eddelbuettel and Romain Francois
4 #
5 # This file is part of Rcpp.
6 #
7 # Rcpp is free software: you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation, either version 2 of the License, or
10 # (at your option) any later version.
11 #
12 # Rcpp is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
19 
20 suppressMessages(library(Rcpp))
21 suppressMessages(library(RcppGSL))
22 
23 ## NOTE: This is the old way to compile Rcpp code inline.
24 ## The code here has left as a historical artifact and tribute to the old way.
25 ## Please use the code under the "new" inline compilation section.
26 
27 suppressMessages(library(inline))
28 
29 firstExample_old <- function() {
30  ## a really simple C program calling three functions from the GSL
31  gslrng <- '
32  gsl_rng *r;
33  gsl_rng_env_setup();
34  double v;
35 
36  r = gsl_rng_alloc (gsl_rng_default);
37 
38  printf(" generator type: %s\\n", gsl_rng_name (r));
39  printf(" seed = %lu\\n", gsl_rng_default_seed);
40  v = gsl_rng_get (r);
41  printf(" first value = %.0f\\n", v);
42 
43  gsl_rng_free(r);
44  return R_NilValue;
45  '
46 
47  ## turn into a function that R can call
48  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
49  funx_old <- cxxfunction(signature(), gslrng,
50  includes="#include <gsl/gsl_rng.h>",
51  plugin="RcppGSL")
52 
53  cat("Calling first example\n")
54  funx_old()
55  invisible(NULL)
56 }
57 
58 secondExample_old <- function() {
59 
60  ## now use Rcpp to pass down a parameter for the seed
61  gslrng <- '
62  int seed = Rcpp::as<int>(par) ;
63 
64  gsl_rng *r;
65  gsl_rng_env_setup();
66  double v;
67 
68  r = gsl_rng_alloc (gsl_rng_default);
69 
70  gsl_rng_set (r, (unsigned long) seed);
71  v = gsl_rng_get (r);
72 
73  #ifndef BeSilent
74  printf(" generator type: %s\\n", gsl_rng_name (r));
75  printf(" seed = %d\\n", seed);
76  printf(" first value = %.0f\\n", v);
77  #endif
78 
79  gsl_rng_free(r);
80  return Rcpp::wrap(v) ;
81  '
82 
83  ## turn into a function that R can call
84  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
85  ## use additional define for compile to suppress output
86  funx_old <- cxxfunction(signature(par="numeric"), gslrng,
87  includes="#include <gsl/gsl_rng.h>",
88  plugin="RcppGSL")
89  cat("\n\nCalling second example without -DBeSilent set\n")
90  print(funx_old(0))
91 
92 
93  ## now override settings to add -D flag
94  settings <- getPlugin("RcppGSL")
95  settings$env$PKG_CPPFLAGS <- paste(settings$PKG_CPPFLAGS, "-DBeSilent")
96 
97  funx_old <- cxxfunction(signature(par="numeric"), gslrng,
98  includes="#include <gsl/gsl_rng.h>",
99  settings=settings)
100  cat("\n\nCalling second example with -DBeSilent set\n")
101  print(funx_old(0))
102 
103  invisible(NULL)
104 }
105 
106 thirdExample_old <- function() {
107 
108  ## now use Rcpp to pass down a parameter for the seed, and a vector size
109  gslrng <- '
110  int seed = Rcpp::as<int>(s) ;
111  int len = Rcpp::as<int>(n);
112 
113  gsl_rng *r;
114  gsl_rng_env_setup();
115  std::vector<double> v(len);
116 
117  r = gsl_rng_alloc (gsl_rng_default);
118 
119  gsl_rng_set (r, (unsigned long) seed);
120  for (int i=0; i<len; i++) {
121  v[i] = gsl_rng_get (r);
122  }
123  gsl_rng_free(r);
124 
125  return Rcpp::wrap(v) ;
126  '
127 
128  ## turn into a function that R can call
129  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
130  ## use additional define for compile to suppress output
131  funx_old <- cxxfunction(signature(s="numeric", n="numeric"),
132  gslrng,
133  includes="#include <gsl/gsl_rng.h>",
134  plugin="RcppGSL")
135  cat("\n\nCalling third example with seed and length\n")
136  print(funx_old(0, 5))
137 
138  invisible(NULL)
139 }
140 
141 fourthExample_old <- function() {
142 
143  ## now use Rcpp to pass down a parameter for the seed, and a vector size
144  gslrng <- '
145  int seed = Rcpp::as<int>(s);
146  int len = Rcpp::as<int>(n);
147 
148  gsl_rng *r;
149  gsl_rng_env_setup();
150  std::vector<double> v(len);
151 
152  r = gsl_rng_alloc (gsl_rng_default);
153 
154  gsl_rng_set (r, (unsigned long) seed);
155  for (int i=0; i<len; i++) {
156  v[i] = gsl_rng_get (r);
157  }
158  gsl_rng_free(r);
159 
160  return wrap(v);
161  '
162 
163  ## turn into a function that R can call
164  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
165  ## use additional define for compile to suppress output
166  funx_old <- cxxfunction(signature(s="numeric", n="numeric"),
167  gslrng,
168  includes=c("#include <gsl/gsl_rng.h>",
169  "using namespace Rcpp;",
170  "using namespace std;"),
171  plugin="RcppGSL")
172  cat("\n\nCalling fourth example with seed, length and namespaces\n")
173  print(funx_old(0, 5))
174 
175  invisible(NULL)
176 }
177 
178 ## NOTE: Within this section, the new way to compile Rcpp code inline has been
179 ## written. Please use the code next as a template for your own project.
180 
181 firstExample <- function() {
182  ## a really simple C program calling three functions from the GSL
183 
184  sourceCpp(code='
185 #include <RcppGSL.h>
186 #include <gsl/gsl_rng.h>
187 
188 // [[Rcpp::depends(RcppGSL)]]
189 
190 // [[Rcpp::export]]
191 SEXP funx(){
192  gsl_rng *r;
193  gsl_rng_env_setup();
194  double v;
195 
196  r = gsl_rng_alloc (gsl_rng_default);
197 
198  printf(" generator type: %s\\n", gsl_rng_name (r));
199  printf(" seed = %lu\\n", gsl_rng_default_seed);
200  v = gsl_rng_get (r);
201  printf(" first value = %.0f\\n", v);
202 
203  gsl_rng_free(r);
204  return R_NilValue;
205 }')
206 
207  cat("Calling first example\n")
208  funx()
209  invisible(NULL)
210 }
211 
212 secondExample <- function() {
213 
214  ## now use Rcpp to pass down a parameter for the seed
215 
216  ## turn into a function that R can call
217  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
218  ## use additional define for compile to suppress output
219 
220  gslrng <- '
221  #include <RcppGSL.h>
222  #include <gsl/gsl_rng.h>
223 
224  // [[Rcpp::depends(RcppGSL)]]
225 
226  // [[Rcpp::export]]
227  double funx(int seed){
228 
229  gsl_rng *r;
230  gsl_rng_env_setup();
231  double v;
232 
233  r = gsl_rng_alloc (gsl_rng_default);
234 
235  gsl_rng_set (r, (unsigned long) seed);
236  v = gsl_rng_get (r);
237 
238  #ifndef BeSilent
239  printf(" generator type: %s\\n", gsl_rng_name (r));
240  printf(" seed = %d\\n", seed);
241  printf(" first value = %.0f\\n", v);
242  #endif
243 
244  gsl_rng_free(r);
245  return v;
246  }'
247 
248  sourceCpp(code=gslrng, rebuild = TRUE)
249 
250  cat("\n\nCalling second example without -DBeSilent set\n")
251  print(funx(0))
252 
253 
254  ## now override settings to add -D flag
255  o = Sys.getenv("PKG_CPPFLAGS")
256  Sys.setenv("PKG_CPPFLAGS" = paste(o, "-DBeSilent"))
257 
258  sourceCpp(code=gslrng, rebuild = TRUE)
259 
260  # Restore environment flags
261  Sys.setenv("PKG_CPPFLAGS" = o )
262 
263  cat("\n\nCalling second example with -DBeSilent set\n")
264  print(funx(0))
265 
266  invisible(NULL)
267 }
268 
269 thirdExample <- function() {
270 
271  ## now use Rcpp to pass down a parameter for the seed, and a vector size
272 
273  ## turn into a function that R can call
274  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
275  ## use additional define for compile to suppress output
276 
277  sourceCpp(code='
278  #include <RcppGSL.h>
279  #include <gsl/gsl_rng.h>
280 
281  // [[Rcpp::depends(RcppGSL)]]
282 
283  // [[Rcpp::export]]
284  std::vector<double> funx(int seed, int len){
285 
286  gsl_rng *r;
287  gsl_rng_env_setup();
288  std::vector<double> v(len);
289 
290  r = gsl_rng_alloc (gsl_rng_default);
291 
292  gsl_rng_set (r, (unsigned long) seed);
293  for (int i=0; i<len; i++) {
294  v[i] = gsl_rng_get (r);
295  }
296  gsl_rng_free(r);
297 
298  return v;
299  }')
300 
301  cat("\n\nCalling third example with seed and length\n")
302  print(funx(0, 5))
303 
304  invisible(NULL)
305 }
306 
307 fourthExample <- function() {
308 
309  ## now use Rcpp to pass down a parameter for the seed, and a vector size
310 
311  ## turn into a function that R can call
312  ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
313  ## use additional define for compile to suppress output
314 
315  sourceCpp(code='
316  #include <RcppGSL.h>
317  #include <gsl/gsl_rng.h>
318 
319  using namespace Rcpp;
320  using namespace std;
321 
322  // [[Rcpp::depends(RcppGSL)]]
323 
324  // [[Rcpp::export]]
325  std::vector<double> funx(int seed, int len){
326 
327  gsl_rng *r;
328  gsl_rng_env_setup();
329  std::vector<double> v(len);
330 
331  r = gsl_rng_alloc (gsl_rng_default);
332 
333  gsl_rng_set (r, (unsigned long) seed);
334  for (int i=0; i<len; i++) {
335  v[i] = gsl_rng_get (r);
336  }
337  gsl_rng_free(r);
338 
339  return v;
340  }')
341 
342  cat("\n\nCalling fourth example with seed, length and namespaces\n")
343  print(funx(0, 5))
344 
345  invisible(NULL)
346 }
347 
348 firstExample()
349 secondExample()
350 thirdExample()
351 fourthExample()