[Rcpp-commits] r3178 - in pkg/Rcpp: . inst inst/examples/OpenMP

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

Author: edd
Date: 2011-08-26 00:50:51 +0200 (Fri, 26 Aug 2011)
New Revision: 3178

Added:
   pkg/Rcpp/inst/examples/OpenMP/OpenMPandInline.r
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/NEWS
Log:
new OpenMP example, this time via inline


Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2011-08-23 22:18:04 UTC (rev 3177)
+++ pkg/Rcpp/ChangeLog	2011-08-25 22:50:51 UTC (rev 3178)
@@ -1,3 +1,8 @@
+2011-08-25  Dirk Eddelbuettel  <edd at debian.org>
+
+	* inst/examples/OpenMP/OpenMPandInline.r: Added new example for
+	OpenMP via inline, comparing simple loops with plain Rcpp and sugar
+
 2011-08-23  Dirk Eddelbuettel  <edd at debian.org>
 
 	* inst/examples/Misc/ifelseLooped.r: Added new example based on blog

Modified: pkg/Rcpp/inst/NEWS
===================================================================
--- pkg/Rcpp/inst/NEWS	2011-08-23 22:18:04 UTC (rev 3177)
+++ pkg/Rcpp/inst/NEWS	2011-08-25 22:50:51 UTC (rev 3178)
@@ -1,5 +1,8 @@
 0.9.7   2011-xx-yy
 
+    o   New example 'OpenMPandInline.r' in the OpenMP/ directory, showing how
+        easily use OpenMP by modifying the RcppPlugin output
+
     o   New example 'ifelseLooped.r' showing Rcpp can accelerate loops that may
 	be difficult to vectorise due to dependencies
 

Added: pkg/Rcpp/inst/examples/OpenMP/OpenMPandInline.r
===================================================================
--- pkg/Rcpp/inst/examples/OpenMP/OpenMPandInline.r	                        (rev 0)
+++ pkg/Rcpp/inst/examples/OpenMP/OpenMPandInline.r	2011-08-25 22:50:51 UTC (rev 3178)
@@ -0,0 +1,66 @@
+#!/usr/bin/r
+
+library(inline)
+library(rbenchmark)
+
+serialCode <- '
+   // assign to C++ vector
+   std::vector<double> x = Rcpp::as<std::vector< double > >(xs);
+   size_t n = x.size();
+   for (size_t i=0; i<n; i++) {
+       x[i] = ::log(x[i]);
+   }
+   return Rcpp::wrap(x);
+'
+funSerial <- cxxfunction(signature(xs="numeric"), body=serialCode, plugin="Rcpp")
+
+## same, but with Rcpp vector just to see if there is measurable difference
+serialRcppCode <- '
+   // assign to C++ vector
+   Rcpp::NumericVector x = Rcpp::NumericVector(xs);
+   size_t n = x.size();
+   for (size_t i=0; i<n; i++) {
+       x[i] = ::log(x[i]);
+   }
+   return x;
+'
+funSerialRcpp <- cxxfunction(signature(xs="numeric"), body=serialRcppCode, plugin="Rcpp")
+
+## now with a sugar expression with internalizes the loop
+sugarRcppCode <- '
+   // assign to C++ vector
+   Rcpp::NumericVector x = log ( Rcpp::NumericVector(xs) );
+   return x;
+'
+funSugarRcpp <- cxxfunction(signature(xs="numeric"), body=sugarRcppCode, plugin="Rcpp")
+
+## lastly via OpenMP for parallel use
+openMPCode <- '
+   // assign to C++ vector
+   std::vector<double> x = Rcpp::as<std::vector< double > >(xs);
+   size_t n = x.size();
+#pragma omp parallel for shared(x, n)
+   for (size_t i=0; i<n; i++) {
+       x[i] = ::log(x[i]);
+   }
+   return Rcpp::wrap(x);
+'
+
+## modify the plugin for Rcpp to support OpenMP
+settings <- getPlugin("Rcpp")
+settings$env$PKG_CXXFLAGS <- paste('-fopenmp', settings$env$PKG_CXXFLAGS)
+settings$env$PKG_LIBS <- paste('-fopenmp -lgomp', settings$env$PKG_LIBS)
+
+funOpenMP <- cxxfunction(signature(xs="numeric"), body=openMPCode, plugin="Rcpp", settings=settings)
+
+
+z <- seq(1, 2e6)
+res <- benchmark(funSerial(z), funOpenMP(z),
+                 funSerialRcpp(z), funSugarRcpp(z),
+                 columns=c("test", "replications", "elapsed",
+                           "relative", "user.self", "sys.self"),
+                 order="relative",
+                 replications=100)
+print(res)
+
+