On 3 August 2011 at 14:48, Christian Gunning wrote:
| On Wed, Aug 3, 2011 at 10:22 AM,
| <rcpp-devel-request at r-forge.wu-wien.ac.at> wrote:
| > Simple examples are in a demo file in the
| > package, see demo(CompiledBenchmark) -- or more importantly, see its
source
| > and the RcppDE source.
|
| I'm now cobbling together a small XPtr section in Rcpp-quickref based
| on these 2 related threads, which have been enormously helpful to me.
You are the man! Much appreciated. But we should really make sure we
settle
on something simple yet complete. Maybe feeding R's optim or something
simpler.
| Thanks, I think I finally get it.
|
| In the meantime, for the inveterately lazy and/or confused, here's the
| horse's mouth, with some key lines therein to trace up from:
|
|
https://r-forge.r-project.org/scm/viewvc.php/pkg/RcppDE/demo/CompiledBench
mark.R?view=markup&root=rcpp
|
| create_xptr <- cxxfunction(signature(funname="character"),
| body=src.xptr, inc=inc, plugin="Rcpp")
| ## ...
| cppDE <- function(n, maxIt, fun) RcppDE::DEoptim(fn=fun,
| lower=rep(-25, n),
| upper=rep(25, n), control=list(NP=10*n, itermax=maxIt,
| trace=FALSE))#, bs=TRUE))
| ## ...
| xptr <- create_xptr(funname)
| ct <- system.time(invisible(cppDE(n, maxIt, xptr)))[3]
What I didn't show was the receiving end. In the C++ function doing the
optimisation setip, we switch based on what the user gives us (R
function, or
inline-created XPtr SEXP with a C function):
Rcpp::DE::EvalBase *ev = NULL; // pointer to abstract base class
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 this 'ev' object is then evaluated with the parameters:
double t_tmpC = ev->eval(par); // Evaluate mutant in t_tmpP
It is implemented as some quick classes wrapped in a header file
evaluate.h:
class EvalBase {
public:
EvalBase() : neval(0) {};
virtual double eval(SEXP par) = 0;
unsigned long getNbEvals() { return neval; }
protected:
unsigned long int neval;
};
class EvalStandard : public EvalBase {
public:
EvalStandard(SEXP fcall_, SEXP env_) : fcall(fcall_), env(env_) {}
double eval(SEXP par) {
neval++;
return defaultfun(par);
}
private:
SEXP fcall, env;
double defaultfun(SEXP par) { // essentialy same as the old
evaluate
SEXP fn = ::Rf_lang3(fcall, par, R_DotsSymbol); // this could be done
with Rcpp
SEXP sexp_fvec = ::Rf_eval(fn, env); // but is still a lot slower
right now
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);
}
};
typedef double (*funcPtr)(SEXP);
class EvalCompiled : public EvalBase {
public:
EvalCompiled( Rcpp::XPtr<funcPtr> xptr ) {
funptr = *(xptr);
};
EvalCompiled( SEXP xps ) {
Rcpp::XPtr<funcPtr> xptr(xps);
funptr = *(xptr);
};
double eval(SEXP par) {
neval++;
return funptr(par);
}
private:
funcPtr funptr;
};
EvalBase is the abstract base class, EvalStandard uses standard R and
EvalCompiled uses the compiled function.
It all looks mighty complicated but once you squint at it for a few
minutes
it starts to make sense. And I share Manuel's excitement for doing
something
like this for Amore -- it make sense.
But we need to clean it up into a simpler selfcontained example.
Volunteers?
Dirk
--
Gauss once played himself in a zero-sum game and won $50.
-- #11 at http://www.gaussfacts.com