v / vlib / math
Raw file | 335 loc (330 sloc) | 7.69 KB | Latest commit hash fe14e2fce
1module 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.
10fn 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
41pub 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
137pub fn log_gamma(x f64) f64 {
138 y, _ := log_gamma_sign(x)
139 return y
140}
141
142pub 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
297fn 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}