[Rcpp-commits] r207 - in pkg/inst: . examples/RcppInline

[noreply at r-forge.r-project.org]

Author: edd
Date: 2009-12-20 22:20:24 +0100 (Sun, 20 Dec 2009)
New Revision: 207

Modified:
   pkg/inst/ChangeLog
   pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
Log:
minor simplification to GSL-using example employing new RcppSexp type


Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2009-12-20 14:51:44 UTC (rev 206)
+++ pkg/inst/ChangeLog	2009-12-20 21:20:24 UTC (rev 207)
@@ -1,7 +1,7 @@
 2009-12-20  Dirk Eddelbuettel  <edd at debian.org>
 
         * inst/examples/RcppInline/RcppInlineWithLibsExamples.r: Minor
-	  simplifications using new RcppSexp types
+	  simplifications using new RcppSexp types, added third example
 
 2009-12-19  Dirk Eddelbuettel  <edd at debian.org>
 

Modified: pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r	2009-12-20 14:51:44 UTC (rev 206)
+++ pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r	2009-12-20 21:20:24 UTC (rev 207)
@@ -15,6 +15,8 @@
     printf("seed = %lu\\n", gsl_rng_default_seed);
     v = gsl_rng_get (r);
     printf("first value = %.0f\\n", v);
+
+    gsl_rng_free(r);
     return R_NilValue;
     '
 
@@ -52,6 +54,7 @@
     printf("first value = %.0f\\n", v);
     #endif
 
+    gsl_rng_free(r);
     return RcppSexp(v).asSexp();
     '
 
@@ -77,5 +80,44 @@
     invisible(NULL)
 }
 
+thirdExample <- function() {
+
+    ## now use Rcpp to pass down a parameter for the seed, and a vector size
+    gslrng <- '
+    int seed = RcppSexp(s).asInt();
+    int len = RcppSexp(n).asInt();
+
+    gsl_rng *r;
+    gsl_rng_env_setup();
+    std::vector<double> v(len);
+
+    r = gsl_rng_alloc (gsl_rng_default);
+
+    gsl_rng_set (r, (unsigned long) seed);
+    for (int i=0; i<len; i++) {
+       v[i] = gsl_rng_get (r);
+    }
+    gsl_rng_free(r);
+
+    return RcppSexp(v).asSexp();
+    '
+
+    ## turn into a function that R can call
+    ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
+    ## use additional define for compile to suppress output
+    funx <- cfunction(signature(s="numeric", n="numeric"),
+                      gslrng,
+                      includes="#include <gsl/gsl_rng.h>",
+                      Rcpp=TRUE,
+                      cppargs="-I/usr/include",
+                      libargs="-lgsl -lgslcblas")
+    cat("\n\nCalling third example with seed and length\n")
+    print(funx(0, 5))
+
+    invisible(NULL)
+}
+
 firstExample()
 secondExample()
+thirdExample()
+