/*************************************************************************
Inverse of the error function
Cephes Math Library Release 2.8: June, 2000
Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier
*************************************************************************/
double inverf(double e)
{
double result;
result = invnormaldistribution(0.5*(e+1))/sqrt(double(2));
return result;
}
/*************************************************************************
Inverse of complemented imcomplete gamma integral
Given p, the function finds x such that
igamc( a, x ) = p.
Starting with the approximate value
3
x = a t
where
t = 1 - d - ndtri(p) sqrt(d)
and
d = 1/9a,
the routine performs up to 10 Newton iterations to find the
root of igamc(a,x) - p = 0.
ACCURACY:
Tested at random a, p in the intervals indicated.
a p Relative error:
arithmetic domain domain # trials peak rms
IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15
IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15
IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14
Cephes Math Library Release 2.8: June, 2000
Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
*************************************************************************/
double invincompletegammac(double a, double y0)
{
double result;
double igammaepsilon;
double iinvgammabignumber;
double x0;
double x1;
double x;
double yl;
double yh;
double y;
double d;
double lgm;
double dithresh;
int i;
int dir;
double tmp;
igammaepsilon = 0.000000000000001;
iinvgammabignumber = 4503599627370496.0;
x0 = iinvgammabignumber;
yl = 0;
x1 = 0;
yh = 1;
dithresh = 5*igammaepsilon;
d = 1/(9*a);
y = 1-d-invnormaldistribution(y0)*sqrt(d);
x = a*y*y*y;
lgm = lngamma(a, tmp);
i = 0;
while(i<10)
{
if( ap::fp_greater(x,x0)||ap::fp_less(x,x1) )
{
d = 0.0625;
break;
}
y = incompletegammac(a, x);
if( ap::fp_less(y,yl)||ap::fp_greater(y,yh) )
{
d = 0.0625;
break;
}
if( ap::fp_less(y,y0) )
{
x0 = x;
yl = y;
}
else
{
x1 = x;
yh = y;
}
d = (a-1)*log(x)-x-lgm;
if( ap::fp_less(d,-709.78271289338399) )
{
d = 0.0625;
break;
}
d = -exp(d);
d = (y-y0)/d;
if( ap::fp_less(fabs(d/x),igammaepsilon) )
{
result = x;
return result;
}
x = x-d;
i = i+1;
}
if( ap::fp_eq(x0,iinvgammabignumber) )
{
if( ap::fp_less_eq(x,0) )
{
x = 1;
}
while(ap::fp_eq(x0,iinvgammabignumber))
{
x = (1+d)*x;
y = incompletegammac(a, x);
if( ap::fp_less(y,y0) )
{
x0 = x;
yl = y;
break;
}
d = d+d;
}
}
d = 0.5;
dir = 0;
i = 0;
while(i<400)
{
x = x1+d*(x0-x1);
y = incompletegammac(a, x);
lgm = (x0-x1)/(x1+x0);
if( ap::fp_less(fabs(lgm),dithresh) )
{
break;
}
lgm = (y-y0)/y0;
if( ap::fp_less(fabs(lgm),dithresh) )
{
break;
}
if( ap::fp_less_eq(x,0.0) )
{
break;
}
if( ap::fp_greater_eq(y,y0) )
{
x1 = x;
yh = y;
if( dir<0 )
{
dir = 0;
d = 0.5;
}
else
{
if( dir>1 )
{
d = 0.5*d+0.5;
}
else
{
d = (y0-yl)/(yh-yl);
}
}
dir = dir+1;
}
else
{
x0 = x;
yl = y;
if( dir>0 )
{
dir = 0;
d = 0.5;
}
else
{
if( dir<-1 )
{
d = 0.5*d;
}
else
{
d = (y0-yl)/(yh-yl);
}
}
dir = dir-1;
}
i = i+1;
}
result = x;
return result;
}
