double bpser(double *a,double *b,double *x,double *eps)
/*
-----------------------------------------------------------------------
POWER SERIES EXPANSION FOR EVALUATING IX(A,B) WHEN B .LE. 1
OR B*X .LE. 0.7. EPS IS THE TOLERANCE USED.
-----------------------------------------------------------------------
*/
{
static double bpser,a0,apb,b0,c,n,sum,t,tol,u,w,z;
static int i,m;
/*
..
.. Executable Statements ..
*/
bpser = 0.0e0;
if(*x == 0.0e0) return bpser;
/*
-----------------------------------------------------------------------
COMPUTE THE FACTOR X**A/(A*BETA(A,B))
-----------------------------------------------------------------------
*/
a0 = fifdmin1(*a,*b);
if(a0 < 1.0e0) goto S10;
z = *a*log(*x)-betaln(a,b);
bpser = exp(z)/ *a;
goto S100;
S10:
b0 = fifdmax1(*a,*b);
if(b0 >= 8.0e0) goto S90;
if(b0 > 1.0e0) goto S40;
/*
PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1
*/
bpser = pow(*x,*a);
if(bpser == 0.0e0) return bpser;
apb = *a+*b;
if(apb > 1.0e0) goto S20;
z = 1.0e0+gam1(&apb);
goto S30;
S20:
u = *a+*b-1.e0;
z = (1.0e0+gam1(&u))/apb;
S30:
c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
bpser *= (c*(*b/apb));
goto S100;
S40:
/*
PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8
*/
u = gamln1(&a0);
m = (long)(b0 - 1.0e0);
if(m < 1) goto S60;
c = 1.0e0;
for(i=1; i<=m; i++) {
b0 -= 1.0e0;
c *= (b0/(a0+b0));
}
u = log(c)+u;
S60:
z = *a*log(*x)-u;
b0 -= 1.0e0;
apb = a0+b0;
if(apb > 1.0e0) goto S70;
t = 1.0e0+gam1(&apb);
goto S80;
S70:
u = a0+b0-1.e0;
t = (1.0e0+gam1(&u))/apb;
S80:
bpser = exp(z)*(a0/ *a)*(1.0e0+gam1(&b0))/t;
goto S100;
S90:
/*
PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8
*/
u = gamln1(&a0)+algdiv(&a0,&b0);
z = *a*log(*x)-u;
bpser = a0/ *a*exp(z);
S100:
if(bpser == 0.0e0 || *a <= 0.1e0**eps) return bpser;
/*
-----------------------------------------------------------------------
COMPUTE THE SERIES
-----------------------------------------------------------------------
*/
sum = n = 0.0e0;
c = 1.0e0;
tol = *eps/ *a;
S110:
n += 1.0e0;
c *= ((0.5e0+(0.5e0-*b/n))**x);
w = c/(*a+n);
sum += w;
if(fabs(w) > tol) goto S110;
bpser *= (1.0e0+*a*sum);
return bpser;
}
/******************************
Computes the inverse of the beta CDF: given a prob. value, calculates the x for which
the integral over 0 to x of beta CDF = prob.
Adapted from:
1. Majumder and Bhattacharjee (1973) App. Stat. 22(3) 411-414
and the corrections:
2. Cran et al. (1977) App. Stat. 26(1) 111-114
3. Berry et al. (1990) App. Stat. 39(2) 309-310
and another adaptation made in the code of Yang (tools.c)
****************************/
MDOUBLE inverseCDFBeta(MDOUBLE a, MDOUBLE b, MDOUBLE prob){
if(a<0 || b<0 || prob<0 || prob>1) {
errorMsg::reportError("error in inverseCDFBeta,illegal parameter");
}
if (prob == 0 || prob == 1)
return prob;
int maxIter=100;
MDOUBLE epsilonLow=1e-300;
MDOUBLE fpu=3e-308;
/****** changing the tail direction (prob=1-prob)*/
bool tail=false;
MDOUBLE probA=prob;
if (prob > 0.5) {
prob = 1.0 - prob;
tail = true;
MDOUBLE tmp=a;
a=b;
b=tmp;
}
MDOUBLE lnBetaVal=betaln(a,b);
MDOUBLE x;
/****** calculating chi square evaluator */
MDOUBLE r = sqrt(-log(prob * prob));
MDOUBLE y = r - (2.30753+0.27061*r)/(1.+ (0.99229+0.04481*r) * r);
MDOUBLE chiSquare = 1.0/(9.0 * b);
chiSquare = b*2 * pow(1.0 - chiSquare + y * sqrt(chiSquare), 3.0);
// MDOUBLE chiSquare2=gammq(b,prob/2.0); //chi square valued of prob with 2q df
MDOUBLE T=(4.0*a+2.0*b-2)/chiSquare;
/****** initializing x0 */
if (a > 1.0 && b > 1.0) {
r = (y * y - 3.) / 6.;
MDOUBLE s = 1. / (a*2. - 1.);
MDOUBLE t = 1. / (b*2. - 1.);
MDOUBLE h = 2. / (s + t);
MDOUBLE w = y * sqrt(h + r) / h - (t - s) * (r + 5./6. - 2./(3.*h));
x = a / (a + b * exp(w + w));
}
else {
if (chiSquare<0){
x=exp((log(b*(1-prob))+lnBetaVal)/b);
}
else if (T<1){
x=exp((log(prob*a)+lnBetaVal)/a);
}
else {
x=(T-1.0)/(T+1.0);
}
}
if(x<=fpu || x>=1-2.22e-16) x=(prob+0.5)/2; // 0<x<1 but to avoid underflow a little smaller
/****** iterating with a modified version of newton-raphson */
MDOUBLE adj, newX=x, prev=0;
MDOUBLE yprev = 0.;
adj = 1.;
MDOUBLE eps = pow(10., -13. - 2.5/(probA * probA) - 0.5/(probA *probA));
eps = (eps>epsilonLow?eps:epsilonLow);
for (int i=0; i<maxIter; i++) {
y = incompleteBeta(a,b,x);
y = (y - prob) *
exp(lnBetaVal + (1.0-a) * log(x) + (1.0-b) * log(1.0 - x)); //the classical newton-raphson formula
if (y * yprev <= 0)
prev = (fabs(adj)>fpu?fabs(adj):fpu);
MDOUBLE g = 1;
for (int j=0; j<maxIter; j++) {
adj = g * y;
if (fabs(adj) < prev) {
newX = x - adj; // new x
if (newX >= 0. && newX <= 1.) {
if (prev <= eps || fabs(y) <= eps) return(tail?1.0-x:x);;
if (newX != 0. && newX != 1.0) break;
}
}
g /= 3.;
}
if (fabs(newX-x)<fpu)
return (tail?1.0-x:x);;
x = newX;
yprev = y;
}
return (tail?1.0-x:x);
}
