[Rcpp-devel] Passing an exposed function to another C++ function as a parameter

After having browse Rcpp sources for the possibility of accessing the
pointer of the exposed function, I have reckon the complexity of the task.

I've tried with Dirk's recommendation and I'm more than good. Let's start
with a benchmarking.

# test elapsed relative
# 1 usingXPtrs  0.001   1
# 3 usingTanh   0.001   1
# 2 usingTanhf0  0.169 169

The external pointer solution is as fast as the original code.
The following lines describe the bechmarking.

##########################################################################
#
####
#Benchmarking
##########################################################################
#
####	

otherCode <- '
             using namespace Rcpp;
             double  f0(double inducedLocalField) {
               return( tanh(inducedLocalField) );
             }
             double f1(double inducedLocalField) {
               double tanhx = tanh(inducedLocalField);
               return( 1-tanhx*tanhx );
             }

             RCPP_MODULE(mod_Test) {
               function( "Tanh_f0", &f0 )  	;
             }
	'

testCode <- '
             typedef double (*funcPtr)(double);
             return List::create( _["f0"]=XPtr<funcPtr>(new
funcPtr(&f0)),
                                  _["f1"]=XPtr<funcPtr>(new
funcPtr(&f1)) 
) ;
	'

testCodefun <- cxxfunction(sig = character(), body = testCode, includes =
otherCode, plugin="Rcpp")

functionPointers <- testCodefun()

modTest <- Module("mod_Test", getDynLib(testCodefun))	

##  Benchmarking

testCode <- '  // ----------------- passing a function as an XPtr
-------------

            typedef double (*funcPtr)(double);
            List functionPointers(listOfFunctionPointers);
            XPtr<funcPtr> f0XPtr = functionPointers["f0"];
            XPtr<funcPtr> f1XPtr = functionPointers["f1"];
            double xx=as<double>(x);
            int N =as<int>(n);
            double result;
            for (int i = 0; i<N ; i++) {
              result = (*f0XPtr)(xx);
            }
            return wrap( result );
	'

usingXPtrs <- cxxfunction(sig =
signature(listOfFunctionPointers="externalpointer", x="numeric",
n="integer"), body = testCode, includes = otherCode, plugin="Rcpp")

usingXPtrs(functionPointers, 0.4, 100)
# [1] 0.379949

testCode <- '  // ----------------- passing a function exposed by Module
-------
            Rcpp::Function fx (myfun);
            int N =as<int>(n);
            double result;
            for (int i = 0; i<N ; i++) {
              result = as<double>(fx(x));
            }
            return wrap( result );
		'
usingTanhf0 <- cxxfunction(sig=signature(myfun="function", x="numeric",
n="integer"), body = testCode, includes = otherCode, plugin="Rcpp")

usingTanhf0(myfun=modTest$Tanh_f0, x=0.4, n=100)
# [1] 0.379949

testCode <- '  // ----------------- using C++ tanh -------

            int N =as<int>(n);
            double result;
            for (int i = 0; i<N ; i++) {
              double value = as<double>(x);
              result = tanh(value);
            }
            return wrap( result );
		'
usingTanh <- cxxfunction(sig=signature(x="numeric", n="integer"), body =
testCode, includes = otherCode, plugin="Rcpp")

usingTanh( x=0.4, n=100)
# [1] 0.379949

suppressMessages(require("rbenchmark"))

benchmark(    usingXPtrs(functionPointers, 0.4, 100), 	
             usingTanhf0(myfun=modTest$Tanh_f0, x=0.4, n=100) ,
             usingTanh( x=0.4, n=100),
  columns=c("test", "elapsed", "relative"), order="relative",
replications=100)

#                                                     test elapsed
relative
# 1                 usingXPtrs   0.001   1
# 3                            usingTanh    0.001   1
# 2 usingTanhf0  0.169      169

El 03/08/11 19:22, "Dirk Eddelbuettel" <edd at debian.org> escribi??: