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

Dirk Eddelbuettel edd at debian.org
Mon Apr 29 06:41:42 CEST 2013


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)

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


More information about the Rcpp-devel mailing list