double pdtr( int k, double m )
{
double v;
if( (k < 0) || (m <= 0.0) )
{
mtherr( "pdtr", DOMAIN );
return( 0.0 );
}
v = k+1;
return( igamc( v, m ) );
}
static DBL igam(DBL a, DBL x)
{
DBL ans, ax, c, r;
int sgngam = 0;
if ((x <= 0) || (a <= 0))
{
return (0.0);
}
if ((x > 1.0) && (x > a))
{
return (1.0 - igamc(a, x));
}
/* Compute x**a * exp(-x) / gamma(a) */
ax = a * log(x) - x - lgam(a, &sgngam);
if (ax < -MAXLOG)
{
/*
mtherr("igam", UNDERFLOW);
*/
return (0.0);
}
ax = exp(ax);
/* power series */
r = a;
c = 1.0;
ans = 1.0;
do
{
r += 1.0;
c *= x / r;
ans += c;
}
while (c / ans > MACHEP);
return (ans * ax / a);
}
double igamci(double a, double q)
{
int i;
double x, fac, f_fp, fpp_fp;
if (npy_isnan(a) || npy_isnan(q)) {
return NPY_NAN;
}
else if ((a < 0.0) || (q < 0.0) || (q > 1.0)) {
mtherr("gammainccinv", DOMAIN);
}
else if (q == 0.0) {
return NPY_INFINITY;
}
else if (q == 1.0) {
return 0.0;
}
else if (q > 0.9) {
return igami(a, 1 - q);
}
x = find_inverse_gamma(a, 1 - q, q);
for (i = 0; i < 3; i++) {
fac = igam_fac(a, x);
if (fac == 0.0) {
return x;
}
f_fp = (igamc(a, x) - q) * x / (-fac);
fpp_fp = -1.0 + (a - 1) / x;
if (npy_isinf(fpp_fp)) {
x = x - f_fp;
}
else {
x = x - f_fp / (1.0 - 0.5 * f_fp * fpp_fp);
}
}
return x;
}
double igami( double a, double y0 )
{
double x0, x1, x, yl, yh, y, d, lgm, dithresh;
int i, dir;
/* bound the solution */
x0 = MAXNUM;
yl = 0;
x1 = 0;
yh = 1.0;
dithresh = 5.0 * MACHEP;
/* approximation to inverse function */
d = 1.0/(9.0*a);
y = ( 1.0 - d - ndtri(y0) * sqrt(d) );
x = a * y * y * y;
lgm = lgam(a);
for( i=0; i<10; i++ )
{
if( x > x0 || x < x1 )
goto ihalve;
y = igamc(a,x);
if( y < yl || y > yh )
goto ihalve;
if( y < y0 )
{
x0 = x;
yl = y;
}
else
{
x1 = x;
yh = y;
}
/* compute the derivative of the function at this point */
d = (a - 1.0) * log(x) - x - lgm;
if( d < -MAXLOG )
goto ihalve;
d = -exp(d);
/* compute the step to the next approximation of x */
d = (y - y0)/d;
if( fabs(d/x) < MACHEP )
goto done;
x = x - d;
}
/* Resort to interval halving if Newton iteration did not converge. */
ihalve:
d = 0.0625;
if( x0 == MAXNUM )
{
if( x <= 0.0 )
x = 1.0;
while( x0 == MAXNUM )
{
x = (1.0 + d) * x;
y = igamc( a, x );
if( y < y0 )
{
x0 = x;
yl = y;
break;
}
d = d + d;
}
}
d = 0.5;
dir = 0;
for( i=0; i<400; i++ )
{
x = x1 + d * (x0 - x1);
y = igamc( a, x );
lgm = (x0 - x1)/(x1 + x0);
if( fabs(lgm) < dithresh )
break;
lgm = (y - y0)/y0;
if( fabs(lgm) < dithresh )
break;
if( x <= 0.0 )
break;
if( 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 += 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 -= 1;
}
}
if( x == 0.0 )
mtherr( "igami", UNDERFLOW );
done:
return( x );
}
inline double gamma_q(double x, double y)
{ return igamc(x, y); }
static DBL igami(DBL a, DBL y0)
{
DBL d, y, x0, lgm;
int i;
int sgngam = 0;
/* approximation to inverse function */
d = 1.0 / (9.0 * a);
y = (1.0 - d - ndtri(y0) * sqrt(d));
x0 = a * y * y * y;
lgm = lgam(a, &sgngam);
for (i = 0; i < 10; i++)
{
if (x0 <= 0.0)
{
/*
mtherr("igami", UNDERFLOW);
*/
return (0.0);
}
y = igamc(a, x0);
/* compute the derivative of the function at this point */
d = (a - 1.0) * log(x0) - x0 - lgm;
if (d < -MAXLOG)
{
/*
mtherr("igami", UNDERFLOW);
*/
goto done;
}
d = -exp(d);
/* compute the step to the next approximation of x */
if (d == 0.0)
{
goto done;
}
d = (y - y0) / d;
x0 = x0 - d;
if (i < 3)
{
continue;
}
if (fabs(d / x0) < 2.0 * MACHEP)
{
goto done;
}
}
done:
return (x0);
}
