Ejemplo n.º 1
0
//[[Rcpp::export]]
std::vector<double> biexponential_transform(std::vector<double> input,double A,double B,double C,double D,double F,double W,double tol,int maxIt) {

	struct biexponential_info params;
	
	int    i;
    int fail=0;
	double step;
	params.a = A;
	params.b = B;
	params.c = C;
	params.d = D;
	params.f = F;
    params.w = W;

    unsigned nLen = input.size();
	for(i=0;i<nLen;i++) {
		int j;
		double Tol = tol;
		int MaxIt = maxIt;
		params.y = input.at(i);
		for(j=0,step=0.5; biexponential_fn(-step,(void*)&params)*biexponential_fn(step,(void*)&params) >0;step*=1.5,j+=1){
			if(j > MaxIt){
				  break;
			  }
		}
		input.at(i) = R_zeroin(-step,step,biexponential_fn,(void*)&params,&Tol,&MaxIt);
		if(MaxIt==-1){
			fail=fail+1;
		}
        }
	if(fail>0)
		Rcpp::warning("%d values of %d have not converged.",fail,nLen);

	return input;
}
Ejemplo n.º 2
0
//[[Rcpp::export]]
std::vector<double> biexponential_transform(std::vector<double> input,
                                            double A, double B, double C,
                                            double D, double F, double W,
                                            double tol, int maxIt) {
  struct biexponential_info params;
  params.a = A;
  params.b = B;
  params.c = C;
  params.d = D;
  params.f = F;
  params.w = W;
  void* pParams = (void*)&params;
  int fail = 0;
  for(int i=0; i < input.size(); i++) {
    params.y = input.at(i);
    double step = 0.5;
    for(int j=0; j<maxIt; j++, step*=1.5) {
      double bi1 = biexponential_fn(step, pParams);
      double bi2 = biexponential_fn(-step, pParams);
      if (bi1 * bi2 > 0) {
        break;
      }
    }
    double tol_ = tol;
    int maxIt_ = maxIt;
    input.at(i) = R_zeroin(-step, step, biexponential_fn, pParams, &tol_, &maxIt_);
    if(MaxIt==-1){
      fail=fail+1;
    }
  }
  if(fail>0)
    Rcpp::warning("%d values have not converged.", fail);

  return input;
}
Ejemplo n.º 3
0
/* zeroin(f, xmin, xmax, tol, maxiter) */
SEXP do_zeroin(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    double xmin, xmax, tol;
    int iter;
    SEXP v, res;
    struct callinfo info;

    checkArity(op, args);
    PrintDefaults(rho);

    /* the function to be minimized */

    v = CAR(args);
    if (!isFunction(v))
	errorcall(call, _("attempt to minimize non-function"));
    args = CDR(args);

    /* xmin */

    xmin = asReal(CAR(args));
    if (!R_FINITE(xmin))
	errorcall(call, _("invalid 'xmin' value"));
    args = CDR(args);

    /* xmax */

    xmax = asReal(CAR(args));
    if (!R_FINITE(xmax))
	errorcall(call, _("invalid 'xmax' value"));
    if (xmin >= xmax)
	errorcall(call, _("'xmin' not less than 'xmax'"));
    args = CDR(args);

    /* tol */

    tol = asReal(CAR(args));
    if (!R_FINITE(tol) || tol <= 0.0)
	errorcall(call, _("invalid 'tol' value"));
    args = CDR(args);

    /* maxiter */
    iter = asInteger(CAR(args));
    if (iter <= 0)
	errorcall(call, _("'maxiter' must be positive"));

    info.R_env = rho;
    PROTECT(info.R_fcall = lang2(v, R_NilValue)); /* the info used in fcn2() */
    SETCADR(info.R_fcall, allocVector(REALSXP, 1));
    PROTECT(res = allocVector(REALSXP, 3));
    REAL(res)[0] =
	R_zeroin(xmin, xmax,   (double (*)(double, void*)) fcn2,
		 (void *) &info, &tol, &iter);
    REAL(res)[1] = (double)iter;
    REAL(res)[2] = tol;
    UNPROTECT(2);
    return res;
}
Ejemplo n.º 4
0
/*
 * use R built-in root finder API :R_zeroin
 */
double Logicle::solve (double b, double w)
{
	// w == 0 means its really arcsinh
	if (w == 0)
		return b;

	// precision is the same as that of b
	double tolerance = 2 * b * EPSILON;
	struct sfun_info params;
	params.b=b;
	params.w=w;

	// bracket the root
	double d_lo = 0;
	double d_hi = b;


	int MaxIt = 20;
	double d ;
	d= R_zeroin(d_lo,d_hi,logicle_fn,(void*)&params,&tolerance,&MaxIt);
	return d;
}