/**
* Update V, Vtr and fac
*
* Note: May want to update fac in a separate operation. For the
* fixed-effects modules this will update the factor twice because
* it is separately updated in updateRzxRx.
*
* @param Xwt square root of the weights for the model matrices
* @param wtres weighted residuals
*/
void sPredModule::reweight(Rcpp::NumericMatrix const& Xwt,
Rcpp::NumericVector const& wtres) throw(std::runtime_error) {
if (d_coef.size() == 0) return;
double one = 1., zero = 0.;
int Wnc = Xwt.ncol();//, Wnr = Xwt.nrow(),
// Xnc = d_X.ncol, Xnr = d_X.nrow;
if ((Xwt.rows() * Xwt.cols()) != (int)d_X.nrow)
throw std::runtime_error("dimension mismatch");
// Rf_error("%s: dimension mismatch %s(%d,%d), %s(%d,%d)",
// "deFeMod::reweight", "X", Xnr, Xnc,
// "Xwt", Wnr, Wnc);
if (Wnc == 1) {
if (d_V) M_cholmod_free_sparse(&d_V, &c);
d_V = M_cholmod_copy_sparse(&d_X, &c);
chmDn csqrtX(Xwt);
M_cholmod_scale(&csqrtX, CHOLMOD_ROW, d_V, &c);
} else throw runtime_error("sPredModule::reweight: multiple columns in Xwt");
// FIXME write this combination using the triplet representation
chmDn cVtr(d_Vtr);
const chmDn cwtres(wtres);
M_cholmod_sdmult(d_V, 'T', &one, &zero, &cwtres, &cVtr, &c);
CHM_SP Vt = M_cholmod_transpose(d_V, 1/*values*/, &c);
d_fac.update(*Vt);
M_cholmod_free_sparse(&Vt, &c);
}
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;
}
// [[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);
}