void test01 ( )
/******************************************************************************/
/*
Purpose:
TEST01 demonstrates the use of ALNGAM.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 November 2010
Author:
John Burkardt
*/
{
double fx;
double fx2;
int ifault;
int n_data;
double x;
printf ( "\n" );
printf ( "TEST01:\n" );
printf ( " ALNGAM computes the logarithm of the \n" );
printf ( " Gamma function. We compare the result\n" );
printf ( " to tabulated values.\n" );
printf ( "\n" );
printf ( " X " );
printf ( "FX FX2\n" );
printf ( " " );
printf ( "(Tabulated) (ALNGAM) DIFF\n" );
printf ( "\n" );
n_data = 0;
for ( ; ; )
{
gamma_log_values ( &n_data, &x, &fx );
if ( n_data == 0 )
{
break;
}
fx2 = alngam ( x, &ifault );
printf ( " %24.16f %24.16f %24.16f %10.4e\n",
x, fx, fx2, fabs ( fx - fx2 ) );
}
return;
}
double gammad ( double x, double p, int *ifault )
/******************************************************************************/
/*
Purpose:
GAMMAD computes the Incomplete Gamma Integral
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
03 November 2010
Author:
Original FORTRAN77 version by B Shea.
C version by John Burkardt.
Reference:
B Shea,
Algorithm AS 239:
Chi-squared and Incomplete Gamma Integral,
Applied Statistics,
Volume 37, Number 3, 1988, pages 466-473.
Parameters:
Input, double X, P, the parameters of the incomplete
gamma ratio. 0 <= X, and 0 < P.
Output, int IFAULT, error flag.
0, no error.
1, X < 0 or P <= 0.
Output, double GAMMAD, the value of the incomplete
Gamma integral.
*/
{
double a;
double an;
double arg;
double b;
double c;
double elimit = - 88.0;
double oflo = 1.0E+37;
double plimit = 1000.0;
double pn1;
double pn2;
double pn3;
double pn4;
double pn5;
double pn6;
double rn;
double tol = 1.0E-14;
int upper;
double value;
double xbig = 1.0E+08;
value = 0.0;
/*
Check the input.
*/
if ( x < 0.0 )
{
*ifault = 1;
return value;
}
if ( p <= 0.0 )
{
*ifault = 1;
return value;
}
*ifault = 0;
if ( x == 0.0 )
{
value = 0.0;
return value;
}
/*
If P is large, use a normal approximation.
*/
if ( plimit < p )
{
pn1 = 3.0 * sqrt ( p ) * ( pow ( x / p, 1.0 / 3.0 )
+ 1.0 / ( 9.0 * p ) - 1.0 );
upper = 0;
value = alnorm ( pn1, upper );
return value;
}
/*
If X is large set value = 1.
*/
if ( xbig < x )
{
value = 1.0;
return value;
}
/*
Use Pearson's series expansion.
(Note that P is not large enough to force overflow in ALOGAM).
No need to test IFAULT on exit since P > 0.
*/
if ( x <= 1.0 || x < p )
{
arg = p * log ( x ) - x - alngam ( p + 1.0, ifault );
c = 1.0;
value = 1.0;
a = p;
for ( ; ; )
{
a = a + 1.0;
c = c * x / a;
value = value + c;
if ( c <= tol )
{
break;
}
}
arg = arg + log ( value );
if ( elimit <= arg )
{
value = exp ( arg );
}
else
{
value = 0.0;
}
}
/*
Use a continued fraction expansion.
*/
else
{
arg = p * log ( x ) - x - alngam ( p, ifault );
a = 1.0 - p;
b = a + x + 1.0;
c = 0.0;
pn1 = 1.0;
pn2 = x;
pn3 = x + 1.0;
pn4 = x * b;
value = pn3 / pn4;
for ( ; ; )
{
a = a + 1.0;
b = b + 2.0;
c = c + 1.0;
an = a * c;
pn5 = b * pn3 - an * pn1;
pn6 = b * pn4 - an * pn2;
if ( pn6 != 0.0 )
{
rn = pn5 / pn6;
if ( r8_abs ( value - rn ) <= r8_min ( tol, tol * rn ) )
{
break;
}
value = rn;
}
pn1 = pn3;
pn2 = pn4;
pn3 = pn5;
pn4 = pn6;
/*
Re-scale terms in continued fraction if terms are large.
*/
if ( oflo <= abs ( pn5 ) )
{
pn1 = pn1 / oflo;
pn2 = pn2 / oflo;
pn3 = pn3 / oflo;
pn4 = pn4 / oflo;
}
}
arg = arg + log ( value );
if ( elimit <= arg )
{
value = 1.0 - exp ( arg );
}
else
{
value = 1.0;
}
}
return value;
}
void test01 ( void )
/******************************************************************************/
/*
Purpose:
TEST01 demonstrates the use of XINBTA.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
05 November 2010
Author:
John Burkardt
*/
{
double a;
double b;
double beta_log;
double fx;
int ifault;
int n_data;
double x;
double x2;
printf ( "\n" );
printf ( "TEST01:\n" );
printf ( " XINBTA inverts the incomplete Beta function.\n" );
printf ( " Given CDF, it computes an X.\n" );
printf ( "\n" );
printf ( " A B CDF " );
printf ( " X X\n" );
printf ( " " );
printf ( " (Tabulated) (XINBTA) DIFF\n" );
printf ( "\n" );
n_data = 0;
for ( ; ; )
{
beta_inc_values ( &n_data, &a, &b, &x, &fx );
if ( n_data == 0 )
{
break;
}
beta_log = alngam ( a, &ifault )
+ alngam ( b, &ifault )
- alngam ( a + b, &ifault );
x2 = xinbta ( a, b, beta_log, fx, &ifault );
printf ( " %10.4f %10.4f %10.4f %24.16g %24.16g %10.4e\n",
a, b, fx, x, x2, r8_abs ( x - x2 ) );
}
return;
}
double prncst ( double st, int idf, double d, int *ifault )
/******************************************************************************/
/*
Purpose:
PRNCST computes the lower tail of noncentral T distribution.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
23 October 2010
Author:
Original FORTRAN77 version by BE Cooper.
C version by John Burkardt.
Reference:
BE Cooper,
Algorithm AS 5:
The Integral of the Non-Central T-Distribution,
Applied Statistics,
Volume 17, Number 2, 1968, page 193.
Parameters:
Input, double ST, the argument.
Input, int IDF, the number of degrees of freedom.
Input, double D, the noncentrality parameter.
Output, int *IFAULT, error flag.
0, no error occurred.
nonzero, an error occurred.
Output, double PRNCST, the value of the lower tail of
the noncentral T distribution.
Local Parameters:
Local, double G1, 1.0 / sqrt(2.0 * pi)
Local, double G2, 1.0 / (2.0 * pi)
Local, double G3, sqrt(2.0 * pi)
*/
{
double a;
double ak;
double b;
double da;
double drb;
double emin = 12.5;
double f;
double fk;
double fkm1;
double fmkm1;
double fmkm2;
double g1 = 0.3989422804;
double g2 = 0.1591549431;
double g3 = 2.5066282746;
int ioe;
int k;
double rb;
double sum;
double value;
f = ( double ) ( idf );
/*
For very large IDF, use the normal approximation.
*/
if ( 100 < idf )
{
*ifault = 1;
a = sqrt ( 0.5 * f )
* exp ( alngam ( 0.5 * ( f - 1.0 ), &k )
- alngam ( 0.5 * f, &k ) ) * d;
value = alnorm ( ( st - a ) / sqrt ( f * ( 1.0 + d * d )
/ ( f - 2.0 ) - a * a ), 0 );
return value;
}
*ifault = 0;
ioe = ( idf % 2 );
a = st / sqrt ( f );
b = f / ( f + st * st );
rb = sqrt ( b );
da = d * a;
drb = d * rb;
if ( idf == 1 )
{
value = alnorm ( drb, 1 ) + 2.0 * tfn ( drb, a );
return value;
}
sum = 0.0;
if ( r8_abs ( drb ) < emin )
{
fmkm2 = a * rb * exp ( - 0.5 * drb * drb )
* alnorm ( a * drb, 0 ) * g1;
}
else
{
fmkm2 = 0.0;
}
fmkm1 = b * da * fmkm2;
if ( r8_abs ( d ) < emin )
{
fmkm1 = fmkm1 + b * a * g2 * exp ( - 0.5 * d * d );
}
if ( ioe == 0 )
{
sum = fmkm2;
}
else
{
sum = fmkm1;
}
ak = 1.0;
fk = 2.0;
for ( k = 2; k <= idf - 2; k = k + 2 )
{
fkm1 = fk - 1.0;
fmkm2 = b * ( da * ak * fmkm1 + fmkm2 ) * fkm1 / fk;
ak = 1.0 / ( ak * fkm1 );
fmkm1 = b * ( da * ak * fmkm2 + fmkm1 ) * fk / ( fk + 1.0 );
if ( ioe == 0 )
{
sum = sum + fmkm2;
}
else
{
sum = sum + fmkm1;
}
ak = 1.0 / ( ak * fk );
fk = fk + 2.0;
}
if ( ioe == 0 )
{
value = alnorm ( d, 1 ) + sum * g3;
}
else
{
value = alnorm ( drb, 1 ) + 2.0 * ( sum + tfn ( drb, a ) );
}
return value;
}
double gamain ( double x, double p, int *ifault )
/******************************************************************************/
/*
Purpose:
GAMAIN computes the incomplete gamma ratio.
Discussion:
A series expansion is used if P > X or X <= 1. Otherwise, a
continued fraction approximation is used.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
17 January 2008
Author:
Original FORTRAN77 version by G Bhattacharjee.
C version by John Burkardt.
Reference:
G Bhattacharjee,
Algorithm AS 32:
The Incomplete Gamma Integral,
Applied Statistics,
Volume 19, Number 3, 1970, pages 285-287.
Parameters:
Input, double X, P, the parameters of the incomplete
gamma ratio. 0 <= X, and 0 < P.
Output, int *IFAULT, error flag.
0, no errors.
1, P <= 0.
2, X < 0.
3, underflow.
4, error return from the Log Gamma routine.
Output, double GAMAIN, the value of the incomplete gamma ratio.
*/
{
double a;
double acu = 1.0E-08;
double an;
double arg;
double b;
double dif;
double factor;
double g;
double gin;
int i;
double oflo = 1.0E+37;
double pn[6];
double rn;
double term;
double uflo = 1.0E-37;
double value;
/*
Check the input.
*/
if ( p <= 0.0 )
{
*ifault = 1;
value = 0.0;
return value;
}
if ( x < 0.0 )
{
*ifault = 2;
value = 0.0;
return value;
}
if ( x == 0.0 )
{
*ifault = 0;
value = 0.0;
return value;
}
g = alngam ( p, ifault );
if ( *ifault != 0 )
{
*ifault = 4;
value = 0.0;
return value;
}
arg = p * log ( x ) - x - g;
if ( arg < log ( uflo ) )
{
*ifault = 3;
value = 0.0;
return value;
}
*ifault = 0;
factor = exp ( arg );
/*
Calculation by series expansion.
*/
if ( x <= 1.0 || x < p )
{
gin = 1.0;
term = 1.0;
rn = p;
for ( ; ; )
{
rn = rn + 1.0;
term = term * x / rn;
gin = gin + term;
if ( term <= acu )
{
break;
}
}
value = gin * factor / p;
return value;
}
/*
Calculation by continued fraction.
*/
a = 1.0 - p;
b = a + x + 1.0;
term = 0.0;
pn[0] = 1.0;
pn[1] = x;
pn[2] = x + 1.0;
pn[3] = x * b;
gin = pn[2] / pn[3];
for ( ; ; )
{
a = a + 1.0;
b = b + 2.0;
term = term + 1.0;
an = a * term;
for ( i = 0; i <= 1; i++ )
{
pn[i+4] = b * pn[i+2] - an * pn[i];
}
if ( pn[5] != 0.0 )
{
rn = pn[4] / pn[5];
dif = r8_abs ( gin - rn );
/*
Absolute error tolerance satisfied?
*/
if ( dif <= acu )
{
/*
Relative error tolerance satisfied?
*/
if ( dif <= acu * rn )
{
value = 1.0 - factor * gin;
break;
}
}
gin = rn;
}
for ( i = 0; i < 4; i++ )
{
pn[i] = pn[i+2];
}
if ( oflo <= r8_abs ( pn[4] ) )
{
for ( i = 0; i < 4; i++ )
{
pn[i] = pn[i] / oflo;
}
}
}
return value;
}
void cumfnc(double *f,double *dfn,double *dfd,double *pnonc,
double *cum,double *ccum)
/*
**********************************************************************
F -NON- -C-ENTRAL F DISTRIBUTION
Function
COMPUTES NONCENTRAL F DISTRIBUTION WITH DFN AND DFD
DEGREES OF FREEDOM AND NONCENTRALITY PARAMETER PNONC
Arguments
X --> UPPER LIMIT OF INTEGRATION OF NONCENTRAL F IN EQUATION
DFN --> DEGREES OF FREEDOM OF NUMERATOR
DFD --> DEGREES OF FREEDOM OF DENOMINATOR
PNONC --> NONCENTRALITY PARAMETER.
CUM <-- CUMULATIVE NONCENTRAL F DISTRIBUTION
CCUM <-- COMPLIMENT OF CUMMULATIVE
Method
USES FORMULA 26.6.20 OF REFERENCE FOR INFINITE SERIES.
SERIES IS CALCULATED BACKWARD AND FORWARD FROM J = LAMBDA/2
(THIS IS THE TERM WITH THE LARGEST POISSON WEIGHT) UNTIL
THE CONVERGENCE CRITERION IS MET.
FOR SPEED, THE INCOMPLETE BETA FUNCTIONS ARE EVALUATED
BY FORMULA 26.5.16.
REFERENCE
HANDBOOD OF MATHEMATICAL FUNCTIONS
EDITED BY MILTON ABRAMOWITZ AND IRENE A. STEGUN
NATIONAL BUREAU OF STANDARDS APPLIED MATEMATICS SERIES - 55
MARCH 1965
P 947, EQUATIONS 26.6.17, 26.6.18
Note
THE SUM CONTINUES UNTIL A SUCCEEDING TERM IS LESS THAN EPS
TIMES THE SUM (OR THE SUM IS LESS THAN 1.0E-20). EPS IS
SET TO 1.0E-4 IN A DATA STATEMENT WHICH CAN BE CHANGED.
**********************************************************************
*/
{
#define qsmall(x) (int)(sum < 1.0e-20 || (x) < eps*sum)
#define half 0.5e0
#define done 1.0e0
static double eps = 1.0e-4;
static double dsum,dummy,prod,xx,yy,adn,aup,b,betdn,betup,centwt,dnterm,sum,
upterm,xmult,xnonc;
static int i,icent,ierr;
static double T1,T2,T3,T4,T5,T6;
/*
..
.. Executable Statements ..
*/
if(!(*f <= 0.0e0)) goto S10;
*cum = 0.0e0;
*ccum = 1.0e0;
return;
S10:
if(!(*pnonc < 1.0e-10)) goto S20;
/*
Handle case in which the non-centrality parameter is
(essentially) zero.
*/
cumf(f,dfn,dfd,cum,ccum);
return;
S20:
xnonc = *pnonc/2.0e0;
/*
Calculate the central term of the poisson weighting factor.
*/
icent = (long)(xnonc);
if(icent == 0) icent = 1;
/*
Compute central weight term
*/
T1 = (double)(icent+1);
centwt = exp(-xnonc+(double)icent*log(xnonc)-alngam(&T1));
/*
Compute central incomplete beta term
Assure that minimum of arg to beta and 1 - arg is computed
accurately.
*/
prod = *dfn**f;
dsum = *dfd+prod;
yy = *dfd/dsum;
if(yy > half) {
xx = prod/dsum;
yy = done-xx;
}
else xx = done-yy;
T2 = *dfn*half+(double)icent;
T3 = *dfd*half;
bratio(&T2,&T3,&xx,&yy,&betdn,&dummy,&ierr);
adn = *dfn/2.0e0+(double)icent;
aup = adn;
b = *dfd/2.0e0;
betup = betdn;
sum = centwt*betdn;
/*
Now sum terms backward from icent until convergence or all done
*/
xmult = centwt;
i = icent;
T4 = adn+b;
T5 = adn+1.0e0;
dnterm = exp(alngam(&T4)-alngam(&T5)-alngam(&b)+adn*log(xx)+b*log(yy));
S30:
if(qsmall(xmult*betdn) || i <= 0) goto S40;
xmult *= ((double)i/xnonc);
i -= 1;
adn -= 1.0;
dnterm = (adn+1.0)/((adn+b)*xx)*dnterm;
betdn += dnterm;
sum += (xmult*betdn);
goto S30;
S40:
i = icent+1;
/*
Now sum forwards until convergence
*/
xmult = centwt;
if(aup-1.0+b == 0) upterm = exp(-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+
b*log(yy));
else {
T6 = aup-1.0+b;
upterm = exp(alngam(&T6)-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+b*
log(yy));
}
goto S60;
S50:
if(qsmall(xmult*betup)) goto S70;
S60:
xmult *= (xnonc/(double)i);
i += 1;
aup += 1.0;
upterm = (aup+b-2.0e0)*xx/(aup-1.0)*upterm;
betup -= upterm;
sum += (xmult*betup);
goto S50;
S70:
*cum = sum;
*ccum = 0.5e0+(0.5e0-*cum);
return;
#undef qsmall
#undef half
#undef done
}
double gammds ( double x, double p, int *ifault )
/******************************************************************************/
/*
Purpose:
GAMMDS computes the incomplete Gamma integral.
Discussion:
The parameters must be positive. An infinite series is used.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 November 2010
Author:
Original FORTRAN77 version by Chi Leung Lau.
C version by John Burkardt.
Reference:
Chi Leung Lau,
Algorithm AS 147:
A Simple Series for the Incomplete Gamma Integral,
Applied Statistics,
Volume 29, Number 1, 1980, pages 113-114.
Parameters:
Input, double X, P, the arguments of the incomplete
Gamma integral. X and P must be greater than 0.
Output, int *IFAULT, error flag.
0, no errors.
1, X <= 0 or P <= 0.
2, underflow during the computation.
Output, double GAMMDS, the value of the incomplete
Gamma integral.
*/
{
double a;
double arg;
double c;
double e = 1.0E-09;
double f;
int ifault2;
double uflo = 1.0E-37;
double value;
/*
Check the input.
*/
if ( x <= 0.0 )
{
*ifault = 1;
value = 0.0;
return value;
}
if ( p <= 0.0 )
{
*ifault = 1;
value = 0.0;
return value;
}
/*
ALNGAM is the natural logarithm of the gamma function.
*/
arg = p * log ( x ) - alngam ( p + 1.0, &ifault2 ) - x;
if ( arg < log ( uflo ) )
{
value = 0.0;
*ifault = 2;
return value;
}
f = exp ( arg );
if ( f == 0.0 )
{
value = 0.0;
*ifault = 2;
return value;
}
*ifault = 0;
/*
Series begins.
*/
c = 1.0;
value = 1.0;
a = p;
for ( ; ; )
{
a = a + 1.0;
c = c * x / a;
value = value + c;
if ( c <= e * value )
{
break;
}
}
value = value * f;
return value;
}
