示例#1
0
void rankSample(NimArr<1, double> &weights, int &n, NimArr<1, int> &output, bool& silent) {
  //PRINTF("in VOID rankSample\n");
  output.setSize(n);
  int N = weights.size();
  //GetRNGstate();
  rawSample(weights.getPtr(), n, N, output.getPtr(), false, silent);
  //PutRNGstate();
}
示例#2
0
void SEXP_2_NimArr<1>(SEXP Sn, NimArr<1, int> &ans) {
  if(!(isNumeric(Sn) || isLogical(Sn))) PRINTF("Error: SEXP_2_NimArr<1> called for SEXP that is not a numeric or logical!\n");
  int nn = LENGTH(Sn);
  if(ans.size() != 0) PRINTF("Error: trying to reset a NimArr that was already sized\n");
  ans.setSize(nn);
  if(isReal(Sn)) {
     std::copy(REAL(Sn), REAL(Sn) + nn, ans.getPtr());	
  } else {
    if(isInteger(Sn) || isLogical(Sn)) {
      int *iSn = isInteger(Sn) ? INTEGER(Sn) : LOGICAL(Sn);
      for(int i = 0; i < nn; ++i) {
	ans(i) = static_cast<double>(iSn[i]);
      }
    } else {
      PRINTF("Error: We could not handle the R input type to SEXP_2_NimArr<1>\n");
    }
  }
}
示例#3
0
void nimble_optim_withVarArgs(void* nimFun, OptimControl* control, OptimAns* ans,
				 	NimArr<1, double> par, optimfn objFxn,
				 	int numOtherArgs, ...){

	//Steps required:	
	//Unpack parts of control (things that are required for all optimizers)
	//Decide optimizer {
	//Based on optimizer, unpack specialized part of optimControl and call appropriate optimizer	
	//  unpack results of optimizer into ans
	//	}
	// ?return ans (depends if we want to allow return of nimble functions)

	// Generic Unpacking	
	int n = par.size();
	double* xin = &(par[0]);	//IF we want to leave par untouched by optim, we could copy these values instead of pointing at them
	double* x = &(ans->par[0]);
	double* Fmin = &(ans->Fmin);
	int* fail = &(ans->fail);
	int* fncount = &(ans->fncount);
	vector<void*>* otherArgs = new vector<void*>(numOtherArgs);
	va_list vl;
	va_start(vl, numOtherArgs);
	for(int i = 0; i < numOtherArgs; i++)
		(*otherArgs)[i] = va_arg(vl, void*);
	va_end(vl);
	vector<void*>* ex = new vector<void*> (2);
	(*ex)[0] = nimFun;
	(*ex)[1] = otherArgs;
	//Choosing and applying optimizer
	//Just using Nelder Mead as example here
	if( control->optimType == 1 ){
		NM_OptimControl* nmControl = static_cast<NM_OptimControl*>(control);	
			nmmin(n, xin, x, Fmin, objFxn, fail, nmControl->abstol, nmControl->intol,
			static_cast<void*> (ex), nmControl->alpha, nmControl->beta, nmControl->gamma, nmControl->trace,
			fncount, nmControl->maxit);
	
	}		
		delete ex;
		delete otherArgs;
	//actually, nothing else to do at this point! 
	//Could return ans if we decided to build it on the fly here instead of providing it as argument
}	
示例#4
0
void bareBonesOptim(NimArr<1, double> initPar, optimfn objFxn, void* nfPtr, int nargs,  ...){
	int n1 = initPar.size();
	NM_OptimControl* nmControl = new NM_OptimControl(1.0, 0.5, 2.0,0.0001, 0.0001, 500, 0);
	OptimAns* optAns = new OptimAns(n1);
	optAns->Fmin = 100;
	vector<void*>* otherArgs = new vector<void*>(nargs);
	va_list vl;
	va_start(vl, nargs);
	for(int i = 0; i < nargs; i++)
		(*otherArgs)[i] = va_arg(vl, void*);
	va_end(vl);
	
    void* vp_otherArgs = static_cast<void*>(otherArgs);
    
	nimble_optim(nfPtr, static_cast<OptimControl*>(nmControl), optAns,
					 initPar, vp_otherArgs, objFxn);
	
	Rprintf("Called bareBonesOptim, final value = %f\n", optAns->Fmin);
	
    delete nmControl;
    delete optAns;
    delete otherArgs;
	
}	
示例#5
0
文件: nimOptim.cpp 项目: cran/nimble
// This attempts to match the behavior of optim() defined in the documentation
//   https://stat.ethz.ch/R-manual/R-devel/library/stats/html/optim.html
// and in the reference implementation
//   https://svn.r-project.org/R/trunk/src/library/stats/R/optim.R
//   https://svn.r-project.org/R/trunk/src/library/stats/src/optim.c
//   https://svn.r-project.org/R/trunk/src/include/R_ext/Applic.h
nimSmartPtr<OptimResultNimbleList> NimOptimProblem::solve(
    NimArr<1, double>& par) {
    NIM_ASSERT1(!par.isMap(), "Internal error: failed to handle mapped NimArr");
    const int n = par.dimSize(0);

    nimSmartPtr<OptimResultNimbleList> result = new OptimResultNimbleList;
    result->par = par;
    result->counts.initialize(NA_INTEGER, true, 2);
    if (hessian_) {
        result->hessian.initialize(NA_REAL, true, n, n);
    }

    // Set context-dependent default control_ values.
    if (control_->maxit == NA_INTEGER) {
        if (method_ == "Nelder-Mead") {
            control_->maxit = 500;
        } else {
            control_->maxit = 100;
        }
    }

    // Parameters common to all methods.
    double* dpar = par.getPtr();
    double* X = result->par.getPtr();
    double* Fmin = &(result->value);
    int* fail = &(result->convergence);
    void* ex = this;
    int* fncount = &(result->counts[0]);
    int* grcount = &(result->counts[1]);

    if (method_ == "Nelder-Mead") {
        nmmin(n, dpar, X, Fmin, NimOptimProblem::fn, fail, control_->abstol,
              control_->reltol, ex, control_->alpha, control_->beta,
              control_->gamma, control_->trace, fncount, control_->maxit);
    } else if (method_ == "BFGS") {
        std::vector<int> mask(n, 1);
        vmmin(n, dpar, Fmin, NimOptimProblem::fn, NimOptimProblem::gr,
              control_->maxit, control_->trace, mask.data(), control_->abstol,
              control_->reltol, control_->REPORT, ex, fncount, grcount, fail);
        result->par = par;
    } else if (method_ == "CG") {
        cgmin(n, dpar, X, Fmin, NimOptimProblem::fn, NimOptimProblem::gr, fail,
              control_->abstol, control_->reltol, ex, control_->type,
              control_->trace, fncount, grcount, control_->maxit);
    } else if (method_ == "L-BFGS-B") {
        if (lower_.dimSize(0) == 1) lower_.initialize(lower_[0], true, n);
        if (upper_.dimSize(0) == 1) upper_.initialize(upper_[0], true, n);
        NIM_ASSERT_SIZE(lower_, n);
        NIM_ASSERT_SIZE(upper_, n);
        std::vector<int> nbd(n, 0);
        for (int i = 0; i < n; ++i) {
            if (std::isfinite(lower_[i])) nbd[i] |= 1;
            if (std::isfinite(upper_[i])) nbd[i] |= 2;
        }
        char msg[60];
        lbfgsb(n, control_->lmm, X, lower_.getPtr(), upper_.getPtr(),
               nbd.data(), Fmin, NimOptimProblem::fn, NimOptimProblem::gr, fail,
               ex, control_->factr, control_->pgtol, fncount, grcount,
               control_->maxit, msg, control_->trace, control_->REPORT);
        result->message = msg;
    } else {
        NIMERROR("Unknown method_: %s", method_.c_str());
    }
    result->value *= control_->fnscale;

    // Compute Hessian.
    if (hessian_) {
        Rf_warning("Hessian computation is not implemented");  // TODO
    }

    return result;
}