/** * 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); }