1 /*
2 * Compute the natural log of Gamma(x), accurate to 10 decimal places.
3 *
4 * This implementation is based on:
5 *
6 * Pike, M.C., I.D. Hill (1966) Algorithm 291: Logarithm of Gamma function
7 * [S14]. Communications of the ACM 9(9):684.
8 */
9 static inline double
ln_gamma(double x)10 ln_gamma(double x) {
11 double f, z;
12
13 assert(x > 0.0);
14
15 if (x < 7.0) {
16 f = 1.0;
17 z = x;
18 while (z < 7.0) {
19 f *= z;
20 z += 1.0;
21 }
22 x = z;
23 f = -log(f);
24 } else {
25 f = 0.0;
26 }
27
28 z = 1.0 / (x * x);
29
30 return f + (x-0.5) * log(x) - x + 0.918938533204673 +
31 (((-0.000595238095238 * z + 0.000793650793651) * z -
32 0.002777777777778) * z + 0.083333333333333) / x;
33 }
34
35 /*
36 * Compute the incomplete Gamma ratio for [0..x], where p is the shape
37 * parameter, and ln_gamma_p is ln_gamma(p).
38 *
39 * This implementation is based on:
40 *
41 * Bhattacharjee, G.P. (1970) Algorithm AS 32: The incomplete Gamma integral.
42 * Applied Statistics 19:285-287.
43 */
44 static inline double
i_gamma(double x,double p,double ln_gamma_p)45 i_gamma(double x, double p, double ln_gamma_p) {
46 double acu, factor, oflo, gin, term, rn, a, b, an, dif;
47 double pn[6];
48 unsigned i;
49
50 assert(p > 0.0);
51 assert(x >= 0.0);
52
53 if (x == 0.0) {
54 return 0.0;
55 }
56
57 acu = 1.0e-10;
58 oflo = 1.0e30;
59 gin = 0.0;
60 factor = exp(p * log(x) - x - ln_gamma_p);
61
62 if (x <= 1.0 || x < p) {
63 /* Calculation by series expansion. */
64 gin = 1.0;
65 term = 1.0;
66 rn = p;
67
68 while (true) {
69 rn += 1.0;
70 term *= x / rn;
71 gin += term;
72 if (term <= acu) {
73 gin *= factor / p;
74 return gin;
75 }
76 }
77 } else {
78 /* Calculation by continued fraction. */
79 a = 1.0 - p;
80 b = a + x + 1.0;
81 term = 0.0;
82 pn[0] = 1.0;
83 pn[1] = x;
84 pn[2] = x + 1.0;
85 pn[3] = x * b;
86 gin = pn[2] / pn[3];
87
88 while (true) {
89 a += 1.0;
90 b += 2.0;
91 term += 1.0;
92 an = a * term;
93 for (i = 0; i < 2; i++) {
94 pn[i+4] = b * pn[i+2] - an * pn[i];
95 }
96 if (pn[5] != 0.0) {
97 rn = pn[4] / pn[5];
98 dif = fabs(gin - rn);
99 if (dif <= acu && dif <= acu * rn) {
100 gin = 1.0 - factor * gin;
101 return gin;
102 }
103 gin = rn;
104 }
105 for (i = 0; i < 4; i++) {
106 pn[i] = pn[i+2];
107 }
108
109 if (fabs(pn[4]) >= oflo) {
110 for (i = 0; i < 4; i++) {
111 pn[i] /= oflo;
112 }
113 }
114 }
115 }
116 }
117
118 /*
119 * Given a value p in [0..1] of the lower tail area of the normal distribution,
120 * compute the limit on the definite integral from [-inf..z] that satisfies p,
121 * accurate to 16 decimal places.
122 *
123 * This implementation is based on:
124 *
125 * Wichura, M.J. (1988) Algorithm AS 241: The percentage points of the normal
126 * distribution. Applied Statistics 37(3):477-484.
127 */
128 static inline double
pt_norm(double p)129 pt_norm(double p) {
130 double q, r, ret;
131
132 assert(p > 0.0 && p < 1.0);
133
134 q = p - 0.5;
135 if (fabs(q) <= 0.425) {
136 /* p close to 1/2. */
137 r = 0.180625 - q * q;
138 return q * (((((((2.5090809287301226727e3 * r +
139 3.3430575583588128105e4) * r + 6.7265770927008700853e4) * r
140 + 4.5921953931549871457e4) * r + 1.3731693765509461125e4) *
141 r + 1.9715909503065514427e3) * r + 1.3314166789178437745e2)
142 * r + 3.3871328727963666080e0) /
143 (((((((5.2264952788528545610e3 * r +
144 2.8729085735721942674e4) * r + 3.9307895800092710610e4) * r
145 + 2.1213794301586595867e4) * r + 5.3941960214247511077e3) *
146 r + 6.8718700749205790830e2) * r + 4.2313330701600911252e1)
147 * r + 1.0);
148 } else {
149 if (q < 0.0) {
150 r = p;
151 } else {
152 r = 1.0 - p;
153 }
154 assert(r > 0.0);
155
156 r = sqrt(-log(r));
157 if (r <= 5.0) {
158 /* p neither close to 1/2 nor 0 or 1. */
159 r -= 1.6;
160 ret = ((((((((7.74545014278341407640e-4 * r +
161 2.27238449892691845833e-2) * r +
162 2.41780725177450611770e-1) * r +
163 1.27045825245236838258e0) * r +
164 3.64784832476320460504e0) * r +
165 5.76949722146069140550e0) * r +
166 4.63033784615654529590e0) * r +
167 1.42343711074968357734e0) /
168 (((((((1.05075007164441684324e-9 * r +
169 5.47593808499534494600e-4) * r +
170 1.51986665636164571966e-2)
171 * r + 1.48103976427480074590e-1) * r +
172 6.89767334985100004550e-1) * r +
173 1.67638483018380384940e0) * r +
174 2.05319162663775882187e0) * r + 1.0));
175 } else {
176 /* p near 0 or 1. */
177 r -= 5.0;
178 ret = ((((((((2.01033439929228813265e-7 * r +
179 2.71155556874348757815e-5) * r +
180 1.24266094738807843860e-3) * r +
181 2.65321895265761230930e-2) * r +
182 2.96560571828504891230e-1) * r +
183 1.78482653991729133580e0) * r +
184 5.46378491116411436990e0) * r +
185 6.65790464350110377720e0) /
186 (((((((2.04426310338993978564e-15 * r +
187 1.42151175831644588870e-7) * r +
188 1.84631831751005468180e-5) * r +
189 7.86869131145613259100e-4) * r +
190 1.48753612908506148525e-2) * r +
191 1.36929880922735805310e-1) * r +
192 5.99832206555887937690e-1)
193 * r + 1.0));
194 }
195 if (q < 0.0) {
196 ret = -ret;
197 }
198 return ret;
199 }
200 }
201
202 /*
203 * Given a value p in [0..1] of the lower tail area of the Chi^2 distribution
204 * with df degrees of freedom, where ln_gamma_df_2 is ln_gamma(df/2.0), compute
205 * the upper limit on the definite integral from [0..z] that satisfies p,
206 * accurate to 12 decimal places.
207 *
208 * This implementation is based on:
209 *
210 * Best, D.J., D.E. Roberts (1975) Algorithm AS 91: The percentage points of
211 * the Chi^2 distribution. Applied Statistics 24(3):385-388.
212 *
213 * Shea, B.L. (1991) Algorithm AS R85: A remark on AS 91: The percentage
214 * points of the Chi^2 distribution. Applied Statistics 40(1):233-235.
215 */
216 static inline double
pt_chi2(double p,double df,double ln_gamma_df_2)217 pt_chi2(double p, double df, double ln_gamma_df_2) {
218 double e, aa, xx, c, ch, a, q, p1, p2, t, x, b, s1, s2, s3, s4, s5, s6;
219 unsigned i;
220
221 assert(p >= 0.0 && p < 1.0);
222 assert(df > 0.0);
223
224 e = 5.0e-7;
225 aa = 0.6931471805;
226
227 xx = 0.5 * df;
228 c = xx - 1.0;
229
230 if (df < -1.24 * log(p)) {
231 /* Starting approximation for small Chi^2. */
232 ch = pow(p * xx * exp(ln_gamma_df_2 + xx * aa), 1.0 / xx);
233 if (ch - e < 0.0) {
234 return ch;
235 }
236 } else {
237 if (df > 0.32) {
238 x = pt_norm(p);
239 /*
240 * Starting approximation using Wilson and Hilferty
241 * estimate.
242 */
243 p1 = 0.222222 / df;
244 ch = df * pow(x * sqrt(p1) + 1.0 - p1, 3.0);
245 /* Starting approximation for p tending to 1. */
246 if (ch > 2.2 * df + 6.0) {
247 ch = -2.0 * (log(1.0 - p) - c * log(0.5 * ch) +
248 ln_gamma_df_2);
249 }
250 } else {
251 ch = 0.4;
252 a = log(1.0 - p);
253 while (true) {
254 q = ch;
255 p1 = 1.0 + ch * (4.67 + ch);
256 p2 = ch * (6.73 + ch * (6.66 + ch));
257 t = -0.5 + (4.67 + 2.0 * ch) / p1 - (6.73 + ch
258 * (13.32 + 3.0 * ch)) / p2;
259 ch -= (1.0 - exp(a + ln_gamma_df_2 + 0.5 * ch +
260 c * aa) * p2 / p1) / t;
261 if (fabs(q / ch - 1.0) - 0.01 <= 0.0) {
262 break;
263 }
264 }
265 }
266 }
267
268 for (i = 0; i < 20; i++) {
269 /* Calculation of seven-term Taylor series. */
270 q = ch;
271 p1 = 0.5 * ch;
272 if (p1 < 0.0) {
273 return -1.0;
274 }
275 p2 = p - i_gamma(p1, xx, ln_gamma_df_2);
276 t = p2 * exp(xx * aa + ln_gamma_df_2 + p1 - c * log(ch));
277 b = t / ch;
278 a = 0.5 * t - b * c;
279 s1 = (210.0 + a * (140.0 + a * (105.0 + a * (84.0 + a * (70.0 +
280 60.0 * a))))) / 420.0;
281 s2 = (420.0 + a * (735.0 + a * (966.0 + a * (1141.0 + 1278.0 *
282 a)))) / 2520.0;
283 s3 = (210.0 + a * (462.0 + a * (707.0 + 932.0 * a))) / 2520.0;
284 s4 = (252.0 + a * (672.0 + 1182.0 * a) + c * (294.0 + a *
285 (889.0 + 1740.0 * a))) / 5040.0;
286 s5 = (84.0 + 264.0 * a + c * (175.0 + 606.0 * a)) / 2520.0;
287 s6 = (120.0 + c * (346.0 + 127.0 * c)) / 5040.0;
288 ch += t * (1.0 + 0.5 * t * s1 - b * c * (s1 - b * (s2 - b * (s3
289 - b * (s4 - b * (s5 - b * s6))))));
290 if (fabs(q / ch - 1.0) <= e) {
291 break;
292 }
293 }
294
295 return ch;
296 }
297
298 /*
299 * Given a value p in [0..1] and Gamma distribution shape and scale parameters,
300 * compute the upper limit on the definite integral from [0..z] that satisfies
301 * p.
302 */
303 static inline double
pt_gamma(double p,double shape,double scale,double ln_gamma_shape)304 pt_gamma(double p, double shape, double scale, double ln_gamma_shape) {
305 return pt_chi2(p, shape * 2.0, ln_gamma_shape) * 0.5 * scale;
306 }
307