/* zeroin2(f, ax, bx, f.ax, f.bx, tol, maxiter) */
SEXP zeroin2(SEXP call, SEXP op, SEXP args, SEXP rho)
{
double f_ax, f_bx;
double xmin, xmax, tol;
int iter;
SEXP v, res;
struct callinfo info;
args = CDR(args);
PrintDefaults();
/* the function to be minimized */
v = CAR(args);
if (!isFunction(v)) error(_("attempt to minimize non-function"));
args = CDR(args);
/* xmin */
xmin = asReal(CAR(args));
if (!R_FINITE(xmin)) error(_("invalid '%s' value"), "xmin");
args = CDR(args);
/* xmax */
xmax = asReal(CAR(args));
if (!R_FINITE(xmax)) error(_("invalid '%s' value"), "xmax");
if (xmin >= xmax) error(_("'xmin' not less than 'xmax'"));
args = CDR(args);
/* f(ax) = f(xmin) */
f_ax = asReal(CAR(args));
if (ISNA(f_ax)) error(_("NA value for '%s' is not allowed"), "f.lower");
args = CDR(args);
/* f(bx) = f(xmax) */
f_bx = asReal(CAR(args));
if (ISNA(f_bx)) error(_("NA value for '%s' is not allowed"), "f.upper");
args = CDR(args);
/* tol */
tol = asReal(CAR(args));
if (!R_FINITE(tol) || tol <= 0.0) error(_("invalid '%s' value"), "tol");
args = CDR(args);
/* maxiter */
iter = asInteger(CAR(args));
if (iter <= 0) error(_("'maxiter' must be positive"));
info.R_env = rho;
PROTECT(info.R_fcall = lang2(v, R_NilValue)); /* the info used in fcn2() */
PROTECT(res = allocVector(REALSXP, 3));
REAL(res)[0] =
R_zeroin2(xmin, xmax, f_ax, f_bx, (double (*)(double, void*)) fcn2,
(void *) &info, &tol, &iter);
REAL(res)[1] = (double)iter;
REAL(res)[2] = tol;
UNPROTECT(2);
return res;
}
/*
* root finder routines are copied from stats/src/zeroin.c
*/
double Logicle::R_zeroin( /* An estimate of the root */
double ax, /* Left border | of the range */
double bx, /* Right border| the root is seeked*/
double (*f)(double x, void *info), /* Function under investigation */
void *info, /* Add'l info passed on to f */
double *Tol, /* Acceptable tolerance */
int *Maxit) /* Max # of iterations */
{
double fa = (*f)(ax, info);
double fb = (*f)(bx, info);
return R_zeroin2(ax, bx, fa, fb, f, info, Tol, Maxit);
}
void Zeroin_( /* An estimate of the root */
double *ax, /* Left border | of the range */
double *bx, /* Right border| the root is seeked*/
double *fa,double *fb,
double (*f)(double x, void *info), /* Function under investigation */
void *info, /* Add'l info passed on to f */
double *Tol, /* Acceptable tolerance */
int *Maxit, /* Max # of iterations */
double *root) /* returned root */
{
*root= R_zeroin2(*ax, *bx,*fa,*fb,f, info,Tol, Maxit);
return;
}