Пример #1
0
    /** 
     * 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);
    }
Пример #2
0
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;
}
Пример #3
0
// [[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); 

}