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