[Rcpp-devel] Additional parameters for an objective function, e.g. in RcppDE

[Dirk Eddelbuettel]

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)

-- 
Dirk Eddelbuettel | edd at debian.org | http://dirk.eddelbuettel.com