RcppArmadillo pass función definida por el usuario

Question

Considere el siguiente código R,

## ----------- R version -----------

caller <- function(x=1:3, fun = "identity", ...){

  ## do some other stuff
  ## ...
  ## then call the function
  eval(call(fun, x))

}

fun1 <- function(x, ...){
  x + x
}

fun2 <- function(x, a = 10) a * x

caller(fun = "fun1")
caller(fun = "fun2")

El usuario puede pasar un nombre de función "diversión", que es utilizado por la caller . Deseo realizar la misma tarea con objetos RcppArmadillo (como parte de una tarea más compleja, obviamente). La función se definiría en C++ , y el usuario la selecciona en el nivel R refiriéndose a su nombre:

caller_cpp(1:3, "fun1_cpp")

o

caller_cpp(1:3, "fun2_cpp")

etc.

Este es mi intento ingenuo para la función de llamador, que incluso no compila:

## ----------- C++ version -----------

library(Rcpp)
require( RcppArmadillo )    

sourceCpp( code = ''

       // [[Rcpp::depends("RcppArmadillo")]]

       #include <RcppArmadillo.h>

       using namespace arma ; 
       using namespace Rcpp ;


       colvec fun1_cpp(const colvec x)
      {
       colvec y ;
       y = x + x;
       return (y);
      }

       colvec fun2_cpp(const colvec x)
      {
       colvec y ;
       y = 10*x;
       return (y);
      }

     // mysterious pointer business in an attempt 
     // to select a compiled function by its name

      typedef double (*funcPtr)(SEXP);
      SEXP putFunPtrInXPtr(SEXP funname) {
            std::string fstr = Rcpp::as<std::string>(funname);
            if (fstr == "fun1")
                return(Rcpp::XPtr<funcPtr>(new funcPtr(&fun1_cpp)));
            else if (fstr == "fun2")
            return(Rcpp::XPtr<funcPtr>(new funcPtr(&fun2_cpp)));

       }

       // [[Rcpp::export]]
       colvec caller_cpp(const colvec x, character funname)
      {
       Rcpp::XPtr fun = putFunPtrInXPtr(funname);
       colvec y ;
       y = fun(x);
       return (y);
      }

   '')

Editar : adaptó el ejemplo después de seguir la sugerencia de Dirk para mirar RcppDE.

Answer 1

(En algún momento debe usar svn log ... en los archivos para ver qué tan anticuados están ...)

Creo que un mejor caso de uso está en mi "puerto" del DEoptim basado en C a Rcpp / RcppArmadillo: RcppDE. En él, permito que la rutina de optimización use una función R (como lo hace DEoptim) o una función compilada proporcionada por el usuario, que es lo que quiere aquí tal como yo lo entiendo.

Hay un poco de andamiaje C ++, pero no debería tener ningún problema para seguir eso.

Editar en 2013-01-21 A continuación se muestra una solución completa que también he publicado como esta nueva publicación en la Galería Rcpp , incluidos algunos comentarios y el uso de la muestra.

// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>

using namespace arma; 
using namespace Rcpp;

vec fun1_cpp(const vec& x) {    // a first function 
    vec y = x + x;
    return (y);
}

vec fun2_cpp(const vec& x) {    // and a second function
    vec y = 10*x;
    return (y);
}

typedef vec (*funcPtr)(const vec& x);

// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr(std::string fstr) {
    if (fstr == "fun1")
        return(XPtr<funcPtr>(new funcPtr(&fun1_cpp)));
    else if (fstr == "fun2")
        return(XPtr<funcPtr>(new funcPtr(&fun2_cpp)));
    else
        return XPtr<funcPtr>(R_NilValue); // runtime error as NULL no XPtr
}

// [[Rcpp::export]]
vec callViaString(const vec x, std::string funname) {
    XPtr<funcPtr> xpfun = putFunPtrInXPtr(funname);
    funcPtr fun = *xpfun;
    vec y = fun(x);
    return (y);
}

// [[Rcpp::export]]
vec callViaXPtr(const vec x, SEXP xpsexp) {
    XPtr<funcPtr> xpfun(xpsexp);
    funcPtr fun = *xpfun;
    vec y = fun(x);
    return (y);
}