[Rcpp-commits] r2282 - tests/rcppFunctionEval

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

Author: edd
Date: 2010-10-07 03:52:10 +0200 (Thu, 07 Oct 2010)
New Revision: 2282

Added:
   tests/rcppFunctionEval/evaluate6.cpp
Modified:
   tests/rcppFunctionEval/bm.cpp
   tests/rcppFunctionEval/bm.r
Log:
and another hybrid variant with Rcpp objects in signature


Modified: tests/rcppFunctionEval/bm.cpp
===================================================================
--- tests/rcppFunctionEval/bm.cpp	2010-10-06 23:34:20 UTC (rev 2281)
+++ tests/rcppFunctionEval/bm.cpp	2010-10-07 01:52:10 UTC (rev 2282)
@@ -31,6 +31,8 @@
 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 double evaluate6(long & l_nfeval, Rcpp::NumericVector & par, 
+			    const Rcpp::Function & fcall, const Rcpp::Environment & env);
 
 RcppExport SEXP benchmarkEvals(SEXP bmS, SEXP parS, SEXP funS, SEXP envS) {
     
@@ -41,7 +43,7 @@
     Rcpp::NumericVector x(parS);
 
     Timer t;
-    double v1 = 0, v2 = 0, v3 = 0, v4 = 0, v5 = 0;
+    double v1 = 0, v2 = 0, v3 = 0, v4 = 0, v5 = 0, v6 = 0;
     t.Start();
     for (int i=0; i<nsim; i++)
 	v1 = evaluate1(&neval, x.begin(), x.size(), funS, envS);
@@ -83,7 +85,17 @@
     t.Stop();
     double t5 = t.ElapsedTime();
 
-    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)));
+    t.Reset();
+    neval = 0;
+    Rcpp::Function fc(fun);
+    Rcpp::Environment en(env);
+    t.Start();
+    for (int i=0; i<nsim; i++)
+	v6 = evaluate6(neval, x, fc, en);
+    t.Stop();
+    double t6 = t.ElapsedTime();
 
+    return Rcpp::DataFrame::create(Rcpp::Named("times", Rcpp::NumericVector::create(t1, t2, t3, t4, t5, t6)),
+				   Rcpp::Named("values", Rcpp::NumericVector::create(v1, v2, v3, v4, v5, v6)));
+
 }

Modified: tests/rcppFunctionEval/bm.r
===================================================================
--- tests/rcppFunctionEval/bm.r	2010-10-06 23:34:20 UTC (rev 2281)
+++ tests/rcppFunctionEval/bm.r	2010-10-07 01:52:10 UTC (rev 2282)
@@ -9,8 +9,8 @@
 
 dyn.load("bm.so")
 res <-.Call("benchmarkEvals",
-            list("nsim"=5000),		# bmpar list
-            rep(1,2),			# parameter vec.
+            list("nsim"=50000),		# bmpar list
+            rep(1.0, 50L),		# parameter vec.
             genroseFunction,		# function
             new.env())			# environment
 

Added: tests/rcppFunctionEval/evaluate6.cpp
===================================================================
--- tests/rcppFunctionEval/evaluate6.cpp	                        (rev 0)
+++ tests/rcppFunctionEval/evaluate6.cpp	2010-10-07 01:52:10 UTC (rev 2282)
@@ -0,0 +1,27 @@
+#include <Rcpp.h>
+
+// faster hybrid version:
+//  -- uses reference for l_nfeval
+//  -- uses NumericVector for par, no copying or alloc needed
+//  -- uses Rcpp objects for interface
+// and that last points makes it slower that version5 
+// but comparable or slightly faster that v1 (the base case)
+
+RcppExport double evaluate6(long & l_nfeval, 
+			    Rcpp::NumericVector & par, 
+			    const Rcpp::Function & fcall, 
+			    const Rcpp::Environment & env)
+{
+  l_nfeval++;  //increment function evaluation count
+
+  // without PROTECT -- safe enough as we do not return fn or sexp_fvec
+  SEXP fn = Rf_lang2(Rcpp::wrap(fcall), Rcpp::wrap(par));
+  SETCADR(fn, par);
+  SEXP sexp_fvec = Rf_eval(fn, Rcpp::wrap(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); 
+}