void R_approx(double *x, double *y, int *nxy, double *xout, int *nout,
int *method, double *yleft, double *yright, double *f)
{
int i;
appr_meth M = {0.0, 0.0, 0.0, 0.0, 0}; /* -Wall */
/* check interpolation method */
switch(*method) {
case 1: /* linear */
break;
case 2: /* constant */
if(!R_FINITE(*f) || *f < 0 || *f > 1)
error(_("approx(): invalid f value"));
M.f2 = *f;
M.f1 = 1 - *f;
break;
default:
error(_("approx(): invalid interpolation method"));
break;
}
for(i = 0 ; i < *nxy ; i++)
if(ISNA(x[i]) || ISNA(y[i]))
error(_("approx(): attempted to interpolate NA values"));
M.kind = *method;
M.ylow = *yleft;
M.yhigh = *yright;
for(i = 0 ; i < *nout; i++)
if(!ISNA(xout[i]))
xout[i] = approx1(xout[i], x, y, *nxy, &M);
}
void R_approxfun(double *x, double *y, int *nxy, double *xout, int *nout,
int *method, double *yleft, double *yright, double *f)
{
int i;
appr_meth M = {0.0, 0.0, 0.0, 0.0, 0}; /* -Wall */
M.f2 = *f;
M.f1 = 1 - *f;
M.kind = *method;
M.ylow = *yleft;
M.yhigh = *yright;
for(i = 0; i < *nout; i++)
if(!ISNA(xout[i])) xout[i] = approx1(xout[i], x, y, *nxy, &M);
}
static void
R_approxfun(double *x, double *y, int nxy, double *xout, double *yout,
int nout, int method, double yleft, double yright, double f)
{
int i;
appr_meth M = {0.0, 0.0, 0.0, 0.0, 0}; /* -Wall */
M.f2 = f;
M.f1 = 1 - f;
M.kind = method;
M.ylow = yleft;
M.yhigh = yright;
for(i = 0; i < nout; i++)
yout[i] = ISNAN(xout[i]) ? xout[i] : approx1(xout[i], x, y, nxy, &M);
}
void approx(double *x, double *y, int nxy, double *xout, double *yout,
int nout, int method, double yleft, double yright, double f)
{
int i;
appr_meth M = {0.0, 0.0, 0.0, 0.0, 0}; /* -Wall */
M.f2 = f;
M.f1 = 1 - f;
M.kind = method;
M.ylow = yleft;
M.yhigh = yright;
for(i = 0; i < nout; i++)
yout[i] = approx1(xout[i], x, y, nxy, &M);
return;
}
void R_approx(double *x, double *y, int *nxy, double *xout, int *nout,
int *method, double *yleft, double *yright, double *f)
{
int i;
appr_meth M = {0.0, 0.0, 0.0, 0.0, 0}; /* -Wall */
/* check interpolation method */
switch(*method) {
case 1: /* linear */
break;
case 2: /* constant */
if(!R_FINITE(*f) || *f < 0 || *f > 1)
error("approx(): invalid f value");
M.f2 = *f;
M.f1 = 1 - *f;
break;
default:
error("approx(): invalid interpolation method");
break;
}
// CODE ALTERATION: permit NA here
#if 0
for(i = 0 ; i < *nxy ; i++)
if(ISNA(x[i]) || ISNA(y[i]))
error("approx(): attempted to interpolate NA values");
#endif
M.kind = *method;
M.ylow = *yleft;
M.yhigh = *yright;
// CODE ALTERATION: permit NA in x and y; just make the answer be
// NA in such cases.
for(i = 0 ; i < *nout; i++) {
if (ISNA(x[i]) || ISNA(y[i]) || ISNA(xout[i])) {
xout[i] = NA_REAL;
} else {
xout[i] = approx1(xout[i], x, y, *nxy, &M);
}
}
}
void test_polynomial()
{
#if defined(BOOST_MATH_NO_DEDUCED_FUNCTION_POINTERS)
double (*f)(double) = boost::math::expm1<double>;
#else
double (*f)(double) = boost::math::expm1;
#endif
std::cout << "Testing expm1 approximation, pinned to origin, abolute error, 6 term polynomial\n";
boost::math::tools::remez_minimax<double> approx1(f, 6, 0, -1, 1, true, false);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx1.iterate();
std::cout << approx1.error_term() << " " << approx1.max_error() << " " << approx1.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
std::cout << "Testing expm1 approximation, pinned to origin, relative error, 6 term polynomial\n";
boost::math::tools::remez_minimax<double> approx2(f, 6, 0, -1, 1, true, true);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx2.iterate();
std::cout << approx2.error_term() << " " << approx2.max_error() << " " << approx2.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
f = std::exp;
std::cout << "Testing exp approximation, not pinned to origin, abolute error, 6 term polynomial\n";
boost::math::tools::remez_minimax<double> approx3(f, 6, 0, -1, 1, false, false);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx3.iterate();
std::cout << approx3.error_term() << " " << approx3.max_error() << " " << approx3.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
std::cout << "Testing exp approximation, not pinned to origin, relative error, 6 term polynomial\n";
boost::math::tools::remez_minimax<double> approx4(f, 6, 0, -1, 1, false, true);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx4.iterate();
std::cout << approx4.error_term() << " " << approx4.max_error() << " " << approx4.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
f = std::cos;
std::cout << "Testing cos approximation, not pinned to origin, abolute error, 5 term polynomial\n";
boost::math::tools::remez_minimax<double> approx5(f, 5, 0, -1, 1, false, false);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx5.iterate();
std::cout << approx5.error_term() << " " << approx5.max_error() << " " << approx5.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
std::cout << "Testing cos approximation, not pinned to origin, relative error, 5 term polynomial\n";
boost::math::tools::remez_minimax<double> approx6(f, 5, 0, -1, 1, false, true);
for(unsigned i = 0; i < 7; ++i)
{
approx6.iterate();
std::cout << approx6.error_term() << " " << approx6.max_error() << " " << approx6.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
f = std::sin;
std::cout << "Testing sin approximation, pinned to origin, abolute error, 4 term polynomial\n";
boost::math::tools::remez_minimax<double> approx7(f, 4, 0, 0, 1, true, false);
for(unsigned i = 0; i < 7; ++i)
{
approx7.iterate();
std::cout << approx7.error_term() << " " << approx7.max_error() << " " << approx7.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
std::cout << "Testing sin approximation, pinned to origin, relative error, 4 term polynomial\n";
boost::math::tools::remez_minimax<double> approx8(f, 4, 0, 0, 1, true, true);
for(unsigned i = 0; i < 7; ++i)
{
approx8.iterate();
std::cout << approx8.error_term() << " " << approx8.max_error() << " " << approx8.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
}
void test_rational()
{
#if defined(BOOST_MATH_NO_DEDUCED_FUNCTION_POINTERS)
double (*f)(double) = boost::math::expm1<double>;
#else
double (*f)(double) = boost::math::expm1;
#endif
std::cout << "Testing expm1 approximation, pinned to origin, abolute error, 3+3 term rational\n";
boost::math::tools::remez_minimax<double> approx1(f, 3, 3, -1, 1, true, false);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx1.iterate();
std::cout << approx1.error_term() << " " << approx1.max_error() << " " << approx1.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
#if 0
//
// This one causes UBLAS to fail on some systems, so disabled for now.
//
std::cout << "Testing expm1 approximation, pinned to origin, relative error, 3+3 term rational\n";
boost::math::tools::remez_minimax<double> approx2(f, 3, 3, -1, 1, true, true);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx2.iterate();
std::cout << approx2.error_term() << " " << approx2.max_error() << " " << approx2.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
#endif
f = std::exp;
std::cout << "Testing exp approximation, not pinned to origin, abolute error, 3+3 term rational\n";
boost::math::tools::remez_minimax<double> approx3(f, 3, 3, -1, 1, false, false);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx3.iterate();
std::cout << approx3.error_term() << " " << approx3.max_error() << " " << approx3.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
std::cout << "Testing exp approximation, not pinned to origin, relative error, 3+3 term rational\n";
boost::math::tools::remez_minimax<double> approx4(f, 3, 3, -1, 1, false, true);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx4.iterate();
std::cout << approx4.error_term() << " " << approx4.max_error() << " " << approx4.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
f = std::cos;
std::cout << "Testing cos approximation, not pinned to origin, abolute error, 2+2 term rational\n";
boost::math::tools::remez_minimax<double> approx5(f, 2, 2, 0, 1, false, false);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx5.iterate();
std::cout << approx5.error_term() << " " << approx5.max_error() << " " << approx5.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
std::cout << "Testing cos approximation, not pinned to origin, relative error, 2+2 term rational\n";
boost::math::tools::remez_minimax<double> approx6(f, 2, 2, 0, 1, false, true);
std::cout << "Interpolation Error: " << approx1.max_error() << std::endl;
for(unsigned i = 0; i < 7; ++i)
{
approx6.iterate();
std::cout << approx6.error_term() << " " << approx6.max_error() << " " << approx6.max_change() << std::endl;
}
std::cout << "~~~~~~~~~~~~~~~~~~~~~~~~~" << std::endl;
}
void mvn1(int m, double w[], double x[], double r[][M], int nsim, double eps,
double *pr, double *sd, int *ifail)
/* first order approximation for conditional probabilities */
/* ref. Joe (1993). Approximations to Multivariate Normal Rectangle
Probabilities Based on Conditional Expectations*/
/* INPUT
m = dimension of multivariate normal probability
w = vector of lower bounds
x = vector of upper bounds
r = correlation matrix (1's on the diagonal)
nsim = number of random permutations used
[ nsim=0 for enumerating all permutations, otherwise random perms
nsim=0 recommended for m<=6 ]
eps = error bound for 2-D bivariate probabilities (1.e-6 recommended)
OUTPUT
pr = probability of rectangle: P(w_i<X_i<z_i, i=1,...,n)
sd = measurement of accuracy (SD from the permuted conditional prob's)
ifail = code for whether prob was succesfully computed
(ifail =0 for success, ifail >0 for failure)
ROUTINES CALLED (directly or indirectly):
mulnor (Schervish's MVN prob)
bivnor (Donnelly's bivariate normal upper quadrant prob)
pnorms (univariate standard normal cdf)
approx1, cond1 (approx to conditional probs)
nexper (generate permutations systematically)
isamp (generate random permutations)
gepp (linear system solver, Gaussian elim with partial pivoting)
*/
/* w[0], x[0], r[0][], r[][0] not used here */
/* No checks are done on r, eg., positive definiteness not checked,
an error may or may not occur if r is not a corr. matrix (user-beware) */
/* for the positive equicorrelated case, use
the 1-dimensional integral given on page 193 of Tong's book
on the multivariate normal distribution */
{ double lb[8],ub[8],bound,eps1,s[22],tem;
double p[M],pp[M][M],sc,sc2,rect;
int i,ifault,inf[8],m1,j,ii,is,even,a[M],idet,isim,k,mm;
int typ[M];
void isamp(int *, int);
double pnorms(double);
void mulnor(double [], double [], double [], double, int,
int [], double *, double *, int *);
void nexper(int, int [], int *, int *);
void approx1(double [], double [], double [][M], int, int [],
double [], double [][M], double *, int *);
*ifail=0;
for(i=1;i<=m;i++) { if(w[i]>=x[i]) { *ifail=1; *pr=0.; *sd=0.; return;}}
if(m==1) { *pr=pnorms(x[1])-pnorms(w[1]); *sd=1.e-6; return;}
if(m==2)
{ inf[0]=2; inf[1]=2; eps1=1.e-6;
lb[0]=w[1]; lb[1]=w[2]; ub[0]=x[1]; ub[1]=x[2]; s[0]=r[1][2];
mulnor(ub,lb,s,eps1,m,inf,&rect,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
*pr=rect; *sd=bound; *ifail=ifault; return;
}
/* m>=3 */
/* some changes for x_i or w_i = oo, May 13, 1994 */
/* for(i=1;i<=m;i++)
{ p[i]=pnorms(x[i])-pnorms(w[i]);}
m1=2; inf[0]=2; inf[1]=2;*/
for(i=1;i<=m;i++)
{ if (w[i]<=-5.) { typ[i]=1; p[i]=pnorms(x[i]);}
else if(x[i]>=5.) {typ[i]=0; p[i]=1.-pnorms(w[i]);}
else { typ[i]=2; p[i]=pnorms(x[i])-pnorms(w[i]);}
}
m1=2;
for(i=1;i<=m;i++) pp[i][i]=p[i]*(1.-p[i]);
for(i=1;i<m;i++)
{ for(j=i+1;j<=m;j++)
{ lb[0]=w[i]; lb[1]=w[j]; ub[0]=x[i]; ub[1]=x[j];
s[0]=r[i][j];
inf[0]=typ[i]; inf[1]=typ[j];
mulnor(ub,lb,s,eps,m1,inf,&tem,&bound,&ifault);
if(ifault!=0)
{ printf("error in mulnor %d\n", ifault);
*pr=0.; *sd=bound; *ifail=ifault; return;
}
pp[i][j]=tem-p[j]*p[i];
pp[j][i]=pp[i][j];
}
}
if(nsim==0) { /*enumerate all permutations */
is=0; ii=0; sc=0.; sc2=0.;
for(i=2,mm=1;i<=m;i++) mm*=i;
for(k=1;k<=mm;k++)
/*do*/ { nexper(m,a,&is,&even);
if(a[1]<a[2])
{ approx1(w,x,r,m,a,p,pp,&rect,&idet);
if(idet==1) { ii++; sc+=rect; sc2+=rect*rect;
/*printf("%8.4f", rect);*/
}
// HJ check May 11, 2004
//printf("%d %8.4f\n", k,rect);
}
} /*while(is==1);*/
/*printf("\n");*/
}
else /* random permutations */
{ ii=0; sc=0.; sc2=0.;
for(isim=1;isim<=nsim;isim++)
{ isamp(a,m);
approx1(w,x,r,m,a,p,pp,&rect,&idet);
if(idet==1) { ii++; sc+=rect; sc2+=rect*rect;}
}
}
sc/=ii; sc2=(sc2-ii*sc*sc)/(ii-1.);
*pr=sc; if(sc2>0.) *sd=sqrt(sc2); else *sd=0.;
/* printf(" mean approx=%9.5f %9.5f %3d\n\n",sc,*sd,ii);*/
}
