void MainThread ()
{
FILE *Fp_in;
FILE *Fp_out;
Fp_in = fopen("in.dat","r");
Fp_out = fopen("out.dat","w");
//-----Initialization of graphics----------------------
graphics_init();
//---optimization--------------------------------------
devol(Fp_in,Fp_out);
fclose(Fp_in);
fclose(Fp_out);
//-----enable zooming in and out even when optimization is finished----
while(1)
{
update_graphics(gt_best.fa_vector, gi_D, gfa_bound, gl_nfeval, gi_gen, gt_best.fa_cost[0],gi_strategy,gi_genmax);
Sleep(50); // provide some time (50ms) for the eye to see the graphics
if (gi_exit_flag == 1)
{
gi_exit_flag = 0;
}
}
}
int main(int argc, char *argv[])
{
FILE *Fp_in;
FILE *Fp_out;
if(argc == 2) {
Fp_in = fopen(argv[1],"r");
if(Fp_in == NULL) {
printf("Can't open %s.\n", argv[1]);
exit(1);
}
} else {
printf("Data file not provided!\n");
exit(1);
}
Fp_out = fopen("out.dat","w");
//---optimization--------------------------------------
devol(Fp_in,Fp_out);
fclose(Fp_in);
fclose(Fp_out);
}
// [[Rcpp::export]]
Rcpp::List DEoptim_impl(const arma::colvec & minbound, // user-defined lower bounds
const arma::colvec & maxbound, // user-defined upper bounds
SEXP fnS, // function to be optimized, either R or C++
const Rcpp::List & control, // parameters
SEXP rhoS) { // optional environment
double VTR = Rcpp::as<double>(control["VTR"]); // value to reach
int i_strategy = Rcpp::as<int>(control["strategy"]); // chooses DE-strategy
int i_itermax = Rcpp::as<int>(control["itermax"]); // Maximum number of generations
long l_nfeval = 0; // nb of function evals (NOT passed in)
int i_D = Rcpp::as<int>(control["npar"]); // Dimension of parameter vector
int i_NP = Rcpp::as<int>(control["NP"]); // Number of population members
int i_storepopfrom = Rcpp::as<int>(control["storepopfrom"]) - 1; // When to start storing populations
int i_storepopfreq = Rcpp::as<int>(control["storepopfreq"]); // How often to store populations
int i_specinitialpop = Rcpp::as<int>(control["specinitialpop"]); // User-defined inital population
double f_weight = Rcpp::as<double>(control["F"]); // stepsize
double f_cross = Rcpp::as<double>(control["CR"]); // crossover probability
int i_bs_flag = Rcpp::as<int>(control["bs"]); // Best of parent and child
int i_trace = Rcpp::as<int>(control["trace"]); // Print progress?
double i_pPct = Rcpp::as<double>(control["p"]); // p to define the top 100p% best solutions
double d_c = Rcpp::as<double>(control["c"]); // c as a trigger of the JADE algorithm
double d_reltol = Rcpp::as<double>(control["reltol"]); // tolerance for relative convergence test, default to be sqrt(.Machine$double.eps)
int i_steptol = Rcpp::as<double>(control["steptol"]); // maximum of iteration after relative convergence test is passed, default to be itermax
// as above, doing it in two steps is faster
Rcpp::NumericMatrix initialpopm = Rcpp::as<Rcpp::NumericMatrix>(control["initialpop"]);
arma::mat initpopm(initialpopm.begin(), initialpopm.rows(), initialpopm.cols(), false);
arma::mat ta_popP(i_D, i_NP*2); // Data structures for parameter vectors
arma::mat ta_oldP(i_D, i_NP);
arma::mat ta_newP(i_D, i_NP);
arma::colvec t_bestP(i_D);
arma::colvec ta_popC(i_NP*2); // Data structures for obj. fun. values
arma::colvec ta_oldC(i_NP);
arma::colvec ta_newC(i_NP);
double t_bestC;
arma::colvec t_bestitP(i_D);
arma::colvec t_tmpP(i_D);
int i_nstorepop = static_cast<int>(ceil(static_cast<double>((i_itermax - i_storepopfrom) / i_storepopfreq)));
arma::mat d_pop(i_D, i_NP);
Rcpp::List d_storepop(i_nstorepop);
arma::mat d_bestmemit(i_D, i_itermax);
arma::colvec d_bestvalit(i_itermax);
int i_iter = 0;
// call actual Differential Evolution optimization given the parameters
devol(VTR, f_weight, f_cross, i_bs_flag, minbound, maxbound, fnS, rhoS, i_trace, i_strategy, i_D, i_NP,
i_itermax, initpopm, i_storepopfrom, i_storepopfreq, i_specinitialpop,
ta_popP, ta_oldP, ta_newP, t_bestP, ta_popC, ta_oldC, ta_newC, t_bestC, t_bestitP, t_tmpP,
d_pop, d_storepop, d_bestmemit, d_bestvalit, i_iter, i_pPct, d_c, l_nfeval,
d_reltol, i_steptol);
return Rcpp::List::create(Rcpp::Named("bestmem") = t_bestP, // and return a named list with results to R
Rcpp::Named("bestval") = t_bestC,
Rcpp::Named("nfeval") = l_nfeval,
Rcpp::Named("iter") = i_iter,
Rcpp::Named("bestmemit") = trans(d_bestmemit),
Rcpp::Named("bestvalit") = d_bestvalit,
Rcpp::Named("pop") = trans(d_pop),
Rcpp::Named("storepop") = d_storepop);
}
RcppExport SEXP DEoptim(SEXP lowerS, SEXP upperS, SEXP fnS, SEXP controlS, SEXP rhoS) {
try {
Rcpp::NumericVector f_lower(lowerS), f_upper(upperS); // User-defined bounds
Rcpp::List control(controlS); // named list of params
double VTR = Rcpp::as<double>(control["VTR"]); // value to reach
int i_strategy = Rcpp::as<int>(control["strategy"]); // chooses DE-strategy
int i_itermax = Rcpp::as<int>(control["itermax"]); // Maximum number of generations
long l_nfeval = 0; // nb of function evals (NOT passed in)
int i_D = Rcpp::as<int>(control["npar"]); // Dimension of parameter vector
int i_NP = Rcpp::as<int>(control["NP"]); // Number of population members
int i_storepopfrom = Rcpp::as<int>(control["storepopfrom"]) - 1; // When to start storing populations
int i_storepopfreq = Rcpp::as<int>(control["storepopfreq"]); // How often to store populations
int i_specinitialpop = Rcpp::as<int>(control["specinitialpop"]);// User-defined inital population
Rcpp::NumericMatrix initialpopm = Rcpp::as<Rcpp::NumericMatrix>(control["initialpop"]);
double f_weight = Rcpp::as<double>(control["F"]); // stepsize
double f_cross = Rcpp::as<double>(control["CR"]); // crossover probability
int i_bs_flag = Rcpp::as<int>(control["bs"]); // Best of parent and child
int i_trace = Rcpp::as<int>(control["trace"]); // Print progress?
int i_check_winner = Rcpp::as<int>(control["checkWinner"]); // Re-evaluate best parameter vector?
int i_av_winner = Rcpp::as<int>(control["avWinner"]); // Average
double i_pPct = Rcpp::as<double>(control["p"]); // p to define the top 100p% best solutions
arma::colvec minbound(f_lower.begin(), f_lower.size(), false); // convert Rcpp vectors to arma vectors
arma::colvec maxbound(f_upper.begin(), f_upper.size(), false);
arma::mat initpopm(initialpopm.begin(), initialpopm.rows(), initialpopm.cols(), false);
arma::mat ta_popP(i_D, i_NP*2); // Data structures for parameter vectors
arma::mat ta_oldP(i_D, i_NP);
arma::mat ta_newP(i_D, i_NP);
arma::colvec t_bestP(i_D);
arma::colvec ta_popC(i_NP*2); // Data structures for obj. fun. values
arma::colvec ta_oldC(i_NP);
arma::colvec ta_newC(i_NP);
double t_bestC;
arma::colvec t_bestitP(i_D);
arma::colvec t_tmpP(i_D);
int i_nstorepop = ceil((i_itermax - i_storepopfrom) / i_storepopfreq);
arma::mat d_pop(i_D, i_NP);
Rcpp::List d_storepop(i_nstorepop);
arma::mat d_bestmemit(i_D, i_itermax);
arma::colvec d_bestvalit(i_itermax);
int i_iter = 0;
// call actual Differential Evolution optimization given the parameters
devol(VTR, f_weight, f_cross, i_bs_flag, minbound, maxbound, fnS, rhoS, i_trace, i_strategy, i_D, i_NP,
i_itermax, initpopm, i_storepopfrom, i_storepopfreq, i_specinitialpop, i_check_winner, i_av_winner,
ta_popP, ta_oldP, ta_newP, t_bestP, ta_popC, ta_oldC, ta_newC, t_bestC, t_bestitP, t_tmpP,
d_pop, d_storepop, d_bestmemit, d_bestvalit, i_iter, i_pPct, l_nfeval);
return Rcpp::List::create(Rcpp::Named("bestmem") = t_bestP, // and return a named list with results to R
Rcpp::Named("bestval") = t_bestC,
Rcpp::Named("nfeval") = l_nfeval,
Rcpp::Named("iter") = i_iter,
Rcpp::Named("bestmemit") = trans(d_bestmemit),
Rcpp::Named("bestvalit") = d_bestvalit,
Rcpp::Named("pop") = trans(d_pop),
Rcpp::Named("storepop") = d_storepop);
} catch( std::exception& ex) {
forward_exception_to_r(ex);
} catch(...) {
::Rf_error( "c++ exception (unknown reason)");
}
return R_NilValue;
}
SEXP DEoptimC(SEXP lower, SEXP upper, SEXP fn, SEXP control, SEXP rho, SEXP fnMap)
{
int i, j, P=0;
if (!isFunction(fn))
error("fn is not a function!");
if (!isEnvironment(rho))
error("rho is not an environment!");
/*-----Initialization of annealing parameters-------------------------*/
/* value to reach */
double VTR = NUMERIC_VALUE(getListElement(control, "VTR"));
/* chooses DE-strategy */
int i_strategy = INTEGER_VALUE(getListElement(control, "strategy"));
/* Maximum number of generations */
int i_itermax = INTEGER_VALUE(getListElement(control, "itermax"));
/* Dimension of parameter vector */
int i_D = INTEGER_VALUE(getListElement(control, "npar"));
/* Number of population members */
int i_NP = INTEGER_VALUE(getListElement(control, "NP"));
/* When to start storing populations */
int i_storepopfrom = INTEGER_VALUE(getListElement(control, "storepopfrom"))-1;
/* How often to store populations */
int i_storepopfreq = INTEGER_VALUE(getListElement(control, "storepopfreq"));
/* User-defined inital population */
int i_specinitialpop = INTEGER_VALUE(getListElement(control, "specinitialpop"));
double *initialpopv = NUMERIC_POINTER(getListElement(control, "initialpop"));
/* stepsize */
double d_weight = NUMERIC_VALUE(getListElement(control, "F"));
/* crossover probability */
double d_cross = NUMERIC_VALUE(getListElement(control, "CR"));
/* Best of parent and child */
int i_bs_flag = NUMERIC_VALUE(getListElement(control, "bs"));
/* Print progress? */
int i_trace = NUMERIC_VALUE(getListElement(control, "trace"));
/* p to define the top 100p% best solutions */
double d_pPct = NUMERIC_VALUE(getListElement(control, "p"));
/* crossover adaptation (a positive constant between 0 and 1) */
double d_c = NUMERIC_VALUE(getListElement(control, "c"));
/* relative tolerance */
double d_reltol = NUMERIC_VALUE(getListElement(control, "reltol"));
/* relative tolerance steps */
int i_steptol = NUMERIC_VALUE(getListElement(control, "steptol"));
int i_nstorepop = ceil((i_itermax - i_storepopfrom) / i_storepopfreq);
/* Use S_alloc, since it initializes with zeros FIXME: these should be SEXP */
double *gd_storepop = (double *)S_alloc(i_NP,sizeof(double) * i_D * i_nstorepop);
/* External pointers to return to R */
SEXP sexp_bestmem, sexp_bestval, sexp_nfeval, sexp_iter,
out, sexp_pop, sexp_storepop, sexp_bestmemit, sexp_bestvalit;
PROTECT(sexp_bestmem = NEW_NUMERIC(i_D)); P++;
PROTECT(sexp_pop = allocMatrix(REALSXP, i_D, i_NP)); P++;
PROTECT(sexp_bestmemit = allocMatrix(REALSXP, i_itermax, i_D)); P++;
PROTECT(sexp_bestvalit = allocVector(REALSXP, i_itermax)); P++;
double *gt_bestP = REAL(sexp_bestmem);
double *gd_pop = REAL(sexp_pop);
double *gd_bestmemit = REAL(sexp_bestmemit);
double *gd_bestvalit = REAL(sexp_bestvalit);
/* ensure lower and upper are double */
if(TYPEOF(lower) != REALSXP) {PROTECT(lower = coerceVector(lower, REALSXP)); P++;}
if(TYPEOF(upper) != REALSXP) {PROTECT(upper = coerceVector(upper, REALSXP)); P++;}
double *d_lower = REAL(lower);
double *d_upper = REAL(upper);
double gt_bestC;
int gi_iter = 0;
long l_nfeval = 0;
/*---optimization--------------------------------------*/
devol(VTR, d_weight, d_cross, i_bs_flag, d_lower, d_upper, fn, rho, i_trace,
i_strategy, i_D, i_NP, i_itermax,
initialpopv, i_storepopfrom, i_storepopfreq,
i_specinitialpop,
gt_bestP, >_bestC,
gd_pop, gd_storepop, gd_bestmemit, gd_bestvalit,
&gi_iter, d_pPct, d_c, &l_nfeval,
d_reltol, i_steptol, fnMap);
/*---end optimization----------------------------------*/
j = i_nstorepop * i_NP * i_D;
PROTECT(sexp_storepop = NEW_NUMERIC(j)); P++;
for (i = 0; i < j; i++)
NUMERIC_POINTER(sexp_storepop)[i] = gd_storepop[i];
PROTECT(sexp_nfeval = ScalarInteger(l_nfeval)); P++;
PROTECT(sexp_iter = ScalarInteger(gi_iter)); P++;
PROTECT(sexp_bestval = ScalarReal(gt_bestC)); P++;
const char *out_names[] = {"bestmem", "bestval", "nfeval",
"iter", "bestmemit", "bestvalit", "pop", "storepop", ""};
PROTECT(out = mkNamed(VECSXP, out_names)); P++;
SET_VECTOR_ELT(out, 0, sexp_bestmem);
SET_VECTOR_ELT(out, 1, sexp_bestval);
SET_VECTOR_ELT(out, 2, sexp_nfeval);
SET_VECTOR_ELT(out, 3, sexp_iter);
SET_VECTOR_ELT(out, 4, sexp_bestmemit);
SET_VECTOR_ELT(out, 5, sexp_bestvalit);
SET_VECTOR_ELT(out, 6, sexp_pop);
SET_VECTOR_ELT(out, 7, sexp_storepop);
UNPROTECT(P);
return out;
}
