[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