/************************************************************************* 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; }