[Rcpp-commits] r2280 - tests/rcppFunctionEval

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

Author: edd
Date: 2010-10-07 00:18:31 +0200 (Thu, 07 Oct 2010)
New Revision: 2280

Added:
   tests/rcppFunctionEval/evaluate5.cpp
Modified:
   tests/rcppFunctionEval/bm.cpp
Log:
added faster 'hybrid' version


Modified: tests/rcppFunctionEval/bm.cpp
===================================================================
--- tests/rcppFunctionEval/bm.cpp	2010-10-06 21:41:34 UTC (rev 2279)
+++ tests/rcppFunctionEval/bm.cpp	2010-10-06 22:18:31 UTC (rev 2280)
@@ -30,6 +30,7 @@
  			    const Rcpp::Function & fun, const Rcpp::Environment & env);
 RcppExport double evaluate4(long *l_nfeval, double *param, int i_D,
 			    const Rcpp::Function & fun, const Rcpp::Environment & env);
+RcppExport double evaluate5(long & l_nfeval, Rcpp::NumericVector & par, SEXP fcall, SEXP env);
 
 RcppExport SEXP benchmarkEvals(SEXP bmS, SEXP parS, SEXP funS, SEXP envS) {
     
@@ -40,7 +41,7 @@
     Rcpp::NumericVector x(parS);
 
     Timer t;
-    double v1 = 0, v2 = 0, v3 = 0, v4 = 0;
+    double v1 = 0, v2 = 0, v3 = 0, v4 = 0, v5 = 0;
     t.Start();
     for (int i=0; i<nsim; i++)
 	v1 = evaluate1(&neval, x.begin(), x.size(), funS, envS);
@@ -74,8 +75,15 @@
     t.Stop();
     double t4 = t.ElapsedTime();
 
+    t.Reset();
+    neval = 0;
+    t.Start();
+    for (int i=0; i<nsim; i++)
+	v5 = evaluate5(neval, x, fun, env);
+    t.Stop();
+    double t5 = t.ElapsedTime();
 
-    return Rcpp::DataFrame::create(Rcpp::Named("times", Rcpp::NumericVector::create(t1, t2, t3, t4)),
-				   Rcpp::Named("values", Rcpp::NumericVector::create(v1, v2, v3, v4)));
+    return Rcpp::DataFrame::create(Rcpp::Named("times", Rcpp::NumericVector::create(t1, t2, t3, t4, t5)),
+				   Rcpp::Named("values", Rcpp::NumericVector::create(v1, v2, v3, v4, v5)));
 
 }

Added: tests/rcppFunctionEval/evaluate5.cpp
===================================================================
--- tests/rcppFunctionEval/evaluate5.cpp	                        (rev 0)
+++ tests/rcppFunctionEval/evaluate5.cpp	2010-10-06 22:18:31 UTC (rev 2280)
@@ -0,0 +1,39 @@
+
+#include <Rcpp.h>
+
+// version from DEoptim
+
+//------objective function---------------------------------------
+
+RcppExport double evaluate5(long & l_nfeval, Rcpp::NumericVector & par, SEXP fcall, SEXP env)
+{
+#if 0 
+  // with PROTECT
+  SEXP sexp_fvec, fn;
+  double f_result;  
+  
+  PROTECT(fn = Rf_lang2(fcall, Rcpp::wrap(par)));
+  l_nfeval++;  //increment function evaluation count
+  
+  SETCADR(fn, par);
+ 
+  PROTECT(sexp_fvec = Rf_eval(fn, env));
+  f_result = Rcpp::as<double>(sexp_fvec);
+ 
+  UNPROTECT(2);	
+ #endif
+
+  // without PROTECT -- safe enough?
+  SEXP fn = Rf_lang2(fcall, Rcpp::wrap(par));
+  l_nfeval++;  //increment function evaluation count
+  
+  SETCADR(fn, par);
+ 
+  SEXP sexp_fvec = Rf_eval(fn, env);
+  double f_result = Rcpp::as<double>(sexp_fvec);
+ 
+  if(ISNAN(f_result))
+    Rf_error("NaN value of objective function! \nPerhaps adjust the bounds.");
+   
+  return(f_result); 
+}