Skip to content

Is it possible to pass a function argument from R to compiled code in C?

6 messages · Alireza Mahani, Uwe Ligges, Gabriel Becker +2 more

Original
Alireza Mahani
# 
I have a function in R that takes another function as argument:

f <- function(g, ...) { #g is expected to be a function
}

I want to see if there is a way to implement "f" in C and calling it from R
using ".C" interface. I know that I can use function pointers for my C
implementation, but I imagine it's going to be nearly impossible to pass a
function from R to C. Are there any exact or approximate solutions
available?

Thank you,
Alireza Mahani


--
View this message in context: http://r.789695.n4.nabble.com/Is-it-possible-to-pass-a-function-argument-from-R-to-compiled-code-in-C-tp3827563p3827563.html
Sent from the R devel mailing list archive at Nabble.com.
Uwe Ligges
# 
You can evaluate R functions from C, see Writing R Extension.

Uwe Ligges
On 20.09.2011 19:26, Alireza Mahani wrote:
Alireza Mahani
# 
OK, thanks. But there are two issues with using ".Call":

1- I may give up performance if I am literally running R code inside C,
right? In some ways, wouldn't it defy the purpose of calling a compiled code
if I end up back in R?

2- If I use the ".Call" interface, the resulting code will be tailored to R,
i.e. I will end up having the lengthy code with all the R macros in it. I
always prefer to use ".C" interface because I can use the exact same piece
of code inside of a C program, i.e. I can call the same function either from
R or from C. But with .Call, I am passing R's pointers into the function,
which obviously I won't be doing when my call comes from inside of C.

Nevertheless, it's good to know that there is at least a sub-optimal
solution out there (sub-optimal from my perspective, of course!).

-Alireza

--
View this message in context: http://r.789695.n4.nabble.com/Is-it-possible-to-pass-a-function-argument-from-R-to-compiled-code-in-C-tp3827563p3827690.html
Sent from the R devel mailing list archive at Nabble.com.
Jeff Ryan
# 
You can't call "R" code as if it is C code.  It is R, and requires
that it be evaluated.  How would your C know what to do with an R
pointer...

.Call is more efficient than .C, all the time.  Check this list and
experiment.  That said, you can still call "just C" within the .Call
"R" function, it really is 'just C' in there.

Probably something like a simple example of what you are trying to do
would help the list steer you into the right direction (steer, since
you seem to be missing something in your thinking on this...)

Best,
Jeff

On Tue, Sep 20, 2011 at 1:07 PM, Alireza Mahani
<alireza.s.mahani at gmail.com> wrote:

  
    

      
      
    

  


  


      

    

    

      
      

        


  

        

      Dirk Eddelbuettel
    

    

      
      #
    

  


  

      
On 20 September 2011 at 10:26, Alireza Mahani wrote:

        
| I have a function in R that takes another function as argument:
| 
| f <- function(g, ...) { #g is expected to be a function
| }
| 
| I want to see if there is a way to implement "f" in C and calling it from R
| using ".C" interface. I know that I can use function pointers for my C
| implementation, but I imagine it's going to be nearly impossible to pass a
| function from R to C. Are there any exact or approximate solutions
| available?

Yes you can -- using .Call() with can receive/return SEXP-typed variable, and
you can use an external pointer wrapped up in a SEXP.  The standard C API to
R supports it.

Now, Romain and I argue that the Rcpp interface for C++ makes it easier.
So what I am showing you now uses C++. You could do all that in C as well,
but you'd need to add a lot more hand-holding code which we hide behind the
C++ type system.

To keep this concrete, I have a full example in the Rcpp-using variant of
DEoptim, the RcppDE package which is on CRAN and R-Forge.  Here are some core
pieces of what demo(CompiledBenchmark) does:

R function:

    Wild <- function(x) { 		## 'Wild' function, global minimum at about -15.81515
        sum(10 * sin(0.3 * x) * sin(1.3 * x^2) + 0.00001 * x^4 + 0.2 * x + 80)/length(x)
    }

C++ variant of same function:


    double wild(SEXP xs) {
       Rcpp::NumericVector x(xs);
       int n = x.size();
       double sum = 0.0;
       for (int i=0; i<n; i++) {
          sum += 10 * sin(0.3 * x[i]) * sin(1.3 * x[i]*x[i]) + 0.00001 * x[i]*x[i]*x[i]*x[i] + 0.2 * x[i] + 80;
       }
       sum /= n;
       return(sum);
    }

and the key is then to (using the inline package, wrapping C++ code) create
an external pointer object (using the Rcpp::XPtr type) pointing at this C++
function just shown (and the real version does this for three different
functions with a switch, but the essence is just this):

    ## now via a class returning external pointer
    src.xptr <- 'return(XPtr<funcPtr>(new funcPtr(&wild)));'
    create_xptr <- cxxfunction(signature(funname="character"), body=src.xptr, inc=inc, plugin="Rcpp")

Calling create_xptr() in R gives us the XPtr in R --- and there we just pass
it down to the optimising function which then has a simple switch on the type
it receives to see whether it evaluates an R function, or a C++ function.  So
in the C++ function implementing the inner core of the optimisation (in
devol.cpp), we do

    if (TYPEOF(fcall) == EXTPTRSXP) { 		// non-standard mode: we are being passed an external pointer
	ev = new Rcpp::DE::EvalCompiled(fcall); // so assign a pointer using external pointer in fcall SEXP
    } else {					// standard mode: env_ is an env, fcall_ is a function 
	ev = new Rcpp::DE::EvalStandard(fcall, rho);	// so assign R function and environment
    }

and that simple branches between two cases of evaluator helper class.

To evaluate the R function at the C++ level we do

    double eval(SEXP par) {
	neval++;
	return defaultfun(par);
    }

with

    double defaultfun(SEXP par) { 			// essentialy same as the old evaluate
	SEXP fn = ::Rf_lang3(fcall, par, R_DotsSymbol); 
	SEXP sexp_fvec = ::Rf_eval(fn, env);		
	double f_result = REAL(sexp_fvec)[0];
	if (ISNAN(f_result)) 
	    ::Rf_error("NaN value of objective function! \nPerhaps adjust the bounds.");
	return(f_result); 
    }

whereas to evaluate the C++ function passed in, we do

    EvalCompiled( SEXP xps ) {				// get funptr from external pointer
	Rcpp::XPtr<funcPtr> xptr(xps);
	funptr = *(xptr);
    };
    double eval(SEXP par) {
	neval++;
	return funptr(par);
    }

This can probably be refined further, as it was mostly just one big proof of
concept.  But it works fine, do

   library(RcppDE)
   demo(CompiledBenchmark)

and several R-vs-C++ comparison of objective funtions should be timed for you.

If you're interested, we're always happy to take on Rcpp-specific questions
on the rcpp-devel list.

Hope this helps,  Dirk