RcppArmadillo передать пользовательскую функцию

Рассмотрим следующий код 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")

Пользователь может передать имя функции "fun", которое используетсяcaller, Я хочу выполнить ту же задачу сRcppArmadillo объекты (как часть более сложной задачи, очевидно). Функция будет определена вC++и пользователь выбирает его на уровне R, ссылаясь на его имя:

caller_cpp(1:3, "fun1_cpp")

или же

caller_cpp(1:3, "fun2_cpp")

и т.п.

Вот моя наивная попытка использования функции вызова, которая даже не скомпилируется:

## ----------- 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);
      }

   ')

редактировать: адаптировал пример, следуя предложению Дирка, чтобы посмотреть на RcppDE.

Ответы на вопрос(1)

Ваш ответ на вопрос