[Rcpp-devel] Additional parameters for an objective function, e.g. in RcppDE
Christoph Bergmeir
c.bergmeir at decsai.ugr.es
Tue Apr 30 02:20:52 CEST 2013
Hi Dirk (and the rest of the list),
I think I have it working; attached is a patch that adds this
functionality to RcppDE. I also came along something which is probably a
bug: The passed environment is never used. In line 75 of DEoptim.R you
just create one. I changed this to
if(!hasArg(env)) env <- new.env()
Now you can use it like this:
#--------------------------
# RcppDE example
#--------------------------
library(inline)
library(RcppDE)
inc <- 'double rastrigin(SEXP xs, SEXP env) {
Rcpp::NumericVector x(xs);
Rcpp::Environment e(env);
std::vector<double> param = e["x"];
int n = x.size();
double sum = 20.0;
for (int i=0; i<n; i++) {
sum += x[i]+2 - 10*cos(2*M_PI*x[i]);
Rprintf("ap: %f\\n", param[0]);
}
return(sum);
}
'
## now via a class returning external pointer
src.xptr <- '
typedef double (*funcPtr)(SEXP, SEXP);
return(XPtr<funcPtr>(new funcPtr(&rastrigin)));
'
create_xptr <- cxxfunction(signature(), body=src.xptr, inc=inc,
plugin="Rcpp")
n <- 10
maxIt <- 100
env <- new.env()
env[["x"]] <- 1:4
res <- RcppDE::DEoptim(fn=create_xptr(), env=env, lower=rep(-25, n),
upper=rep(25, n),
control=list(NP=10*n, itermax=maxIt, trace=FALSE))
res$optim
#------------------------------------------------
Regards and thanks for the help,
Christoph
On 04/29/2013 02:41 PM, Dirk Eddelbuettel wrote:
>
> On 29 April 2013 at 14:22, Christoph Bergmeir wrote:
> | Hi,
> |
> | ok, that's exactly the file I was looking at right now. The problem is
> | that my objective function is implemented in C++, and passed as an
> | external pointer. So in evaluate.h, instead of in the EvalStandard case
> | I'm in the EvalCompiled case, where the environment is not used. My
> | question now is if I can include it there somehow..
>
> Right. Just how EvalBase and EvalStandard extend the basic interface, we
> "just" need to create something that lets an XPtr be evaluation along with an
> environment.
>
> Anyway, past bedtime here so no more from me...
>
> Dirk
>
> | Regards,
> | Christoph
> |
> | On 04/29/2013 02:16 PM, Dirk Eddelbuettel wrote:
> | >
> | > On 29 April 2013 at 13:55, Christoph Bergmeir wrote:
> | > | Hi,
> | > |
> | > | thanks Dirk for the prompt reply. Ok, this was also the solution I had
> | > | in mind. I'll try to find the code in RcppDE or try to implement it
> | > | myself..I'll keep you posted with any advances.
> | >
> | > I think this may do the trick: demo/environment.R in the RcppDE package:
> | >
> | >
> | > suppressMessages(library(RcppDE))
> | >
> | > ## somewhat pathodological example with nuisance parameter mul
> | > Rastrigin <- function(x) {
> | > mul * (sum(x+2 - 10 * cos(2*pi*x)) + 20)
> | > }
> | >
> | > ## create a new environment associated with the function
> | > funenv <- environment(fun=Rastrigin)
> | > assign("mul", 2, envir=funenv) ## set value
> | >
> | > out <- DEoptim(Rastrigin, -25, 25,
> | > control=list(NP=10, trace=0),
> | > env=funenv)
> | > summary(out)
> | >
> | >
> | >
> | > Hth, Dirk
> | >
> | > |
> | > | Regards,
> | > | Christoph
> | > |
> | > | On 04/29/2013 01:44 PM, Dirk Eddelbuettel wrote:
> | > | >
> | > | > On 29 April 2013 at 12:37, Christoph Bergmeir wrote:
> | > | > | Dear list,
> | > | > |
> | > | > | I'm looking for some advice on a specific problem. Using RcppDE there is
> | > | > | the possibility to give the optimizer directly an external pointer to
> | > | > | the C++ function it will use as the objective function. I found this
> | > | > | mechanism pretty useful as it may speed up things quite a lot (I have a
> | > | > | problem where the speedup is from 17 minutes to some seconds), so that I
> | > | > | use the same mechanism as RcppDE in our package Rmalschains and in the
> | > | > | Rdonlp2 package, which is available from Rmetrics on Rforge.
> | > | > |
> | > | > | The problem that this mechanism has is that it cannot handle additional
> | > | > | parameters to the objective function. Having additional parameters is
> | > | >
> | > | > I think it can. The DEoptim folks, particularly Josh, pointed this out and
> | > | > the best general way is to assign all you need in a new environment -- which
> | > | > you can assign to from R and (thanks to Rcpp) from C++. Then pass that down.
> | > | >
> | > | > I think I have an example of that in the package but I don't have time right
> | > | > now to chase this.
> | > | >
> | > | > But yes, this _is_ a very neat feature and something that needs broader
> | > | > exposure.
> | > | >
> | > | > Maybe I can help in a few days.
> | > | >
> | > | > Dirk
> | > | >
> | > | > | often essential, because if you fit a model to data you need the data
> | > | > | available in the target function. I illustrate the problem with an
> | > | > | example I took from the RcppDE tests:
> | > | > |
> | > | > | #-----------------------------------------
> | > | > |
> | > | > | library(inline)
> | > | > | library(RcppDE)
> | > | > |
> | > | > | inc <- 'double rastrigin(SEXP xs) { //here I want to give it an
> | > | > | additional parameter: SEXP additional_parameter
> | > | > |
> | > | > | //Do something with the parameter, e.g. use it for result
> | > | > | calculation. Here we just want to print it
> | > | > | //double my_additional_parameter =
> | > | > | Rcpp::as<double>(additional_parameter);
> | > | > | //Rprintf("ap: %f\\n", my_additional_parameter);
> | > | > |
> | > | > | Rcpp::NumericVector x(xs);
> | > | > | int n = x.size();
> | > | > | double sum = 20.0;
> | > | > | for (int i=0; i<n; i++) {
> | > | > | sum += x[i]+2 - 10*cos(2*M_PI*x[i]);
> | > | > |
> | > | > | }
> | > | > | return(sum);
> | > | > | }
> | > | > | '
> | > | > |
> | > | > | src.xptr <- '
> | > | > | typedef double (*funcPtr)(SEXP);
> | > | > | return(XPtr<funcPtr>(new funcPtr(&rastrigin)));
> | > | > | '
> | > | > | create_xptr <- cxxfunction(signature(), body=src.xptr, inc=inc,
> | > | > | plugin="Rcpp")
> | > | > |
> | > | > | n <- 10
> | > | > | maxIt <- 100
> | > | > |
> | > | > | res <- RcppDE::DEoptim(fn=create_xptr(), lower=rep(-25, n),
> | > | > | upper=rep(25, n),
> | > | > | control=list(NP=10*n, itermax=maxIt, trace=FALSE)) #,
> | > | > | additional_paramater=25)
> | > | > |
> | > | > | res$optim
> | > | > |
> | > | > | #-----------------------------------------
> | > | > |
> | > | > | I currently get around this by having a global singleton object which
> | > | > | holds these parameters. This works but of course is not very nice when
> | > | > | it comes to parallelization. The code is more or less like this:
> | > | > |
> | > | > | //----------------------------------------------
> | > | > | class TargetFunction {
> | > | > |
> | > | > | private:
> | > | > |
> | > | > | static TargetFunction *TargetFunctionSingleton;
> | > | > | std::vector<double> param;
> | > | > | double objval;
> | > | > |
> | > | > | public:
> | > | > |
> | > | > | void eval(const double* x, int n) {
> | > | > | double sum = 20.0;
> | > | > | for (int i=0; i<n; i++) {
> | > | > | sum += x[i]+2 - 10*cos(2*M_PI*x[i]);
> | > | > | };
> | > | > |
> | > | > | //here I can use the parameter now!!
> | > | > | Rprintf("ap: %f\\n", param[0]);
> | > | > |
> | > | > | this->objval = sum;
> | > | > | };
> | > | > |
> | > | > | void init(std::vector<double> & p_param) {
> | > | > | this->param = p_param;
> | > | > | };
> | > | > |
> | > | > | static TargetFunction* getTargetFunctionSingleton() {
> | > | > | if( TargetFunctionSingleton == 0 )
> | > | > | TargetFunctionSingleton = new TargetFunction();
> | > | > | return TargetFunctionSingleton;
> | > | > | };
> | > | > |
> | > | > | static void deleteTargetFunctionSingleton(){
> | > | > | if( TargetFunctionSingleton == 0 ) return;
> | > | > | else {
> | > | > | delete TargetFunctionSingleton;
> | > | > | TargetFunctionSingleton = 0;
> | > | > | }
> | > | > | return;
> | > | > | };
> | > | > |
> | > | > | double getObjVal() {
> | > | > | return(objval);
> | > | > | };
> | > | > |
> | > | > |
> | > | > | };
> | > | > |
> | > | > | TargetFunction* TargetFunction::TargetFunctionSingleton = 0;
> | > | > |
> | > | > | RcppExport SEXP targetFunction(SEXP p_par)
> | > | > | {
> | > | > | Rcpp::NumericVector par(p_par);
> | > | > |
> | > | > | TargetFunction* sp = TargetFunction::getTargetFunctionSingleton();
> | > | > |
> | > | > | sp->eval(par.begin(), par.size());
> | > | > |
> | > | > | return Rcpp::wrap(sp->getObjVal());
> | > | > |
> | > | > | }
> | > | > |
> | > | > | RcppExport SEXP targetFunctionInit(SEXP p_param) {
> | > | > |
> | > | > | TargetFunction::deleteTargetFunctionSingleton();
> | > | > |
> | > | > | TargetFunction* sp = TargetFunction::getTargetFunctionSingleton();
> | > | > |
> | > | > | std::vector<double> param = Rcpp::as< std::vector<double> >(p_param);
> | > | > |
> | > | > | sp->init(param);
> | > | > |
> | > | > | return R_NilValue;
> | > | > |
> | > | > | }
> | > | > |
> | > | > | RcppExport SEXP GetTargetFunctionPtr() {
> | > | > |
> | > | > | typedef SEXP (*funcPtr)(SEXP);
> | > | > |
> | > | > | return (Rcpp::XPtr<funcPtr>(new funcPtr(&targetFunction)));
> | > | > | }
> | > | > | //-----------------------------------------------------
> | > | > |
> | > | > | Now, before doing the optimization, I call targetFunctionInit and set
> | > | > | the additional parameters. Afterwards, everything is as in the example
> | > | > | above, and I have the additional parameters available in the target
> | > | > | function. Now the question is how I could solve this more elegantly, or
> | > | > | more R like. The first thing that comes to mind is to use an R
> | > | > | environment instead of the singleton. However, how can I do this? I
> | > | > | could have a singleton list of objects and then use the address of the R
> | > | > | environment as a hash to find the right object in the list. But this is
> | > | > | probably not really the way R environments should be used, and I wonder
> | > | > | if this will cause any trouble.
> | > | > |
> | > | > | Any advise is highly appreciated.
> | > | > |
> | > | > | Regards,
> | > | > | Christoph
> | > | > |
> | > | > | --
> | > | > | Christoph Bergmeir
> | > | > | e-mail: c.bergmeir at decsai.ugr.es
> | > | > | Grupo SCI2S, DiCITS Lab (http://sci2s.ugr.es/DiCITS)
> | > | > | Dpto. de Ciencias de la Computacion e Inteligencia Artificial
> | > | > | E.T.S. Ingenierias de Informatica y Telecomunicacion
> | > | > | Universidad de Granada
> | > | > | 18071 - GRANADA (Spain)
> | > | > | _______________________________________________
> | > | > | Rcpp-devel mailing list
> | > | > | Rcpp-devel at lists.r-forge.r-project.org
> | > | > | https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
> | > | >
> | > |
> | > | --
> | > | Christoph Bergmeir
> | > | e-mail: c.bergmeir at decsai.ugr.es
> | > | Grupo SCI2S, DiCITS Lab (http://sci2s.ugr.es/DiCITS)
> | > | Dpto. de Ciencias de la Computacion e Inteligencia Artificial
> | > | E.T.S. Ingenierias de Informatica y Telecomunicacion
> | > | Universidad de Granada
> | > | 18071 - GRANADA (Spain)
> | >
> |
> | --
> | Christoph Bergmeir
> | e-mail: c.bergmeir at decsai.ugr.es
> | Grupo SCI2S, DiCITS Lab (http://sci2s.ugr.es/DiCITS)
> | Dpto. de Ciencias de la Computacion e Inteligencia Artificial
> | E.T.S. Ingenierias de Informatica y Telecomunicacion
> | Universidad de Granada
> | 18071 - GRANADA (Spain)
>
--
Christoph Bergmeir
e-mail: c.bergmeir at decsai.ugr.es
Grupo SCI2S, DiCITS Lab (http://sci2s.ugr.es/DiCITS)
Dpto. de Ciencias de la Computacion e Inteligencia Artificial
E.T.S. Ingenierias de Informatica y Telecomunicacion
Universidad de Granada
18071 - GRANADA (Spain)
-------------- next part --------------
A non-text attachment was scrubbed...
Name: RcppDE_patch_environment.diff
Type: text/x-patch
Size: 3258 bytes
Desc: not available
URL: <http://lists.r-forge.r-project.org/pipermail/rcpp-devel/attachments/20130430/7fd85ab9/attachment-0001.bin>
More information about the Rcpp-devel
mailing list