struct Gauleg18 { static const Int ngau = 18; static const Doub y[18]; static const Doub w[18]; }; const Doub Gauleg18::y[18] = {0.0021695375159141994, 0.011413521097787704,0.027972308950302116,0.051727015600492421, 0.082502225484340941, 0.12007019910960293,0.16415283300752470, 0.21442376986779355, 0.27051082840644336, 0.33199876341447887, 0.39843234186401943, 0.46931971407375483, 0.54413605556657973, 0.62232745288031077, 0.70331500465597174, 0.78649910768313447, 0.87126389619061517, 0.95698180152629142}; const Doub Gauleg18::w[18] = {0.0055657196642445571, 0.012915947284065419,0.020181515297735382,0.027298621498568734, 0.034213810770299537,0.040875750923643261,0.047235083490265582, 0.053244713977759692,0.058860144245324798,0.064039797355015485, 0.068745323835736408,0.072941885005653087,0.076598410645870640, 0.079687828912071670,0.082187266704339706,0.084078218979661945, 0.085346685739338721,0.085983275670394821}; struct Gamma : Gauleg18 { static const Int ASWITCH=100; static const Doub EPS; static const Doub FPMIN; Doub gln; Doub gammp(const Doub a, const Doub x) { if (x < 0.0 || a <= 0.0) throw("bad args in gammp"); if (x == 0.0) return 0.0; else if ((Int)a >= ASWITCH) return gammpapprox(a,x,1); else if (x < a+1.0) return gser(a,x); else return 1.0-gcf(a,x); } Doub gammq(const Doub a, const Doub x) { if (x < 0.0 || a <= 0.0) throw("bad args in gammq"); if (x == 0.0) return 1.0; else if ((Int)a >= ASWITCH) return gammpapprox(a,x,0); else if (x < a+1.0) return 1.0-gser(a,x); else return gcf(a,x); } Doub gser(const Doub a, const Doub x) { Doub sum,del,ap; gln=gammln(a); ap=a; del=sum=1.0/a; for (;;) { ++ap; del *= x/ap; sum += del; if (fabs(del) < fabs(sum)*EPS) { return sum*exp(-x+a*log(x)-gln); } } } Doub gcf(const Doub a, const Doub x) { Int i; Doub an,b,c,d,del,h; gln=gammln(a); b=x+1.0-a; c=1.0/FPMIN; d=1.0/b; h=d; for (i=1;;i++) { an = -i*(i-a); b += 2.0; d=an*d+b; if (fabs(d) < FPMIN) d=FPMIN; c=b+an/c; if (fabs(c) < FPMIN) c=FPMIN; d=1.0/d; del=d*c; h *= del; if (fabs(del-1.0) <= EPS) break; } return exp(-x+a*log(x)-gln)*h; } Doub gammpapprox(Doub a, Doub x, Int psig) { Int j; Doub xu,t,sum,ans; Doub a1 = a-1.0, lna1 = log(a1), sqrta1 = sqrt(a1); gln = gammln(a); if (x > a1) xu = MAX(a1 + 11.5*sqrta1, x + 6.0*sqrta1); else xu = MAX(0.,MIN(a1 - 7.5*sqrta1, x - 5.0*sqrta1)); sum = 0; for (j=0;ja1? 1.0-ans:-ans):(x>a1? ans:1.0+ans)); } Doub invgammp(Doub p, Doub a); }; const Doub Gamma::EPS = numeric_limits::epsilon(); const Doub Gamma::FPMIN = numeric_limits::min()/EPS; Doub Gamma::invgammp(Doub p, Doub a) { Int j; Doub x,err,t,u,pp,lna1,afac,a1=a-1; const Doub EPS=1.e-8; gln=gammln(a); if (a <= 0.) throw("a must be pos in invgammap"); if (p >= 1.) return MAX(100.,a + 100.*sqrt(a)); if (p <= 0.) return 0.0; if (a > 1.) { lna1=log(a1); afac = exp(a1*(lna1-1.)-gln); pp = (p < 0.5)? p : 1. - p; t = sqrt(-2.*log(pp)); x = (2.30753+t*0.27061)/(1.+t*(0.99229+t*0.04481)) - t; if (p < 0.5) x = -x; x = MAX(1.e-3,a*pow(1.-1./(9.*a)-x/(3.*sqrt(a)),3)); } else { t = 1.0 - a*(0.253+a*0.12); if (p < t) x = pow(p/t,1./a); else x = 1.-log(1.-(p-t)/(1.-t)); } for (j=0;j<12;j++) { if (x <= 0.0) return 0.0; err = gammp(a,x) - p; if (a > 1.) t = afac*exp(-(x-a1)+a1*(log(x)-lna1)); else t = exp(-x+a1*log(x)-gln); u = err/t; x -= (t = u/(1.-0.5*MIN(1.,u*((a-1.)/x - 1)))); if (x <= 0.) x = 0.5*(x + t); if (fabs(t) < EPS*x ) break; } return x; } struct Beta : Gauleg18 { static const Int SWITCH=3000; static const Doub EPS, FPMIN; Doub betai(const Doub a, const Doub b, const Doub x) { Doub bt; if (a <= 0.0 || b <= 0.0) throw("Bad a or b in routine betai"); if (x < 0.0 || x > 1.0) throw("Bad x in routine betai"); if (x == 0.0 || x == 1.0) return x; if (a > SWITCH && b > SWITCH) return betaiapprox(a,b,x); bt=exp(gammln(a+b)-gammln(a)-gammln(b)+a*log(x)+b*log(1.0-x)); if (x < (a+1.0)/(a+b+2.0)) return bt*betacf(a,b,x)/a; else return 1.0-bt*betacf(b,a,1.0-x)/b; } Doub betacf(const Doub a, const Doub b, const Doub x) { Int m,m2; Doub aa,c,d,del,h,qab,qam,qap; qab=a+b; qap=a+1.0; qam=a-1.0; c=1.0; d=1.0-qab*x/qap; if (fabs(d) < FPMIN) d=FPMIN; d=1.0/d; h=d; for (m=1;m<10000;m++) { m2=2*m; aa=m*(b-m)*x/((qam+m2)*(a+m2)); d=1.0+aa*d; if (fabs(d) < FPMIN) d=FPMIN; c=1.0+aa/c; if (fabs(c) < FPMIN) c=FPMIN; d=1.0/d; h *= d*c; aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2)); d=1.0+aa*d; if (fabs(d) < FPMIN) d=FPMIN; c=1.0+aa/c; if (fabs(c) < FPMIN) c=FPMIN; d=1.0/d; del=d*c; h *= del; if (fabs(del-1.0) <= EPS) break; } return h; } Doub betaiapprox(Doub a, Doub b, Doub x) { Int j; Doub xu,t,sum,ans; Doub a1 = a-1.0, b1 = b-1.0, mu = a/(a+b); Doub lnmu=log(mu),lnmuc=log(1.-mu); t = sqrt(a*b/(SQR(a+b)*(a+b+1.0))); if (x > a/(a+b)) { if (x >= 1.0) return 1.0; xu = MIN(1.,MAX(mu + 10.*t, x + 5.0*t)); } else { if (x <= 0.0) return 0.0; xu = MAX(0.,MIN(mu - 10.*t, x - 5.0*t)); } sum = 0; for (j=0;j<18;j++) { t = x + (xu-x)*y[j]; sum += w[j]*exp(a1*(log(t)-lnmu)+b1*(log(1-t)-lnmuc)); } ans = sum*(xu-x)*exp(a1*lnmu-gammln(a)+b1*lnmuc-gammln(b)+gammln(a+b)); return ans>0.0? 1.0-ans : -ans; } Doub invbetai(Doub p, Doub a, Doub b) { const Doub EPS = 1.e-8; Doub pp,t,u,err,x,al,h,w,afac,a1=a-1.,b1=b-1.; Int j; if (p <= 0.) return 0.; else if (p >= 1.) return 1.; else if (a >= 1. && b >= 1.) { pp = (p < 0.5)? p : 1. - p; t = sqrt(-2.*log(pp)); x = (2.30753+t*0.27061)/(1.+t*(0.99229+t*0.04481)) - t; if (p < 0.5) x = -x; al = (SQR(x)-3.)/6.; h = 2./(1./(2.*a-1.)+1./(2.*b-1.)); w = (x*sqrt(al+h)/h)-(1./(2.*b-1)-1./(2.*a-1.))*(al+5./6.-2./(3.*h)); x = a/(a+b*exp(2.*w)); } else { Doub lna = log(a/(a+b)), lnb = log(b/(a+b)); t = exp(a*lna)/a; u = exp(b*lnb)/b; w = t + u; if (p < t/w) x = pow(a*w*p,1./a); else x = 1. - pow(b*w*(1.-p),1./b); } afac = -gammln(a)-gammln(b)+gammln(a+b); for (j=0;j<10;j++) { if (x == 0. || x == 1.) return x; err = betai(a,b,x) - p; t = exp(a1*log(x)+b1*log(1.-x) + afac); u = err/t; x -= (t = u/(1.-0.5*MIN(1.,u*(a1/x - b1/(1.-x))))); if (x <= 0.) x = 0.5*(x + t); if (x >= 1.) x = 0.5*(x + t + 1.); if (fabs(t) < EPS*x && j > 0) break; } return x; } }; const Doub Beta::EPS = numeric_limits::epsilon(); const Doub Beta::FPMIN = numeric_limits::min()/EPS; struct Gammadist : Gamma { Doub alph, bet, fac; Gammadist(Doub aalph, Doub bbet = 1.) : alph(aalph), bet(bbet) { if (alph <= 0. || bet <= 0.) throw("bad alph,bet in Gammadist"); fac = alph*log(bet)-gammln(alph); } Doub p(Doub x) { if (x <= 0.) throw("bad x in Gammadist"); return exp(-bet*x+(alph-1.)*log(x)+fac); } Doub cdf(Doub x) { if (x < 0.) throw("bad x in Gammadist"); return gammp(alph,bet*x); } Doub invcdf(Doub p) { if (p < 0. || p >= 1.) throw("bad p in Gammadist"); return invgammp(p,alph)/bet; } }; struct Betadist : Beta { Doub alph, bet, fac; Betadist(Doub aalph, Doub bbet) : alph(aalph), bet(bbet) { if (alph <= 0. || bet <= 0.) throw("bad alph,bet in Betadist"); fac = gammln(alph+bet)-gammln(alph)-gammln(bet); } Doub p(Doub x) { if (x <= 0. || x >= 1.) throw("bad x in Betadist"); return exp((alph-1.)*log(x)+(bet-1.)*log(1.-x)+fac); } Doub cdf(Doub x) { if (x < 0. || x > 1.) throw("bad x in Betadist"); return betai(alph,bet,x); } Doub invcdf(Doub p) { if (p < 0. || p > 1.) throw("bad p in Betadist"); return invbetai(p,alph,bet); } }; struct Studenttdist : Beta { Doub nu, mu, sig, np, fac; Studenttdist(Doub nnu, Doub mmu = 0., Doub ssig = 1.) : nu(nnu), mu(mmu), sig(ssig) { if (sig <= 0. || nu <= 0.) throw("bad sig,nu in Studentdist"); np = 0.5*(nu + 1.); fac = gammln(np)-gammln(0.5*nu); } Doub p(Doub t) { return exp(-np*log(1.+SQR((t-mu)/sig)/nu)+fac) /(sqrt(3.14159265358979324*nu)*sig); } Doub cdf(Doub t) { Doub p = 0.5*betai(0.5*nu, 0.5, nu/(nu+SQR((t-mu)/sig))); if (t >= mu) return 1. - p; else return p; } Doub invcdf(Doub p) { if (p <= 0. || p >= 1.) throw("bad p in Studentdist"); Doub x = invbetai(2.*MIN(p,1.-p), 0.5*nu, 0.5); x = sig*sqrt(nu*(1.-x)/x); return (p >= 0.5? mu+x : mu-x); } Doub aa(Doub t) { if (t < 0.) throw("bad t in Studentdist"); return 1.-betai(0.5*nu, 0.5, nu/(nu+SQR(t))); } Doub invaa(Doub p) { if (p < 0. || p >= 1.) throw("bad p in Studentdist"); Doub x = invbetai(1.-p, 0.5*nu, 0.5); return sqrt(nu*(1.-x)/x); } }; struct Poissondist : Gamma { Doub lam; Poissondist(Doub llam) : lam(llam) { if (lam <= 0.) throw("bad lam in Poissondist"); } Doub p(Int n) { if (n < 0) throw("bad n in Poissondist"); return exp(-lam + n*log(lam) - gammln(n+1.)); } Doub cdf(Int n) { if (n < 0) throw("bad n in Poissondist"); if (n == 0) return 0.; return gammq((Doub)n,lam); } Int invcdf(Doub p) { Int n,nl,nu,inc=1; if (p <= 0. || p >= 1.) throw("bad p in Poissondist"); if (p < exp(-lam)) return 0; n = (Int)MAX(sqrt(lam),5.); if (p < cdf(n)) { do { n = MAX(n-inc,0); inc *= 2; } while (p < cdf(n)); nl = n; nu = n + inc/2; } else { do { n += inc; inc *= 2; } while (p > cdf(n)); nu = n; nl = n - inc/2; } while (nu-nl>1) { n = (nl+nu)/2; if (p < cdf(n)) nu = n; else nl = n; } return nl; } }; struct Binomialdist : Beta { Int n; Doub pe, fac; Binomialdist(Int nn, Doub ppe) : n(nn), pe(ppe) { if (n <= 0 || pe <= 0. || pe >= 1.) throw("bad args in Binomialdist"); fac = gammln(n+1.); } Doub p(Int k) { if (k < 0) throw("bad k in Binomialdist"); if (k > n) return 0.; return exp(k*log(pe)+(n-k)*log(1.-pe) +fac-gammln(k+1.)-gammln(n-k+1.)); } Doub cdf(Int k) { if (k < 0) throw("bad k in Binomialdist"); if (k == 0) return 0.; if (k > n) return 1.; return 1. - betai((Doub)k,n-k+1.,pe); } Int invcdf(Doub p) { Int k,kl,ku,inc=1; if (p <= 0. || p >= 1.) throw("bad p in Binomialdist"); k = MAX(0,MIN(n,(Int)(n*pe))); if (p < cdf(k)) { do { k = MAX(k-inc,0); inc *= 2; } while (p < cdf(k)); kl = k; ku = k + inc/2; } else { do { k = MIN(k+inc,n+1); inc *= 2; } while (p > cdf(k)); ku = k; kl = k - inc/2; } while (ku-kl>1) { k = (kl+ku)/2; if (p < cdf(k)) ku = k; else kl = k; } return kl; } }; struct Chisqdist : Gamma { Doub nu,fac; Chisqdist(Doub nnu) : nu(nnu) { if (nu <= 0.) throw("bad nu in Chisqdist"); fac = 0.693147180559945309*(0.5*nu)+gammln(0.5*nu); } Doub p(Doub x2) { if (x2 <= 0.) throw("bad x2 in Chisqdist"); return exp(-0.5*(x2-(nu-2.)*log(x2))-fac); } Doub cdf(Doub x2) { if (x2 < 0.) throw("bad x2 in Chisqdist"); return gammp(0.5*nu,0.5*x2); } Doub invcdf(Doub p) { if (p < 0. || p >= 1.) throw("bad p in Chisqdist"); return 2.*invgammp(p,0.5*nu); } }; struct Fdist : Beta { Doub nu1,nu2; Doub fac; Fdist(Doub nnu1, Doub nnu2) : nu1(nnu1), nu2(nnu2) { if (nu1 <= 0. || nu2 <= 0.) throw("bad nu1,nu2 in Fdist"); fac = 0.5*(nu1*log(nu1)+nu2*log(nu2))+gammln(0.5*(nu1+nu2)) -gammln(0.5*nu1)-gammln(0.5*nu2); } Doub p(Doub f) { if (f <= 0.) throw("bad f in Fdist"); return exp((0.5*nu1-1.)*log(f)-0.5*(nu1+nu2)*log(nu2+nu1*f)+fac); } Doub cdf(Doub f) { if (f < 0.) throw("bad f in Fdist"); return betai(0.5*nu1,0.5*nu2,nu1*f/(nu2+nu1*f)); } Doub invcdf(Doub p) { if (p <= 0. || p >= 1.) throw("bad p in Fdist"); Doub x = invbetai(p,0.5*nu1,0.5*nu2); return nu2*x/(nu1*(1.-x)); } };