trig.ha (24034B)
1 // SPDX-License-Identifier: MPL-2.0 2 // (c) Hare authors <https://harelang.org> 3 4 // Sections of the code below are based on Go's implementation, which is, in 5 // turn, based on: 6 // * the Cephes Mathematical Library (cephes/cmath/{sin,..}), available from 7 // http://www.netlib.org/cephes/cmath.tgz. 8 // * FreeBSD's /usr/src/lib/msun/src/{s_asinh.c,...} 9 // The original C code, as well as the respective comments and constants are 10 // from these libraries. 11 // 12 // The Cephes copyright notice: 13 // ==================================================== 14 // Cephes Math Library Release 2.8: June, 2000 15 // Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier 16 // 17 // The readme file at http://netlib.sandia.gov/cephes/ says: 18 // Some software in this archive may be from the book _Methods and 19 // Programs for Mathematical Functions_ (Prentice-Hall or Simon & Schuster 20 // International, 1989) or from the Cephes Mathematical Library, a 21 // commercial product. In either event, it is copyrighted by the author. 22 // What you see here may be used freely but it comes with no support or 23 // guarantee. 24 // 25 // The two known misprints in the book are repaired here in the 26 // source listings for the gamma function and the incomplete beta 27 // integral. 28 // 29 // Stephen L. Moshier 30 // moshier@na-net.ornl.gov 31 // ==================================================== 32 // 33 // The FreeBSD copyright notice: 34 // ==================================================== 35 // Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. 36 // 37 // Developed at SunPro, a Sun Microsystems, Inc. business. 38 // Permission to use, copy, modify, and distribute this 39 // software is freely granted, provided that this notice 40 // is preserved. 41 // ==================================================== 42 // 43 // The Go copyright notice: 44 // ==================================================== 45 // Copyright (c) 2009 The Go Authors. All rights reserved. 46 // 47 // Redistribution and use in source and binary forms, with or without 48 // modification, are permitted provided that the following conditions are 49 // met: 50 // 51 // * Redistributions of source code must retain the above copyright 52 // notice, this list of conditions and the following disclaimer. 53 // * Redistributions in binary form must reproduce the above 54 // copyright notice, this list of conditions and the following disclaimer 55 // in the documentation and/or other materials provided with the 56 // distribution. 57 // * Neither the name of Google Inc. nor the names of its 58 // contributors may be used to endorse or promote products derived from 59 // this software without specific prior written permission. 60 // 61 // THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 62 // "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 63 // LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 64 // A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 65 // OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 66 // SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 67 // LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 68 // DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 69 // THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 70 // (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 71 // OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 72 // ==================================================== 73 74 // sin coefficients 75 const SIN_CF: [_]f64 = [ 76 1.58962301576546568060e-10, // 0x3de5d8fd1fd19ccd 77 -2.50507477628578072866e-8, // 0xbe5ae5e5a9291f5d 78 2.75573136213857245213e-6, // 0x3ec71de3567d48a1 79 -1.98412698295895385996e-4, // 0xbf2a01a019bfdf03 80 8.33333333332211858878e-3, // 0x3f8111111110f7d0 81 -1.66666666666666307295e-1, // 0xbfc5555555555548 82 ]; 83 84 // cos coefficients 85 const COS_CF: [_]f64 = [ 86 -1.13585365213876817300e-11, // 0xbda8fa49a0861a9b 87 2.08757008419747316778e-9, // 0x3e21ee9d7b4e3f05 88 -2.75573141792967388112e-7, // 0xbe927e4f7eac4bc6 89 2.48015872888517045348e-5, // 0x3efa01a019c844f5 90 -1.38888888888730564116e-3, // 0xbf56c16c16c14f91 91 4.16666666666665929218e-2, // 0x3fa555555555554b 92 ]; 93 94 // PI / 4 split into three parts 95 def PI4A: f64 = 7.85398125648498535156e-1; // 0x3fe921fb40000000 96 def PI4B: f64 = 3.77489470793079817668e-8; // 0x3e64442d00000000 97 def PI4C: f64 = 2.69515142907905952645e-15; // 0x3ce8469898cc5170 98 99 // reduce_threshold is the maximum value of x where the reduction using PI/4 100 // in 3 float64 parts still gives accurate results. This threshold 101 // is set by y*C being representable as a float64 without error 102 // where y is given by y = floor(x * (4 / PI)) and C is the leading partial 103 // terms of 4/PI. Since the leading terms (PI4A and PI4B in sin.go) have 30 104 // and 32 trailing zero bits, y should have less than 30 significant bits. 105 // y < 1<<30 -> floor(x*4/PI) < 1<<30 -> x < (1<<30 - 1) * PI/4 106 // So, conservatively we can take x < 1<<29. 107 // Above this threshold Payne-Hanek range reduction must be used. 108 def REDUCE_THRESHOLD: f64 = ((1u64 << 29): f64); 109 110 // MPI4 is the binary digits of 4/pi as a uint64 array, 111 // that is, 4/pi = Sum MPI4[i]*2^(-64*i) 112 // 19 64-bit digits and the leading one bit give 1217 bits 113 // of precision to handle the largest possible float64 exponent. 114 const MPI4: [_]u64 = [ 115 0x0000000000000001, 116 0x45f306dc9c882a53, 117 0xf84eafa3ea69bb81, 118 0xb6c52b3278872083, 119 0xfca2c757bd778ac3, 120 0x6e48dc74849ba5c0, 121 0x0c925dd413a32439, 122 0xfc3bd63962534e7d, 123 0xd1046bea5d768909, 124 0xd338e04d68befc82, 125 0x7323ac7306a673e9, 126 0x3908bf177bf25076, 127 0x3ff12fffbc0b301f, 128 0xde5e2316b414da3e, 129 0xda6cfd9e4f96136e, 130 0x9e8c7ecd3cbfd45a, 131 0xea4f758fd7cbe2f6, 132 0x7a0e73ef14a525d4, 133 0xd7f6bf623f1aba10, 134 0xac06608df8f6d757, 135 ]; 136 137 // trig_reduce implements Payne-Hanek range reduction by PI/4 for x > 0. It 138 // returns the integer part mod 8 (j) and the fractional part (z) of x / (PI/4). 139 fn trig_reduce(x: f64) (u64, f64) = { 140 // The implementation is based on: "ARGUMENT REDUCTION FOR HUGE 141 // ARGUMENTS: Good to the Last Bit" K. C. Ng et al, March 24, 1992 142 // The simulated multi-precision calculation of x * B uses 64-bit 143 // integer arithmetic. 144 const PI4 = PI / 4f64; 145 if (x < PI4) { 146 return (0u64, x); 147 }; 148 // Extract out the integer and exponent such that x = ix * 2 ** exp 149 let ix = f64bits(x); 150 const exp = 151 ((ix >> F64_MANTISSA_BITS & 152 F64_EXPONENT_MASK): i64) - 153 (F64_EXPONENT_BIAS: i64) - 154 (F64_MANTISSA_BITS: i64); 155 ix = ix & ~(F64_EXPONENT_MASK << F64_MANTISSA_BITS); 156 ix |= 1 << F64_MANTISSA_BITS; 157 // Use the exponent to extract the 3 appropriate uint64 digits from 158 // MPI4, B ~ (z0, z1, z2), such that the product leading digit has the 159 // exponent -61. Note, exp >= -53 since x >= PI4 and exp < 971 for 160 // maximum float64. 161 const digit = ((exp + 61): u64) / 64; 162 const bitshift = ((exp + 61): u64) % 64; 163 const z0 = (MPI4[digit] << bitshift) | 164 (MPI4[digit + 1] >> (64 - bitshift)); 165 const z1 = (MPI4[digit + 1] << bitshift) | 166 (MPI4[digit + 2] >> (64 - bitshift)); 167 const z2 = (MPI4[digit + 2] << bitshift) | 168 (MPI4[digit + 3] >> (64 - bitshift)); 169 // Multiply mantissa by the digits and extract the upper two digits 170 // (hi, lo). 171 const z2 = mulu64(z2, ix); 172 const z2hi = z2.0; 173 const z1 = mulu64(z1, ix); 174 const z1hi = z1.0; 175 const z1lo = z1.1; 176 const z0lo = z0 * ix; 177 const add1 = addu64(z1lo, z2hi, 0); 178 const lo = add1.0; 179 const c = add1.1; 180 const add2 = addu64(z0lo, z1hi, c); 181 let hi = add2.0; 182 // The top 3 bits are j. 183 let j = hi >> 61; 184 // Extract the fraction and find its magnitude. 185 hi = hi << 3 | lo >> 61; 186 const lz = ((leading_zeros_u64(hi)): uint); 187 const e = ((F64_EXPONENT_BIAS - (lz + 1)): u64); 188 // Clear implicit mantissa bit and shift into place. 189 hi = (hi << (lz + 1)) | (lo >> (64 - (lz + 1))); 190 hi >>= 64 - F64_MANTISSA_BITS; 191 // Include the exponent and convert to a float. 192 hi |= e << F64_MANTISSA_BITS; 193 let z = f64frombits(hi); 194 // Map zeros to origin. 195 if (j & 1 == 1) { 196 j += 1; 197 j &= 7; 198 z -= 1f64; 199 }; 200 // Multiply the fractional part by pi/4. 201 return (j, z * PI4); 202 }; 203 204 // cos.c 205 // 206 // Circular cosine 207 // 208 // SYNOPSIS: 209 // 210 // double x, y, cos(); 211 // y = cos( x ); 212 // 213 // DESCRIPTION: 214 // 215 // Range reduction is into intervals of pi/4. The reduction error is nearly 216 // eliminated by contriving an extended precision modular arithmetic. 217 // 218 // Two polynomial approximating functions are employed. 219 // Between 0 and pi/4 the cosine is approximated by 220 // 1 - x**2 Q(x**2). 221 // Between pi/4 and pi/2 the sine is represented as 222 // x + x**3 P(x**2). 223 // 224 // ACCURACY: 225 // 226 // Relative error: 227 // arithmetic domain # trials peak rms 228 // IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 229 // DEC 0,+1.07e9 17000 3.0e-17 7.2e-18 230 231 // Returns the cosine of x, in radians. 232 export fn cosf64(x: f64) f64 = { 233 if (isnan(x) || isinf(x)) { 234 return NAN; 235 }; 236 237 // Make argument positive 238 let is_negative = false; 239 x = absf(x); 240 241 let j = 0u64; 242 let y = 0f64; 243 let z = 0f64; 244 if (x >= REDUCE_THRESHOLD) { 245 const reduce_res = trig_reduce(x); 246 j = reduce_res.0; 247 z = reduce_res.1; 248 } else { 249 // Integer part of x/(PI/4), as integer for tests on the phase 250 // angle 251 j = ((x * (4f64 / PI)): i64: u64); 252 // Integer part of x/(PI/4), as float 253 y = (j: i64: f64); 254 255 // Map zeros to origin 256 if (j & 1 == 1) { 257 j += 1; 258 y += 1f64; 259 }; 260 // Octant modulo 2PI radians (360 degrees) 261 j &= 7; 262 // Extended precision modular arithmetic 263 z = ((x - (y * PI4A)) - (y * PI4B)) - (y * PI4C); 264 }; 265 266 if (j > 3) { 267 j -= 4; 268 is_negative = !is_negative; 269 }; 270 if (j > 1) { 271 is_negative = !is_negative; 272 }; 273 274 const zz = z * z; 275 if (j == 1 || j == 2) { 276 y = z + z * zz * ((((((SIN_CF[0] * zz) + 277 SIN_CF[1]) * zz + 278 SIN_CF[2]) * zz + 279 SIN_CF[3]) * zz + 280 SIN_CF[4]) * zz + 281 SIN_CF[5]); 282 } else { 283 y = 1.0 - 0.5 * zz + zz * zz * ((((((COS_CF[0] * zz) + 284 COS_CF[1]) * zz + 285 COS_CF[2]) * zz + 286 COS_CF[3]) * zz + 287 COS_CF[4]) * zz + 288 COS_CF[5]); 289 }; 290 if (is_negative) { 291 y = -y; 292 }; 293 return y; 294 }; 295 296 // sin.c 297 // 298 // Circular sine 299 // 300 // SYNOPSIS: 301 // 302 // double x, y, sin(); 303 // y = sin( x ); 304 // 305 // DESCRIPTION: 306 // 307 // Range reduction is into intervals of pi/4. The reduction error is nearly 308 // eliminated by contriving an extended precision modular arithmetic. 309 // 310 // Two polynomial approximating functions are employed. 311 // Between 0 and pi/4 the sine is approximated by 312 // x + x**3 P(x**2). 313 // Between pi/4 and pi/2 the cosine is represented as 314 // 1 - x**2 Q(x**2). 315 // 316 // ACCURACY: 317 // 318 // Relative error: 319 // arithmetic domain # trials peak rms 320 // DEC 0, 10 150000 3.0e-17 7.8e-18 321 // IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 322 // 323 // Partial loss of accuracy begins to occur at x = 2**30 = 1.074e9. The loss 324 // is not gradual, but jumps suddenly to about 1 part in 10e7. Results may 325 // be meaningless for x > 2**49 = 5.6e14. 326 327 // Returns the sine of x, in radians. 328 export fn sinf64(x: f64) f64 = { 329 if (x == 0f64 || isnan(x)) { 330 return x; 331 } else if (isinf(x)) { 332 return NAN; 333 }; 334 335 // Make argument positive but save the sign 336 let is_negative = false; 337 if (x < 0f64) { 338 x = -x; 339 is_negative = true; 340 }; 341 342 let j = 0u64; 343 let y = 0f64; 344 let z = 0f64; 345 if (x >= REDUCE_THRESHOLD) { 346 const reduce_res = trig_reduce(x); 347 j = reduce_res.0; 348 z = reduce_res.1; 349 } else { 350 // Integer part of x/(PI/4), as integer for tests on the phase 351 // angle 352 j = ((x * (4f64 / PI)): i64: u64); 353 // Integer part of x/(PI/4), as float 354 y = (j: i64: f64); 355 356 // Map zeros to origin 357 if (j & 1 == 1) { 358 j += 1; 359 y += 1f64; 360 }; 361 // Octant modulo 2PI radians (360 degrees) 362 j &= 7; 363 // Extended precision modular arithmetic 364 z = ((x - (y * PI4A)) - (y * PI4B)) - (y * PI4C); 365 }; 366 367 // Reflect in x axis 368 if (j > 3) { 369 j -= 4; 370 is_negative = !is_negative; 371 }; 372 373 const zz = z * z; 374 if (j == 1 || j == 2) { 375 y = 1.0 - 0.5 * zz + zz * zz * 376 ((((((COS_CF[0] * zz) + 377 COS_CF[1]) * zz + 378 COS_CF[2]) * zz + 379 COS_CF[3]) * zz + 380 COS_CF[4]) * zz + 381 COS_CF[5]); 382 } else { 383 y = z + z * zz * 384 ((((((SIN_CF[0] * zz) + 385 SIN_CF[1]) * zz + 386 SIN_CF[2]) * zz + 387 SIN_CF[3]) * zz + 388 SIN_CF[4]) * zz + 389 SIN_CF[5]); 390 }; 391 if (is_negative) { 392 y = -y; 393 }; 394 return y; 395 }; 396 397 // tan.c 398 // 399 // Circular tangent 400 // 401 // SYNOPSIS: 402 // 403 // double x, y, tan(); 404 // y = tan( x ); 405 // 406 // DESCRIPTION: 407 // 408 // Returns the circular tangent of the radian argument x. 409 // 410 // Range reduction is modulo pi/4. A rational function 411 // x + x**3 P(x**2)/Q(x**2) 412 // is employed in the basic interval [0, pi/4]. 413 // 414 // ACCURACY: 415 // Relative error: 416 // arithmetic domain # trials peak rms 417 // DEC +-1.07e9 44000 4.1e-17 1.0e-17 418 // IEEE +-1.07e9 30000 2.9e-16 8.1e-17 419 // 420 // Partial loss of accuracy begins to occur at x = 2**30 = 1.074e9. The loss 421 // is not gradual, but jumps suddenly to about 1 part in 10e7. Results may 422 // be meaningless for x > 2**49 = 5.6e14. 423 // [Accuracy loss statement from sin.go comments.] 424 425 // tan coefficients 426 const TAN_P: [_]f64 = [ 427 -1.30936939181383777646e4, // 0xc0c992d8d24f3f38 428 1.15351664838587416140e6, // 0x413199eca5fc9ddd 429 -1.79565251976484877988e7, // 0xc1711fead3299176 430 ]; 431 const TAN_Q: [_]f64 = [ 432 1.00000000000000000000e0, 433 1.36812963470692954678e4, // 0x40cab8a5eeb36572 434 -1.32089234440210967447e6, // 0xc13427bc582abc96 435 2.50083801823357915839e7, // 0x4177d98fc2ead8ef 436 -5.38695755929454629881e7, // 0xc189afe03cbe5a31 437 ]; 438 439 // Returns the tangent of x, in radians. 440 export fn tanf64(x: f64) f64 = { 441 if (x == 0f64 || isnan(x)) { 442 return x; 443 } else if (isinf(x)) { 444 return NAN; 445 }; 446 447 // Make argument positive but save the sign 448 let is_negative = false; 449 if (x < 0f64) { 450 x = -x; 451 is_negative = true; 452 }; 453 let j = 0u64; 454 let y = 0f64; 455 let z = 0f64; 456 if (x >= REDUCE_THRESHOLD) { 457 const reduce_res = trig_reduce(x); 458 j = reduce_res.0; 459 z = reduce_res.1; 460 } else { 461 // Integer part of x/(PI/4), as integer for tests on the phase 462 // angle 463 j = ((x * (4f64 / PI)): i64: u64); 464 // Integer part of x/(PI/4), as float 465 y = (j: i64: f64); 466 467 // Map zeros and singularities to origin 468 if (j & 1 == 1) { 469 j += 1; 470 y += 1f64; 471 }; 472 473 z = ((x - (y * PI4A)) - (y * PI4B)) - (y * PI4C); 474 }; 475 const zz = z * z; 476 477 if (zz > 1e-14) { 478 y = z + z * (zz * 479 (((TAN_P[0] * zz) + TAN_P[1]) * zz + TAN_P[2]) / 480 ((((zz + TAN_Q[1]) * zz + 481 TAN_Q[2]) * zz + 482 TAN_Q[3]) * zz + 483 TAN_Q[4])); 484 } else { 485 y = z; 486 }; 487 if (j & 2 == 2) { 488 y = -1f64 / y; 489 }; 490 if (is_negative) { 491 y = -y; 492 }; 493 return y; 494 }; 495 496 // Evaluates a series valid in the range [0, 0.66]. 497 fn xatan(x: f64) f64 = { 498 const P0 = -8.750608600031904122785e-01; 499 const P1 = -1.615753718733365076637e+01; 500 const P2 = -7.500855792314704667340e+01; 501 const P3 = -1.228866684490136173410e+02; 502 const P4 = -6.485021904942025371773e+01; 503 const Q0 = 2.485846490142306297962e+01; 504 const Q1 = 1.650270098316988542046e+02; 505 const Q2 = 4.328810604912902668951e+02; 506 const Q3 = 4.853903996359136964868e+02; 507 const Q4 = 1.945506571482613964425e+02; 508 let z = x * x; 509 z = z * ((((P0 * z + P1) * z + P2) * z + P3) * z + P4) / 510 (((((z + Q0) * z + Q1) * z + Q2) * z + Q3) * z + Q4); 511 z = (x * z) + x; 512 return z; 513 }; 514 515 // Reduces argument (known to be positive) to the range [0, 0.66] and calls 516 // xatan. 517 fn satan(x: f64) f64 = { 518 // pi / 2 = PIO2 + morebits 519 const morebits = 6.123233995736765886130e-17; 520 // tan(3 * pi / 8) 521 const tan3pio8 = 2.41421356237309504880; 522 if (x <= 0.66) { 523 return xatan(x); 524 }; 525 if (x > tan3pio8) { 526 return (PI / 2f64) - xatan(1f64 / x) + morebits; 527 }; 528 return (PI / 4f64) + 529 xatan((x - 1f64) / (x + 1f64)) + 530 (0.5f64 * morebits); 531 }; 532 533 // Returns the arcsine, in radians, of x. 534 export fn asinf64(x: f64) f64 = { 535 if (x == 0f64) { 536 return x; 537 }; 538 let is_negative = false; 539 if (x < 0.064) { 540 x = -x; 541 is_negative = true; 542 }; 543 if (x > 1f64) { 544 return NAN; 545 }; 546 let temp = sqrtf64(1f64 - x * x); 547 if (x > 0.7f64) { 548 temp = PI / 2f64 - satan(temp / x); 549 } else { 550 temp = satan(x / temp); 551 }; 552 553 if (is_negative) { 554 temp = -temp; 555 }; 556 return temp; 557 }; 558 559 // Returns the arccosine, in radians, of x. 560 export fn acosf64(x: f64) f64 = { 561 return PI / 2f64 - asinf64(x); 562 }; 563 564 // atan.c 565 // Inverse circular tangent (arctangent) 566 // 567 // SYNOPSIS: 568 // double x, y, atan(); 569 // y = atan( x ); 570 // 571 // DESCRIPTION: 572 // Returns radian angle between -pi/2 and +pi/2 whose tangent is x. 573 // 574 // Range reduction is from three intervals into the interval from zero to 0.66. 575 // The approximant uses a rational function of degree 4/5 of the form 576 // x + x**3 P(x)/Q(x). 577 // 578 // ACCURACY: 579 // Relative error: 580 // arithmetic domain # trials peak rms 581 // DEC -10, 10 50000 2.4e-17 8.3e-18 582 // IEEE -10, 10 10^6 1.8e-16 5.0e-17 583 584 // Returns the arctangent, in radians, of x. 585 export fn atanf64(x: f64) f64 = { 586 if (x == 0f64) { 587 return x; 588 }; 589 if (x > 0f64) { 590 return satan(x); 591 }; 592 return -satan(-x); 593 }; 594 595 // Floating-point hyperbolic sine and cosine. 596 // The exponential func is called for arguments greater in magnitude than 0.5. 597 // A series is used for arguments smaller in magnitude than 0.5. 598 // Cosh(x) is computed from the exponential func for all arguments. 599 600 // Returns the hyperbolic sine of x. 601 export fn sinhf64(x: f64) f64 = { 602 // The coefficients are #2029 from Hart & Cheney. (20.36D) 603 const P0 = -0.6307673640497716991184787251e+6; 604 const P1 = -0.8991272022039509355398013511e+5; 605 const P2 = -0.2894211355989563807284660366e+4; 606 const P3 = -0.2630563213397497062819489e+2; 607 const Q0 = -0.6307673640497716991212077277e+6; 608 const Q1 = 0.1521517378790019070696485176e+5; 609 const Q2 = -0.173678953558233699533450911e+3; 610 611 let is_negative = false; 612 if (x < 0f64) { 613 x = -x; 614 is_negative = true; 615 }; 616 617 let temp = 0f64; 618 if (x > 21f64) { 619 temp = expf64(x) * 0.5f64; 620 } else if (x > 0.5f64) { 621 const ex = expf64(x); 622 temp = (ex - (1f64 / ex)) * 0.5f64; 623 } else { 624 const sq = x * x; 625 temp = (((P3 * sq + P2) * sq + P1) * sq + P0) * x; 626 temp = temp / (((sq + Q2) * sq + Q1) * sq + Q0); 627 }; 628 629 if (is_negative) { 630 temp = -temp; 631 }; 632 633 return temp; 634 }; 635 636 // Returns the hyperbolic cosine of x. 637 export fn coshf64(x: f64) f64 = { 638 x = absf64(x); 639 if (x > 21f64) { 640 return expf64(x) * 0.5f64; 641 }; 642 const ex = expf64(x); 643 return (ex + 1f64 / ex) * 0.5f64; 644 }; 645 646 // tanh.c 647 // 648 // Hyperbolic tangent 649 // 650 // SYNOPSIS: 651 // 652 // double x, y, tanh(); 653 // 654 // y = tanh( x ); 655 // 656 // DESCRIPTION: 657 // 658 // Returns hyperbolic tangent of argument in the range MINLOG to MAXLOG. 659 // MAXLOG = 8.8029691931113054295988e+01 = log(2**127) 660 // MINLOG = -8.872283911167299960540e+01 = log(2**-128) 661 // 662 // A rational function is used for |x| < 0.625. The form 663 // x + x**3 P(x)/Q(x) of Cody & Waite is employed. 664 // Otherwise, 665 // tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1). 666 // 667 // ACCURACY: 668 // 669 // Relative error: 670 // arithmetic domain # trials peak rms 671 // IEEE -2,2 30000 2.5e-16 5.8e-17 672 673 // tanh coefficients 674 const TANH_P: [_]f64 = [ 675 -9.64399179425052238628e-1, 676 -9.92877231001918586564e1, 677 -1.61468768441708447952e3, 678 ]; 679 const TANH_Q: [_]f64 = [ 680 1.12811678491632931402e2, 681 2.23548839060100448583e3, 682 4.84406305325125486048e3, 683 ]; 684 685 // Returns the hyperbolic tangent of x. 686 export fn tanhf64(x: f64) f64 = { 687 const MAXLOG = 8.8029691931113054295988e+01; // log(2**127) 688 let z = absf64(x); 689 if (z > 0.5f64 * MAXLOG) { 690 if (x < 0f64) { 691 return -1f64; 692 }; 693 return 1f64; 694 } else if (z >= 0.625f64) { 695 const s = expf64(2f64 * z); 696 z = 1f64 - 2f64 / (s + 1f64); 697 if (x < 0f64) { 698 z = -z; 699 }; 700 } else { 701 if (x == 0f64) { 702 return x; 703 }; 704 const s = x * x; 705 z = x + x * s * ((TANH_P[0] * s + TANH_P[1]) * s + TANH_P[2]) / 706 (((s + TANH_Q[0]) * s + TANH_Q[1]) * s + TANH_Q[2]); 707 }; 708 return z; 709 }; 710 711 // asinh(x) 712 // Method : 713 // Based on 714 // asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ] 715 // we have 716 // asinh(x) := x if 1+x*x=1, 717 // := sign(x)*(log(x)+ln2)) for large |x|, else 718 // := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else 719 // := sign(x)*log1p(|x| + x**2/(1 + sqrt(1+x**2))) 720 // 721 722 // Returns the inverse hyperbolic sine of x. 723 export fn asinhf64(x: f64) f64 = { 724 const NEAR_ZERO = 1f64 / ((1i64 << 28): f64); 725 const LARGE = ((1i64 << 28): f64); 726 727 if (isnan(x) || isinf(x)) { 728 return x; 729 }; 730 731 let is_negative = false; 732 if (x < 0f64) { 733 x = -x; 734 is_negative = true; 735 }; 736 737 let temp = 0f64; 738 739 if (x > LARGE) { 740 // |x| > 2**28 741 temp = logf64(x) + LN_2; 742 } else if (x > 2f64) { 743 // 2**28 > |x| > 2.0 744 temp = logf64(2f64 * x + 745 1f64 / (sqrtf64(x * x + 1f64) + x)); 746 } else if (x < NEAR_ZERO) { 747 // |x| < 2**-28 748 temp = x; 749 } else { 750 // 2.0 > |x| > 2**-28 751 temp = log1pf64(x + x * x / 752 (1f64 + sqrtf64(1f64 + x * x))); 753 }; 754 if (is_negative) { 755 temp = -temp; 756 }; 757 return temp; 758 }; 759 760 // __ieee754_acosh(x) 761 // Method : 762 // Based on 763 // acosh(x) = log [ x + sqrt(x*x-1) ] 764 // we have 765 // acosh(x) := log(x)+ln2, if x is large; else 766 // acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else 767 // acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1. 768 // 769 // Special cases: 770 // acosh(x) is NaN with signal if x<1. 771 // acosh(NaN) is NaN without signal. 772 // 773 774 // Returns the inverse hyperbolic cosine of x. 775 export fn acoshf64(x: f64) f64 = { 776 const LARGE = ((1i64 << 28): f64); 777 778 if (x < 1f64 || isnan(x)) { 779 return NAN; 780 } else if (x == 1f64) { 781 return 0f64; 782 } else if (x >= LARGE) { 783 // x > 2**28 784 return logf64(x) + LN_2; 785 } else if (x > 2f64) { 786 // 2**28 > x > 2 787 return logf64(2f64 * x - 1f64 / 788 (x + sqrtf64(x * x - 1f64))); 789 }; 790 const t = x - 1f64; 791 // 2 >= x > 1 792 return log1pf64(t + sqrtf64(2f64 * t + t * t)); 793 }; 794 795 // __ieee754_atanh(x) 796 // Method : 797 // 1. Reduce x to positive by atanh(-x) = -atanh(x) 798 // 2. For x>=0.5 799 // 1 2x x 800 // atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) 801 // 2 1 - x 1 - x 802 // 803 // For x<0.5 804 // atanh(x) = 0.5*log1p(2x+2x*x/(1-x)) 805 // 806 // Special cases: 807 // atanh(x) is NaN if |x| > 1 with signal; 808 // atanh(NaN) is that NaN with no signal; 809 // atanh(+-1) is +-INF with signal. 810 // 811 812 // Returns the inverse hyperbolic tangent of x. 813 export fn atanhf64(x: f64) f64 = { 814 const NEAR_ZERO = 1f64 / ((1i64 << 28): f64); 815 816 if (x < -1f64 || x > 1.064) { 817 return NAN; 818 } else if (isnan(x)) { 819 return NAN; 820 } else if (x == 1f64) { 821 return INF; 822 } else if (x == -1f64) { 823 return -INF; 824 }; 825 826 let is_negative = false; 827 828 if (x < 0f64) { 829 x = -x; 830 is_negative = true; 831 }; 832 833 let temp = 0f64; 834 835 if (x < NEAR_ZERO) { 836 temp = x; 837 } else if (x < 0.5f64) { 838 temp = x + x; 839 temp = 0.5f64 * log1pf64(temp + temp * x / (1f64 - x)); 840 } else { 841 temp = 0.5f64 * log1pf64((x + x) / (1f64 - x)); 842 }; 843 if (is_negative) { 844 temp = -temp; 845 }; 846 return temp; 847 }; 848 849 // Returns the arctangent, in radians, of y / x. 850 export fn atan2f64(y: f64, x: f64) f64 = { 851 if (isnan(y) || isnan(x)) { 852 return NAN; 853 } else if (y == 0f64) { 854 x = if (x >= 0f64 && signf64(x) > 0) 0f64 else PI; 855 return copysignf64(x, y); 856 } else if (x == 0f64) { 857 return copysignf64(PI / 2f64, y); 858 } else if (isinf(x)) { 859 if (signf64(x) > 0) { 860 x = if (isinf(y)) PI / 4f64 else 0f64; 861 return copysignf64(x, y); 862 } else { 863 x = if (isinf(y)) 3f64 * PI / 4f64 else PI; 864 return copysignf64(x, y); 865 }; 866 } else if (isinf(y)) { 867 return copysignf64(PI / 2f64, y); 868 }; 869 870 const q = atanf64(y / x); 871 if (x < 0f64) { 872 return if (q <= 0f64) q + PI else q - PI; 873 }; 874 return q; 875 }; 876 877 // Returns the square root of a*a + b*b, taking care to avoid unnecessary 878 // overflow and underflow. 879 export fn hypotf64(a: f64, b: f64) f64 = { 880 if (isinf(a) || isinf(b)) { 881 return INF; 882 } else if (isnan(a) || isnan(b)) { 883 return NAN; 884 }; 885 a = absf64(a); 886 b = absf64(b); 887 if (a < b) { 888 const temp = a; 889 a = b; 890 b = temp; 891 }; 892 if (a == 0f64) { 893 return 0f64; 894 }; 895 b = b / a; 896 return a * sqrtf64(1f64 + b * b); 897 };