| 1 | module math |
| 2 | |
| 3 | fn 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. |
| 18 | fn 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 |
| 47 | pub 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 | |
| 123 | fn 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 |
| 139 | pub 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) |
| 145 | pub 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 |
| 299 | fn 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 | |