1 | module math |
2 | |
3 | // gamma function computed by Stirling's formula. |
4 | // The pair of results must be multiplied together to get the actual answer. |
5 | // The multiplication is left to the caller so that, if careful, the caller can avoid |
6 | // infinity for 172 <= x <= 180. |
7 | // The polynomial is valid for 33 <= x <= 172 larger values are only used |
8 | // in reciprocal and produce denormalized floats. The lower precision there |
9 | // masks any imprecision in the polynomial. |
10 | fn stirling(x f64) (f64, f64) { |
11 | if x > 200 { |
12 | return inf(1), 1.0 |
13 | } |
14 | sqrt_two_pi := 2.506628274631000502417 |
15 | max_stirling := 143.01608 |
16 | mut w := 1.0 / x |
17 | w = 1.0 + w * ((((gamma_s[0] * w + gamma_s[1]) * w + gamma_s[2]) * w + gamma_s[3]) * w + |
18 | gamma_s[4]) |
19 | mut y1 := exp(x) |
20 | mut y2 := 1.0 |
21 | if x > max_stirling { // avoid Pow() overflow |
22 | v := pow(x, 0.5 * x - 0.25) |
23 | y1_ := y1 |
24 | y1 = v |
25 | y2 = v / y1_ |
26 | } else { |
27 | y1 = pow(x, x - 0.5) / y1 |
28 | } |
29 | return y1, f64(sqrt_two_pi) * w * y2 |
30 | } |
31 | |
32 | // gamma returns the gamma function of x. |
33 | // |
34 | // special ifs are: |
35 | // gamma(+inf) = +inf |
36 | // gamma(+0) = +inf |
37 | // gamma(-0) = -inf |
38 | // gamma(x) = nan for integer x < 0 |
39 | // gamma(-inf) = nan |
40 | // gamma(nan) = nan |
41 | pub fn gamma(a f64) f64 { |
42 | mut x := a |
43 | euler := 0.57721566490153286060651209008240243104215933593992 // A001620 |
44 | if is_neg_int(x) || is_inf(x, -1) || is_nan(x) { |
45 | return nan() |
46 | } |
47 | if is_inf(x, 1) { |
48 | return inf(1) |
49 | } |
50 | if x == 0.0 { |
51 | return copysign(inf(1), x) |
52 | } |
53 | mut q := abs(x) |
54 | mut p := floor(q) |
55 | if q > 33 { |
56 | if x >= 0 { |
57 | y1, y2 := stirling(x) |
58 | return y1 * y2 |
59 | } |
60 | // Note: x is negative but (checked above) not a negative integer, |
61 | // so x must be small enough to be in range for conversion to i64. |
62 | // If |x| were >= 2⁶³ it would have to be an integer. |
63 | mut signgam := 1 |
64 | ip := i64(p) |
65 | if (ip & 1) == 0 { |
66 | signgam = -1 |
67 | } |
68 | mut z := q - p |
69 | if z > 0.5 { |
70 | p = p + 1 |
71 | z = q - p |
72 | } |
73 | z = q * sin(pi * z) |
74 | if z == 0 { |
75 | return inf(signgam) |
76 | } |
77 | sq1, sq2 := stirling(q) |
78 | absz := abs(z) |
79 | d := absz * sq1 * sq2 |
80 | if is_inf(d, 0) { |
81 | z = pi / absz / sq1 / sq2 |
82 | } else { |
83 | z = pi / d |
84 | } |
85 | return f64(signgam) * z |
86 | } |
87 | // Reduce argument |
88 | mut z := 1.0 |
89 | for x >= 3 { |
90 | x = x - 1 |
91 | z = z * x |
92 | } |
93 | for x < 0 { |
94 | if x > -1e-09 { |
95 | unsafe { |
96 | goto small |
97 | } |
98 | } |
99 | z = z / x |
100 | x = x + 1 |
101 | } |
102 | for x < 2 { |
103 | if x < 1e-09 { |
104 | unsafe { |
105 | goto small |
106 | } |
107 | } |
108 | z = z / x |
109 | x = x + 1 |
110 | } |
111 | if x == 2 { |
112 | return z |
113 | } |
114 | x = x - 2 |
115 | p = (((((x * gamma_p[0] + gamma_p[1]) * x + gamma_p[2]) * x + gamma_p[3]) * x + |
116 | gamma_p[4]) * x + gamma_p[5]) * x + gamma_p[6] |
117 | q = ((((((x * gamma_q[0] + gamma_q[1]) * x + gamma_q[2]) * x + gamma_q[3]) * x + |
118 | gamma_q[4]) * x + gamma_q[5]) * x + gamma_q[6]) * x + gamma_q[7] |
119 | if true { |
120 | return z * p / q |
121 | } |
122 | small: |
123 | if x == 0 { |
124 | return inf(1) |
125 | } |
126 | return z / ((1.0 + euler * x) * x) |
127 | } |
128 | |
129 | // log_gamma returns the natural logarithm and sign (-1 or +1) of Gamma(x). |
130 | // |
131 | // special ifs are: |
132 | // log_gamma(+inf) = +inf |
133 | // log_gamma(0) = +inf |
134 | // log_gamma(-integer) = +inf |
135 | // log_gamma(-inf) = -inf |
136 | // log_gamma(nan) = nan |
137 | pub fn log_gamma(x f64) f64 { |
138 | y, _ := log_gamma_sign(x) |
139 | return y |
140 | } |
141 | |
142 | pub fn log_gamma_sign(a f64) (f64, int) { |
143 | mut x := a |
144 | ymin := 1.461632144968362245 |
145 | tiny := exp2(-70) |
146 | two52 := exp2(52) // 0x4330000000000000 ~4.5036e+15 |
147 | two58 := exp2(58) // 0x4390000000000000 ~2.8823e+17 |
148 | tc := 1.46163214496836224576e+00 // 0x3FF762D86356BE3F |
149 | tf := -1.21486290535849611461e-01 // 0xBFBF19B9BCC38A42 |
150 | // tt := -(tail of tf) |
151 | tt := -3.63867699703950536541e-18 // 0xBC50C7CAA48A971F |
152 | mut sign := 1 |
153 | if is_nan(x) { |
154 | return x, sign |
155 | } |
156 | if is_inf(x, 1) { |
157 | return x, sign |
158 | } |
159 | if x == 0.0 { |
160 | return inf(1), sign |
161 | } |
162 | mut neg := false |
163 | if x < 0 { |
164 | x = -x |
165 | neg = true |
166 | } |
167 | if x < tiny { // if |x| < 2**-70, return -log(|x|) |
168 | if neg { |
169 | sign = -1 |
170 | } |
171 | return -log(x), sign |
172 | } |
173 | mut nadj := 0.0 |
174 | if neg { |
175 | if x >= two52 { |
176 | // x| >= 2**52, must be -integer |
177 | return inf(1), sign |
178 | } |
179 | t := sin_pi(x) |
180 | if t == 0 { |
181 | return inf(1), sign |
182 | } |
183 | nadj = log(pi / abs(t * x)) |
184 | if t < 0 { |
185 | sign = -1 |
186 | } |
187 | } |
188 | mut lgamma := 0.0 |
189 | if x == 1 || x == 2 { // purge off 1 and 2 |
190 | return 0.0, sign |
191 | } else if x < 2 { // use lgamma(x) = lgamma(x+1) - log(x) |
192 | mut y := 0.0 |
193 | mut i := 0 |
194 | if x <= 0.9 { |
195 | lgamma = -log(x) |
196 | if x >= (ymin - 1 + 0.27) { // 0.7316 <= x <= 0.9 |
197 | y = 1.0 - x |
198 | i = 0 |
199 | } else if x >= (ymin - 1 - 0.27) { // 0.2316 <= x < 0.7316 |
200 | y = x - (tc - 1) |
201 | i = 1 |
202 | } else { // 0 < x < 0.2316 |
203 | y = x |
204 | i = 2 |
205 | } |
206 | } else { |
207 | lgamma = 0 |
208 | if x >= (ymin + 0.27) { // 1.7316 <= x < 2 |
209 | y = f64(2) - x |
210 | i = 0 |
211 | } else if x >= (ymin - 0.27) { // 1.2316 <= x < 1.7316 |
212 | y = x - tc |
213 | i = 1 |
214 | } else { // 0.9 < x < 1.2316 |
215 | y = x - 1 |
216 | i = 2 |
217 | } |
218 | } |
219 | if i == 0 { |
220 | z := y * y |
221 | gamma_p1 := lgamma_a[0] + z * (lgamma_a[2] + z * (lgamma_a[4] + z * (lgamma_a[6] + |
222 | z * (lgamma_a[8] + z * lgamma_a[10])))) |
223 | gamma_p2 := z * (lgamma_a[1] + z * (lgamma_a[3] + z * (lgamma_a[5] + z * (lgamma_a[7] + |
224 | z * (lgamma_a[9] + z * lgamma_a[11]))))) |
225 | p := y * gamma_p1 + gamma_p2 |
226 | lgamma += (p - 0.5 * y) |
227 | } else if i == 1 { |
228 | z := y * y |
229 | w := z * y |
230 | gamma_p1 := lgamma_t[0] + w * (lgamma_t[3] + w * (lgamma_t[6] + w * (lgamma_t[9] + |
231 | w * lgamma_t[12]))) // parallel comp |
232 | gamma_p2 := lgamma_t[1] + w * (lgamma_t[4] + w * (lgamma_t[7] + w * (lgamma_t[10] + |
233 | w * lgamma_t[13]))) |
234 | gamma_p3 := lgamma_t[2] + w * (lgamma_t[5] + w * (lgamma_t[8] + w * (lgamma_t[11] + |
235 | w * lgamma_t[14]))) |
236 | p := z * gamma_p1 - (tt - w * (gamma_p2 + y * gamma_p3)) |
237 | lgamma += (tf + p) |
238 | } else if i == 2 { |
239 | gamma_p1 := y * (lgamma_u[0] + y * (lgamma_u[1] + y * (lgamma_u[2] + y * (lgamma_u[3] + |
240 | y * (lgamma_u[4] + y * lgamma_u[5]))))) |
241 | gamma_p2 := 1.0 + y * (lgamma_v[1] + y * (lgamma_v[2] + y * (lgamma_v[3] + |
242 | y * (lgamma_v[4] + y * lgamma_v[5])))) |
243 | lgamma += (-0.5 * y + gamma_p1 / gamma_p2) |
244 | } |
245 | } else if x < 8 { // 2 <= x < 8 |
246 | i := int(x) |
247 | y := x - f64(i) |
248 | p := y * (lgamma_s[0] + y * (lgamma_s[1] + y * (lgamma_s[2] + y * (lgamma_s[3] + |
249 | y * (lgamma_s[4] + y * (lgamma_s[5] + y * lgamma_s[6])))))) |
250 | q := 1.0 + y * (lgamma_r[1] + y * (lgamma_r[2] + y * (lgamma_r[3] + y * (lgamma_r[4] + |
251 | y * (lgamma_r[5] + y * lgamma_r[6]))))) |
252 | lgamma = 0.5 * y + p / q |
253 | mut z := 1.0 // lgamma(1+s) = log(s) + lgamma(s) |
254 | if i == 7 { |
255 | z *= (y + 6) |
256 | z *= (y + 5) |
257 | z *= (y + 4) |
258 | z *= (y + 3) |
259 | z *= (y + 2) |
260 | lgamma += log(z) |
261 | } else if i == 6 { |
262 | z *= (y + 5) |
263 | z *= (y + 4) |
264 | z *= (y + 3) |
265 | z *= (y + 2) |
266 | lgamma += log(z) |
267 | } else if i == 5 { |
268 | z *= (y + 4) |
269 | z *= (y + 3) |
270 | z *= (y + 2) |
271 | lgamma += log(z) |
272 | } else if i == 4 { |
273 | z *= (y + 3) |
274 | z *= (y + 2) |
275 | lgamma += log(z) |
276 | } else if i == 3 { |
277 | z *= (y + 2) |
278 | lgamma += log(z) |
279 | } |
280 | } else if x < two58 { // 8 <= x < 2**58 |
281 | t := log(x) |
282 | z := 1.0 / x |
283 | y := z * z |
284 | w := lgamma_w[0] + z * (lgamma_w[1] + y * (lgamma_w[2] + y * (lgamma_w[3] + |
285 | y * (lgamma_w[4] + y * (lgamma_w[5] + y * lgamma_w[6]))))) |
286 | lgamma = (x - 0.5) * (t - 1.0) + w |
287 | } else { // 2**58 <= x <= Inf |
288 | lgamma = x * (log(x) - 1.0) |
289 | } |
290 | if neg { |
291 | lgamma = nadj - lgamma |
292 | } |
293 | return lgamma, sign |
294 | } |
295 | |
296 | // sin_pi(x) is a helper function for negative x |
297 | fn sin_pi(x_ f64) f64 { |
298 | mut x := x_ |
299 | two52 := exp2(52) // 0x4330000000000000 ~4.5036e+15 |
300 | two53 := exp2(53) // 0x4340000000000000 ~9.0072e+15 |
301 | if x < 0.25 { |
302 | return -sin(pi * x) |
303 | } |
304 | // argument reduction |
305 | mut z := floor(x) |
306 | mut n := 0 |
307 | if z != x { // inexact |
308 | x = mod(x, 2) |
309 | n = int(x * 4) |
310 | } else { |
311 | if x >= two53 { // x must be even |
312 | x = 0 |
313 | n = 0 |
314 | } else { |
315 | if x < two52 { |
316 | z = x + two52 // exact |
317 | } |
318 | n = 1 & int(f64_bits(z)) |
319 | x = f64(n) |
320 | n <<= 2 |
321 | } |
322 | } |
323 | if n == 0 { |
324 | x = sin(pi * x) |
325 | } else if n == 1 || n == 2 { |
326 | x = cos(pi * (0.5 - x)) |
327 | } else if n == 3 || n == 4 { |
328 | x = sin(pi * (1.0 - x)) |
329 | } else if n == 5 || n == 6 { |
330 | x = -cos(pi * (x - 1.5)) |
331 | } else { |
332 | x = sin(pi * (x - 2)) |
333 | } |
334 | return -x |
335 | } |