[Rcpp-commits] r1667 - pkg/Rcpp/inst/examples/SugarPerformance

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

Author: romain
Date: 2010-06-23 14:12:17 +0200 (Wed, 23 Jun 2010)
New Revision: 1667

Modified:
   pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R
Log:
more generic code so that we can benchmark other expression

Modified: pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R
===================================================================
--- pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R	2010-06-23 12:01:51 UTC (rev 1666)
+++ pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R	2010-06-23 12:12:17 UTC (rev 1667)
@@ -2,7 +2,9 @@
 suppressMessages(library(inline))
 suppressMessages(library(Rcpp))
 
-src <- '
+benchmark <- function( hand.written, sugar, expr  ){
+
+src <- sprintf( '
     NumericVector x(xs);
     NumericVector y(ys);
     unsigned int runs = as<int>(runss);
@@ -13,39 +15,25 @@
     // approach one
     timer.Start();
     for (unsigned int i=0; i<runs; i++) {
-   NumericVector res1( n ) ;
-        double x_ = 0.0 ;
-        double y_ = 0.0 ;
-        for( int i=0; i<n; i++){
-            x_ = x[i] ;
-            y_ = y[i] ;
-            if( R_IsNA(x_) || R_IsNA(y_) ){
-                res1[i] = NA_REAL;
-            } else if( x_ < y_ ){
-                res1[i] = (x_ * x_) ;
-            } else {
-                res1[i] = - (y_ * y_) ;
-            }
-        }
+	   %s
     }
     timer.Stop();
     double t1 = timer.ElapsedTime();
     
     // approach two
     timer.Reset(); timer.Start();   
-    start = as<double>( sys_time( ) ) ;
     for (unsigned int i=0; i<runs; i++) {
-        NumericVector res2 = ifelse( x < y, x*x, -(y*y) ) ;
+        %s
     }
     timer.Stop();
     double t2 = timer.ElapsedTime();
     
-    ExpressionVector rcode( "ifelse( x<y, x*x, -(y*y) )" ) ;
-    Language call = rcode[0] ;
+    Language call(expr) ;
+    Environment e(env) ;
     
     timer.Reset(); timer.Start();   
     for (unsigned int i=0; i<runs; i++) {
-        NumericVector res2 = Rf_eval( call, R_GlobalEnv ) ;
+        NumericVector res2 = Rf_eval( call, e ) ;
     }
     timer.Stop();
     double t3 = timer.ElapsedTime();
@@ -55,17 +43,44 @@
     	_["sugar"] = t2, 
     	_["R"]     = t3
     	) ;
-'
-settings <- getPlugin("Rcpp")
-settings$env$PKG_CXXFLAGS <- paste("-I", getwd(), " -O0", sep="")
+', 
+	paste( hand.written, collapse = "\n" ), 
+	paste( sugar, collapse = "\n" ) )
+	
 
-x <- runif(1e5)
-y <- runif(1e5)
-runs <- 500
+	settings <- getPlugin("Rcpp")
+	settings$env$PKG_CXXFLAGS <- paste("-I", getwd(), " -O0", sep="")
+	
+	x <- runif(1e5)
+	y <- runif(1e5)
+	runs <- 500
+	
+	fun <- cxxfunction(signature(runss="numeric", xs="numeric", ys="numeric", expr = "language", env = "environment" ),
+	                   src,
+	                   includes='#include "Timer.h"',
+	                   plugin="Rcpp",
+	                   settings=settings)
+	fun(runs, x, y, expr, environment() )
+}
 
-fun <- cxxfunction(signature(runss="numeric", xs="numeric", ys="numeric"),
-                   src,
-                   includes='#include "Timer.h"',
-                   plugin="Rcpp",
-                   settings=settings)
-print(fun(runs, x, y))
+benchmark( '
+		NumericVector res1( n ) ;
+        double x_ = 0.0 ;
+        double y_ = 0.0 ;
+        for( int i=0; i<n; i++){
+            x_ = x[i] ;
+            y_ = y[i] ;
+            if( R_IsNA(x_) || R_IsNA(y_) ){
+                res1[i] = NA_REAL;
+            } else if( x_ < y_ ){
+                res1[i] = x_ * x_ ;
+            } else {
+                res1[i] = -( y_ * y_)  ;
+            }
+        }
+
+', '
+	NumericVector res2 = ifelse( x < y, x*x, -(y*y) ) ;
+', quote(ifelse(x<y, x*x, -(y*y) )) 
+)
+