/*************************************************************************
Complemented Chi-square distribution
Returns the area under the right hand tail (from x to
infinity) of the Chi square probability density function
with v degrees of freedom:
inf.
-
1 | | v/2-1 -t/2
P( x | v ) = ----------- | t e dt
v/2 - | |
2 | (v/2) -
x
where x is the Chi-square variable.
The incomplete gamma integral is used, according to the
formula
y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ).
The arguments must both be positive.
ACCURACY:
See incomplete gamma function
Cephes Math Library Release 2.8: June, 2000
Copyright 1984, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
double chisquarecdistribution(double v, double x)
{
double result;
ap::ap_error::make_assertion(ap::fp_greater_eq(x,0)&&ap::fp_greater_eq(v,1), "Domain error in ChiSquareDistributionC");
result = incompletegammac(v/2.0, x/2.0);
return result;
}
/*************************************************************************
Incomplete gamma integral
The function is defined by
x
-
1 | | -t a-1
igam(a,x) = ----- | e t dt.
- | |
| (a) -
0
In this implementation both arguments must be positive.
The integral is evaluated by either a power series or
continued fraction expansion, depending on the relative
values of a and x.
ACCURACY:
Relative error:
arithmetic domain # trials peak rms
IEEE 0,30 200000 3.6e-14 2.9e-15
IEEE 0,100 300000 9.9e-14 1.5e-14
Cephes Math Library Release 2.8: June, 2000
Copyright 1985, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
double incompletegamma(double a, double x)
{
double result;
double igammaepsilon;
double ans;
double ax;
double c;
double r;
double tmp;
igammaepsilon = 0.000000000000001;
if( ap::fp_less_eq(x,0)||ap::fp_less_eq(a,0) )
{
result = 0;
return result;
}
if( ap::fp_greater(x,1)&&ap::fp_greater(x,a) )
{
result = 1-incompletegammac(a, x);
return result;
}
ax = a*log(x)-x-lngamma(a, tmp);
if( ap::fp_less(ax,-709.78271289338399) )
{
result = 0;
return result;
}
ax = exp(ax);
r = a;
c = 1;
ans = 1;
do
{
r = r+1;
c = c*x/r;
ans = ans+c;
}
while(ap::fp_greater(c/ans,igammaepsilon));
result = ans*ax/a;
return result;
}
void lrlines(const ap::real_2d_array& xy,
const ap::real_1d_array& s,
int n,
int& info,
double& a,
double& b,
double& vara,
double& varb,
double& covab,
double& corrab,
double& p)
{
int i;
double ss;
double sx;
double sxx;
double sy;
double stt;
double e1;
double e2;
double t;
double chi2;
if( n<2 )
{
info = -1;
return;
}
for(i = 0; i <= n-1; i++)
{
if( ap::fp_less_eq(s(i),0) )
{
info = -2;
return;
}
}
info = 1;
//
// Calculate S, SX, SY, SXX
//
ss = 0;
sx = 0;
sy = 0;
sxx = 0;
for(i = 0; i <= n-1; i++)
{
t = ap::sqr(s(i));
ss = ss+1/t;
sx = sx+xy(i,0)/t;
sy = sy+xy(i,1)/t;
sxx = sxx+ap::sqr(xy(i,0))/t;
}
//
// Test for condition number
//
t = sqrt(4*ap::sqr(sx)+ap::sqr(ss-sxx));
e1 = 0.5*(ss+sxx+t);
e2 = 0.5*(ss+sxx-t);
if( ap::fp_less_eq(ap::minreal(e1, e2),1000*ap::machineepsilon*ap::maxreal(e1, e2)) )
{
info = -3;
return;
}
//
// Calculate A, B
//
a = 0;
b = 0;
stt = 0;
for(i = 0; i <= n-1; i++)
{
t = (xy(i,0)-sx/ss)/s(i);
b = b+t*xy(i,1)/s(i);
stt = stt+ap::sqr(t);
}
b = b/stt;
a = (sy-sx*b)/ss;
//
// Calculate goodness-of-fit
//
if( n>2 )
{
chi2 = 0;
for(i = 0; i <= n-1; i++)
{
chi2 = chi2+ap::sqr((xy(i,1)-a-b*xy(i,0))/s(i));
}
p = incompletegammac(double(n-2)/double(2), chi2/2);
}
else
{
p = 1;
}
//
// Calculate other parameters
//
vara = (1+ap::sqr(sx)/(ss*stt))/ss;
varb = 1/stt;
covab = -sx/(ss*stt);
corrab = covab/sqrt(vara*varb);
}
/*************************************************************************
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;
}
