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

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

Author: edd
Date: 2009-12-20 15:51:44 +0100 (Sun, 20 Dec 2009)
New Revision: 206

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-19 20:28:22 UTC (rev 205)
+++ pkg/inst/ChangeLog	2009-12-20 14:51:44 UTC (rev 206)
@@ -1,3 +1,8 @@
+2009-12-20  Dirk Eddelbuettel  <edd at debian.org>
+
+        * inst/examples/RcppInline/RcppInlineWithLibsExamples.r: Minor
+	  simplifications using new RcppSexp types
+
 2009-12-19  Dirk Eddelbuettel  <edd at debian.org>
 
 	* DESCRIPTION: Release 0.7.0

Modified: pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r	2009-12-19 20:28:22 UTC (rev 205)
+++ pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r	2009-12-20 14:51:44 UTC (rev 206)
@@ -1,4 +1,4 @@
-#!/usr/bin/r
+#!/usr/bin/r -t
 
 suppressMessages(library(Rcpp))
 
@@ -14,7 +14,7 @@
     printf("generator type: %s\\n", gsl_rng_name (r));
     printf("seed = %lu\\n", gsl_rng_default_seed);
     v = gsl_rng_get (r);
-    printf("first value = %f\\n", v);
+    printf("first value = %.0f\\n", v);
     return R_NilValue;
     '
 
@@ -35,8 +35,7 @@
 
     ## now use Rcpp to pass down a parameter for the seed
     gslrng <- '
-    RcppVector<int> vec(par);
-    int seed = vec(0);
+    int seed = RcppSexp(par).asInt();
 
     gsl_rng *r;
     gsl_rng_env_setup();
@@ -50,14 +49,10 @@
     #ifndef BeSilent
     printf("generator type: %s\\n", gsl_rng_name (r));
     printf("seed = %d\\n", seed);
-    printf("first value = %f\\n", v);
+    printf("first value = %.0f\\n", v);
     #endif
 
-    RcppResultSet rs;           // Build result set to be returned as a list to R.
-    rs.add("value", v);         // vec as named element with name "vec"
-    SEXP rl = rs.getReturnList();    // Get the list to be returned to R.
-
-    return rl;
+    return RcppSexp(v).asSexp();
     '
 
     ## turn into a function that R can call
@@ -69,7 +64,7 @@
                       cppargs="-I/usr/include",
                       libargs="-lgsl -lgslcblas")
     cat("\n\nCalling second example without -DBeSilent set\n")
-    print(funx(0)["value"])
+    print(funx(0))
 
     funx <- cfunction(signature(par="numeric"), gslrng,
                       includes="#include <gsl/gsl_rng.h>",
@@ -77,61 +72,10 @@
                       cppargs="-I/usr/include -DBeSilent",
                       libargs="-lgsl -lgslcblas")
     cat("\n\nCalling second example with -DBeSilent set\n")
-    print(funx(1)["value"])
+    print(funx(0))
 
     invisible(NULL)
 }
 
-thirdExample <- function() {
-
-    ## now use Rcpp to pass down a parameter for the seed
-    gslrng <- '
-    RcppVector<int> vec(par);
-    int seed = vec(0);
-
-    gsl_rng *r;
-    gsl_rng_env_setup();
-    double v;
-
-    r = gsl_rng_alloc (gsl_rng_default);
-
-    gsl_rng_set (r, (unsigned long) seed);
-    v = gsl_rng_get (r);
-
-    #ifndef BeSilent
-    printf("generator type: %s\\n", gsl_rng_name (r));
-    printf("seed = %d\\n", seed);
-    printf("first value = %f\\n", v);
-    #endif
-
-    RcppResultSet rs;           // Build result set to be returned as a list to R.
-    rs.add("value", v);         // vec as named element with name "vec"
-    SEXP rl = rs.getReturnList();    // Get the list to be returned to R.
-
-    return rl;
-    '
-
-    ## 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(par="numeric"), gslrng,
-                      includes="#include <gsl/gsl_rng.h>",
-                      Rcpp=TRUE,
-                      compileargs="-I/usr/include",
-                      libargs="-lgsl -lgslcblas")
-    cat("\n\nCalling second example without -DBeSilent set\n")
-    print(funx(0)["value"])
-
-    funx <- cfunction(signature(par="numeric"), gslrng,
-                      includes="#include <gsl/gsl_rng.h>",
-                      Rcpp=TRUE,
-                      compileargs="-I/usr/include -DBeSilent",
-                      libargs="-lgsl -lgslcblas")
-    cat("\n\nCalling second example with -DBeSilent set\n")
-    print(funx(1)["value"])
-
-    invisible(NULL)
-}
-
 firstExample()
 secondExample()