[Rcpp-commits] r1670 - in pkg/Rcpp/inst: examples/SugarPerformance include/Rcpp/sugar/functions include/Rcpp/sugar/logical

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

Author: romain
Date: 2010-06-23 15:38:34 +0200 (Wed, 23 Jun 2010)
New Revision: 1670

Modified:
   pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/all.h
   pkg/Rcpp/inst/include/Rcpp/sugar/logical/is.h
Log:
any benchmark

Modified: pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R
===================================================================
--- pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R	2010-06-23 12:58:57 UTC (rev 1669)
+++ pkg/Rcpp/inst/examples/SugarPerformance/vectorOps.R	2010-06-23 13:38:34 UTC (rev 1670)
@@ -3,7 +3,8 @@
 suppressMessages(library(Rcpp))
 
 benchmark <- function( start, hand.written, sugar, expr, runs = 500, 
-	data = list( x = runif(1e5),  y = runif(1e5) ) ){
+	data = list( x = runif(1e5),  y = runif(1e5) ), 
+	end = ""){
 
 src <- sprintf( '
     unsigned int runs = as<int>(runss);
@@ -37,6 +38,8 @@
     }
     timer.Stop();
     double t3 = timer.ElapsedTime();
+     
+    %s
     
     return NumericVector::create( 
     	_["hand written"] = t1, 
@@ -46,7 +49,9 @@
 ', 
 	paste( start, collapse = "\n" ) ,
 	paste( hand.written, collapse = "\n" ), 
-	paste( sugar, collapse = "\n" ) )
+	paste( sugar, collapse = "\n" ), 
+	paste( end, collapse = "\n" )
+	)
 	
 	e <- environment()
 	for( i in names(data) ){
@@ -64,7 +69,7 @@
 	fun(runs, expr, environment() )
 }
 
-benchmark( '
+res.ifelse <- benchmark( '
 	NumericVector x = e["x"] ;
 	NumericVector y = e["y"] ;
 ', '
@@ -90,3 +95,49 @@
 	quote(ifelse(x<y, x*x, -(y*y) )) 
 )
 
+res.any <- benchmark( '
+	NumericVector x = e["x"] ;
+	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 ;
+    			}
+    		}
+    	}
+    }
+    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) 
+	)
+)
+
+results <- rbind( 
+	as.data.frame( t( res.ifelse ) ), 
+	as.data.frame( t( res.any    ) )
+	)
+print( results )
+

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/all.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/all.h	2010-06-23 12:58:57 UTC (rev 1669)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/all.h	2010-06-23 13:38:34 UTC (rev 1670)
@@ -68,9 +68,7 @@
 			}
 		}
 	}
-	
-	
-private:
+
 } ;
 
 } // sugar

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/logical/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/logical/is.h	2010-06-23 12:58:57 UTC (rev 1669)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/logical/is.h	2010-06-23 13:38:34 UTC (rev 1670)
@@ -26,17 +26,17 @@
 
 	template <bool NA, typename T>
 	inline bool is_true( const Rcpp::sugar::SingleLogicalResult<NA,T>& x){
-		return x.is_true() ;
+		return const_cast< Rcpp::sugar::SingleLogicalResult<NA,T>& >(x).is_true() ;
 	}
 
 	template <bool NA, typename T>
 	inline bool is_false( const Rcpp::sugar::SingleLogicalResult<NA,T>& x){
-		return x.is_false() ;
+		return const_cast< Rcpp::sugar::SingleLogicalResult<NA,T>& >(x).is_false() ;
 	}
 
 	template <bool NA, typename T>
 	inline bool is_na( const Rcpp::sugar::SingleLogicalResult<NA,T>& x){
-		return x.is_na() ;
+		return const_cast< Rcpp::sugar::SingleLogicalResult<NA,T>& >(x).is_na() ;
 	}