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

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

Author: edd
Date: 2010-06-24 01:24:28 +0200 (Thu, 24 Jun 2010)
New Revision: 1697

Modified:
   pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R
Log:
minor polish / edit
incr. runs for 2nd example


Modified: pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R
===================================================================
--- pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R	2010-06-23 23:24:05 UTC (rev 1696)
+++ pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R	2010-06-23 23:24:28 UTC (rev 1697)
@@ -2,18 +2,18 @@
 suppressMessages(library(inline))
 suppressMessages(library(Rcpp))
 
-benchmark <- function( start, hand.written, sugar, expr, runs = 500, 
-	data = list( x = runif(1e5),  y = runif(1e5) ), 
-	end = ""){
+benchmark <- function(start, hand.written, sugar, expr, runs = 500,
+                      data = list( x = runif(1e5),  y = runif(1e5) ),
+                      end = "") {
 
 src <- sprintf( '
     unsigned int runs = as<int>(runss);
    	Environment e(env) ;
-    
+
    	%s
-	    
+
     Timer timer;
-    
+
     // approach one
     timer.Start();
     for (unsigned int i=0; i<runs; i++) {
@@ -21,46 +21,46 @@
     }
     timer.Stop();
     double t1 = timer.ElapsedTime();
-    
+
     // approach two
-    timer.Reset(); timer.Start();   
+    timer.Reset(); timer.Start();
     for (unsigned int i=0; i<runs; i++) {
         %s
     }
     timer.Stop();
     double t2 = timer.ElapsedTime();
-    
+
     Language call(expr) ;
-    
-    timer.Reset(); timer.Start();   
+
+    timer.Reset(); timer.Start();
     for (unsigned int i=0; i<runs; i++) {
         NumericVector res2 = Rf_eval( call, e ) ;
     }
     timer.Stop();
     double t3 = timer.ElapsedTime();
-     
+
     %s
-    
-    return NumericVector::create( 
-    	_["hand written"] = t1, 
-    	_["sugar"] = t2, 
+
+    return NumericVector::create(
+    	_["hand written"] = t1,
+    	_["sugar"] = t2,
     	_["R"]     = t3
     	) ;
-', 
-	paste( start, collapse = "\n" ) ,
-	paste( hand.written, collapse = "\n" ), 
-	paste( sugar, collapse = "\n" ), 
-	paste( end, collapse = "\n" )
+',
+               paste( start, collapse = "\n" ) ,
+               paste( hand.written, collapse = "\n" ),
+               paste( sugar, collapse = "\n" ),
+               paste( end, collapse = "\n" )
 	)
-	
+
 	e <- environment()
 	for( i in names(data) ){
 		assign( i, data[[i]], envir = e )
 	}
-	
+
 	settings <- getPlugin("Rcpp")
 	settings$env$PKG_CXXFLAGS <- paste("-I", getwd(), " -O0", sep="")
-	
+
 	fun <- cxxfunction(signature(runss="integer", expr = "language", env = "environment" ),
 	                   src,
 	                   includes='#include "Timer.h"',
@@ -74,10 +74,10 @@
 	NumericVector y = e["y"] ;
 ', '
 	int n = x.size() ;
-    NumericVector res1( n ) ;
-    double x_ = 0.0 ;
-    double y_ = 0.0 ;
-    for( int i=0; i<n; 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_) ){
@@ -91,8 +91,8 @@
 
 ', '
     NumericVector res2 = ifelse( x < y, x*x, -(y*y) ) ;
-', 
-	quote(ifelse(x<y, x*x, -(y*y) )) 
+',
+	quote(ifelse(x<y, x*x, -(y*y) ))
 )
 
 res.any <- benchmark( '
@@ -100,44 +100,43 @@
 	NumericVector y = e["y"] ;
 	int res ;
 	SEXP res2 ;
-	
+
 ', '
 	int n = x.size() ;
 	bool seen_na = false ;
 	bool result = false ;
 	double x_ = 0.0 ;
 	double y_ = 0.0 ;
-    for( int i=0; i<n; i++){
-    	x_ = x[i] ;
-    	if( R_IsNA( x_ )  ){
-    		seen_na = true ;
-    	} else {
-    		y_ = y[i] ;
-    		if( R_IsNA( y_ ) ){
-    			seen_na = true ;
-    		} else {
-    			/* both non NA */
-    			if( x_*y_ < 0.0 ){
-    				result = true ;
-    				break ;
+	for( int i=0; i<n; i++){
+    		x_ = x[i] ;
+		if( R_IsNA( x_ )  ){
+			seen_na = true ;
+		} else {
+    			y_ = y[i] ;
+    			if( R_IsNA( y_ ) ){
+    				seen_na = true ;
+	    		} else {
+    				/* both non NA */
+    				if( x_*y_ < 0.0 ){
+    					result = true ;
+    					break ;
+    				}
     			}
     		}
     	}
-    }
-    res = result ? TRUE : ( seen_na ? NA_LOGICAL : FALSE ) ;
+	res = result ? TRUE : ( seen_na ? NA_LOGICAL : FALSE ) ;
 ', '
-    res2 = any( x*y < 0 ) ; 
-', 
-	quote(any(x*y<0)), 
-	data = list( 
-		x = seq( -1, 1, length = 1e05), 
-		y = rep( 1, 1e05) 
+	res2 = any( x*y < 0 ) ;
+',
+	quote(any(x*y<0)),
+        runs = 5000,
+	data = list(
+		x = seq( -1, 1, length = 1e05),
+		y = rep( 1, 1e05)
 	)
 )
 
-results <- rbind( 
-	as.data.frame( t( res.ifelse ) ), 
-	as.data.frame( t( res.any    ) )
-	)
+results <- rbind(as.data.frame( t( res.ifelse ) ),
+                 as.data.frame( t( res.any    ) ))
 print( results )