complex.ha (20982B)
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 Cephes Math Library. The original C code can be found at 6 // http://netlib.sandia.gov/cephes/c9x-complex/. 7 // 8 // Cephes Math Library Release 2.8: June, 2000 9 // Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier 10 // 11 // The readme file at http://netlib.sandia.gov/cephes/ says: 12 // Some software in this archive may be from the book _Methods and 13 // Programs for Mathematical Functions_ (Prentice-Hall or Simon & Schuster 14 // International, 1989) or from the Cephes Mathematical Library, a 15 // commercial product. In either event, it is copyrighted by the author. 16 // What you see here may be used freely but it comes with no support or 17 // guarantee. 18 // 19 // The two known misprints in the book are repaired here in the 20 // source listings for the gamma function and the incomplete beta 21 // integral. 22 // 23 // Stephen L. Moshier 24 // moshier@na-net.ornl.gov 25 // 26 // The Go copyright notice: 27 // ==================================================== 28 // Copyright (c) 2009 The Go Authors. All rights reserved. 29 // 30 // Redistribution and use in source and binary forms, with or without 31 // modification, are permitted provided that the following conditions are 32 // met: 33 // 34 // * Redistributions of source code must retain the above copyright 35 // notice, this list of conditions and the following disclaimer. 36 // * Redistributions in binary form must reproduce the above 37 // copyright notice, this list of conditions and the following disclaimer 38 // in the documentation and/or other materials provided with the 39 // distribution. 40 // * Neither the name of Google Inc. nor the names of its 41 // contributors may be used to endorse or promote products derived from 42 // this software without specific prior written permission. 43 // 44 // THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 45 // "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 46 // LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 47 // A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 48 // OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 49 // SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 50 // LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 51 // DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 52 // THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 53 // (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 54 // OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 55 // ==================================================== 56 57 use math; 58 59 // A complex number containing a real component and an imaginary component, 60 // represented as two single-precision floating point numbers. 61 export type c64 = (f32, f32); 62 63 // A complex number containing a real component and an imaginary component, 64 // represented as two double-precision floating point numbers. 65 export type c128 = (f64, f64); 66 67 // A tagged union of all complex types. 68 export type complex = (c64 | c128); 69 70 // Converts a [[c64]] to a [[c128]]. 71 export fn c64to128(z: c64) c128 = (z.0: f64, z.1: f64); 72 73 // Truncates a [[c128]] to a [[c64]]. Precision may be lost. 74 export fn c128to64(z: c128) c64 = (z.0: f32, z.1: f32); 75 76 // Adds two complex numbers 77 export fn addc64(a: c64, b: c64) c64 = (a.0 + b.0, a.1 + b.1); 78 79 // Adds two complex numbers. 80 export fn addc128(a: c128, b: c128) c128 = (a.0 + b.0, a.1 + b.1); 81 82 // Subtracts two complex numbers. 83 export fn subc64(a: c64, b: c64) c64 = (a.0 - b.0, a.1 - b.1); 84 85 // Subtracts two complex numbers. 86 export fn subc128(a: c128, b: c128) c128 = (a.0 - b.0, a.1 - b.1); 87 88 // Multiplies two complex numbers. 89 export fn mulc64(a: c64, b: c64) c64 = 90 (a.0 * b.0 - a.1 * b.1, a.1 * b.0 + a.0 * b.1); 91 92 // Multiplies two complex numbers. 93 export fn mulc128(a: c128, b: c128) c128 = 94 (a.0 * b.0 - a.1 * b.1, a.1 * b.0 + a.0 * b.1); 95 96 // Divides two complex numbers. 97 export fn divc64(a: c64, b: c64) c64 = { 98 const denom = b.0 * b.0 + b.1 * b.1; 99 return ( 100 (a.0 * b.0 + a.1 * b.1) / denom, 101 (a.1 * b.0 - a.0 * b.1) / denom, 102 ); 103 }; 104 105 // Divides two complex numbers. 106 export fn divc128(a: c128, b: c128) c128 = { 107 const denom = b.0 * b.0 + b.1 * b.1; 108 return ( 109 (a.0 * b.0 + a.1 * b.1) / denom, 110 (a.1 * b.0 - a.0 * b.1) / denom, 111 ); 112 }; 113 114 // Takes the conjugate of a complex number by negating the imaginary component. 115 export fn conjc64(z: c64) c64 = (z.0, -z.1); 116 117 // Takes the conjugate of a complex number by negating the imaginary component. 118 export fn conjc128(z: c128) c128 = (z.0, -z.1); 119 120 // Takes the absolute value of a complex number. 121 export fn absc128(z: c128) f64 = math::hypotf64(z.0, z.1); 122 123 // Gets the argument, or phase, of a complex number. 124 export fn argc128(z: c128) f64 = math::atan2f64(z.1, z.0); 125 126 // Checks if two complex numbers are equal. Be sure to take floating point 127 // round-off errors into account. 128 export fn equalc64(a: c64, b: c64) bool = a.0 == b.0 && a.1 == b.1; 129 130 // Checks if two complex numbers are equal. Be sure to take floating point 131 // round-off errors into account. 132 export fn equalc128(a: c128, b: c128) bool = a.0 == b.0 && a.1 == b.1; 133 134 // Checks if two complex numbers are equal. Be sure to take floating point 135 // round-off errors into account. 136 export fn equal(a: complex, b: complex) bool = { 137 match (a) { 138 case let a: c64 => 139 return equalc64(a, b as c64); 140 case let a: c128 => 141 return equalc128(a, b as c128); 142 }; 143 }; 144 145 // Returns [[math::E]] raised to the power of z. 146 export fn expc128(z: c128) c128 = { 147 if (math::isinf(z.0)) { 148 if (z.0 > 0f64 && z.1 == 0f64) { 149 return z; 150 }; 151 if (math::isinf(z.1) || math::isnan(z.1)) { 152 if (z.0 < 0f64) { 153 return (0f64, math::copysignf64(0f64, z.1)); 154 } else { 155 return (math::INF, math::NAN); 156 }; 157 }; 158 } else if (math::isnan(z.0) && z.1 == 0f64) { 159 return (math::NAN, z.1); 160 }; 161 return rectc128(math::expf64(z.0), z.1); 162 }; 163 164 // Returns true if the given complex number is infinite. 165 export fn isinf(z: c128) bool = math::isinf(z.0) || math::isinf(z.1); 166 167 // Returns true if the given complex number is NaN -- that is -- either 168 // component is NaN and neither component is an infinity. 169 export fn isnan(z: c128) bool = 170 !isinf(z) && (math::isnan(z.0) || math::isnan(z.1)); 171 172 // Returns the natural logarithm of z. 173 export fn logc128(z: c128) c128 = (math::logf64(absc128(z)), argc128(z)); 174 175 // Negates z. 176 export fn negc64(z: c64) c64 = (-z.0, -z.1); 177 178 // Negates z. 179 export fn negc128(z: c128) c128 = (-z.0, -z.1); 180 181 // Creates a new [[c128]] from the polar coordinates (r, theta). 182 export fn rectc128(r: f64, theta: f64) c128 = 183 (r * math::cosf64(theta), r * math::sinf64(theta)); 184 185 // Returns the polar coordinates of z. 186 export fn polarc128(z: c128) (f64, f64) = (absc128(z), argc128(z)); 187 188 // Returns a raised to the power of b. 189 export fn powc128(a: c128, b: c128) c128 = { 190 if (a.0 == 0f64 && a.1 == 0f64) { 191 if (isnan(b)) { 192 return (math::NAN, math::NAN); 193 } else if (b.0 == 0f64) { 194 return (1f64, 0f64); 195 } else if (b.0 < 0f64) { 196 return (math::INF, if (b.1 == 0f64) 0f64 else math::INF); 197 } else { 198 assert(b.0 > 0f64); 199 return (0f64, 0f64); 200 }; 201 }; 202 const mod = absc128(a); 203 if (mod == 0f64) { 204 return (0f64, 0f64); 205 }; 206 let r = math::powf64(mod, b.0); 207 const phase = argc128(a); 208 let theta = b.0 * phase; 209 if (b.1 != 0f64) { 210 r *= math::expf64(-b.1 * phase); 211 theta += b.1 * math::logf64(mod); 212 }; 213 return rectc128(r, theta); 214 }; 215 216 // Projects z onto the surface of a Riemann Sphere. If z is finite, it projects 217 // to itself. If z is infinite, it projects to positive infinity on the real 218 // axis. 219 export fn projc64(z: c64) c64 = 220 if (!isinf(c64to128(z))) z else (math::INF, math::copysignf32(0f32, z.1)); 221 222 // Projects z onto the surface of a Riemann Sphere. If z is finite, it projects 223 // to itself. If z is infinite, it projects to positive infinity on the real 224 // axis. 225 export fn projc128(z: c128) c128 = 226 if (!isinf(z)) z else (math::INF, math::copysignf64(0f64, z.1)); 227 228 // Returns the square root of z. 229 export fn sqrtc128(z: c128) c128 = { 230 if (z.1 == 0f64) { 231 if (z.0 == 0f64) { 232 return (0f64, z.1); 233 }; 234 if (z.0 < 0f64) { 235 return (0f64, math::copysignf64(math::sqrtf64(-z.0), z.1)); 236 }; 237 return (math::sqrtf64(z.0), z.1); 238 }; 239 if (math::isinf(z.1)) { 240 return (math::INF, z.1); 241 }; 242 if (z.0 == 0f64) { 243 if (z.1 < 0f64) { 244 const r = math::sqrtf64(-0.5 * z.1); 245 return (r, -r); 246 } else { 247 const r = math::sqrtf64(0.5 * z.1); 248 return (r, r); 249 }; 250 }; 251 let a = z.0, b = z.1; 252 const scale = if (math::absf64(a) > 4f64 || math::absf64(b) > 4f64) { 253 a *= 0.25; 254 b *= 0.25; 255 yield 2f64; 256 } else { 257 a *= 1.8014398509481984e16; // 2**54 258 b *= 1.8014398509481984e16; 259 yield 7.450580596923828125e-9; // 2**-27 260 }; 261 let r = math::hypotf64(a, b); 262 const t = if (a > 0f64) { 263 const t = math::sqrtf64(0.5 * r + 0.5 * a); 264 r = scale * math::absf64(0.5 * b / t); 265 yield t * scale; 266 } else { 267 r = math::sqrtf64(0.5 * r - 0.5 * a); 268 const t = scale * math::absf64(0.5 * b / r); 269 r *= scale; 270 yield t; 271 }; 272 return (t, if (b < 0f64) -r else r); 273 }; 274 275 // Returns the sine of z, in radians. 276 export fn sinc128(z: c128) c128 = { 277 if (z.1 == 0f64 && (math::isinf(z.0) || math::isnan(z.0))) { 278 return (math::NAN, z.1); 279 } else if (math::isinf(z.1)) { 280 if (z.0 == 0f64) { 281 return z; 282 } else if (math::isinf(z.0) || math::isnan(z.0)) { 283 return (math::NAN, z.1); 284 }; 285 } else if (z.0 == 0f64 && math::isnan(z.1)) { 286 return z; 287 }; 288 const shch = sinhcosh(z.1); 289 return (math::sinf64(z.0) * shch.1, math::cosf64(z.0) * shch.0); 290 }; 291 292 // Returns the hyperbolic sine of z. 293 export fn sinhc128(z: c128) c128 = { 294 if (z.0 == 0f64 && (math::isinf(z.1) || math::isnan(z.1))) { 295 return (z.0, math::NAN); 296 } else if (math::isinf(z.0)) { 297 if (z.1 == 0f64) { 298 return z; 299 } else if (math::isinf(z.1) || math::isnan(z.1)) { 300 return (z.0, math::NAN); 301 }; 302 } else if (z.1 == 0f64 && math::isnan(z.0)) { 303 return (math::NAN, z.1); 304 }; 305 const shch = sinhcosh(z.0); 306 return (math::cosf64(z.1) * shch.0, math::sinf64(z.1) * shch.1); 307 }; 308 309 // Returns the arcsine, in radians, of z. 310 export fn asinc128(z: c128) c128 = { 311 if (z.1 == 0f64 && math::absf64(z.0) <= 1f64) { 312 return (math::asinf64(z.0), z.1); 313 } else if (z.0 == 0f64 && math::absf64(z.1) <= 1f64) { 314 return (z.0, math::asinhf64(z.1)); 315 } else if (math::isnan(z.1)) { 316 if (z.0 == 0f64) { 317 return (z.0, math::NAN); 318 } else if (math::isinf(z.0)) { 319 return (math::NAN, z.0); 320 } else { 321 return (math::NAN, math::NAN); 322 }; 323 } else if (math::isinf(z.1)) { 324 if (math::isnan(z.0)) { 325 return z; 326 } else if (math::isinf(z.0)) { 327 return (math::copysignf64(math::PI / 4f64, z.0), z.1); 328 } else { 329 return (math::copysignf64(0f64, z.0), z.1); 330 }; 331 } else if (math::isinf(z.0)) { 332 return (math::copysignf64(math::PI / 2f64, z.0), 333 math::copysignf64(z.0, z.1)); 334 }; 335 const ct = (-z.1, z.0); // i * z 336 const zz = mulc128(z, z); 337 const z1 = (1f64 - zz.0, -zz.1); // 1 - z * z 338 const z2 = sqrtc128(z1); // z2 = sqrt(1 - z * z) 339 const w = logc128(addc128(ct, z2)); 340 return (w.1, -w.0); // -i * w 341 }; 342 343 // Returns the inverse hyperbolic sine of z. 344 export fn asinhc128(z: c128) c128 = { 345 if (z.1 == 0f64 && math::absf64(z.0) <= 1f64) { 346 return (math::asinhf64(z.0), z.1); 347 } else if (z.0 == 0f64 && math::absf64(z.1) <= 1f64) { 348 return (z.0, math::asinf64(z.1)); 349 } else if (math::isinf(z.0)) { 350 if (math::isinf(z.1)) { 351 return (z.0, math::copysignf64(math::PI / 4f64, z.1)); 352 } else if (math::isnan(z.1)) { 353 return z; 354 } else { 355 return (z.0, math::copysignf64(0f64, z.1)); 356 }; 357 } else if (math::isnan(z.0)) { 358 if (z.1 == 0f64) { 359 return z; 360 } else if (math::isinf(z.1)) { 361 return (z.1, z.0); 362 } else { 363 return (math::NAN, math::NAN); 364 }; 365 } else if (math::isinf(z.1)) { 366 return (math::copysignf64(z.1, z.0), 367 math::copysign(math::PI / 2f64, z.1)); 368 }; 369 const zz = mulc128(z, z); 370 const z1 = (1f64 + zz.0, zz.1); // 1 + z * z 371 return logc128(addc128(z, sqrtc128(z1))); // log(x + sqrt(1 + x * x)) 372 }; 373 374 // Returns the cosine of z, in radians. 375 export fn cosc128(z: c128) c128 = { 376 if (z.1 == 0f64 && (math::isinf(z.0) || math::isnan(z.0))) { 377 return (math::NAN, -z.1 * math::copysignf64(0f64, z.0)); 378 } else if (math::isinf(z.1)) { 379 if (z.0 == 0f64) { 380 return (math::INF, -z.0 * math::copysignf64(0f64, z.1)); 381 } else if (math::isinf(z.0) || math::isnan(z.0)) { 382 return (math::INF, math::NAN); 383 }; 384 } else if (z.0 == 0f64 && math::isnan(z.1)) { 385 return (math::NAN, 0f64); 386 }; 387 const shch = sinhcosh(z.1); 388 return (math::cosf64(z.0) * shch.1, -math::sinf64(z.0) * shch.0); 389 }; 390 391 // Returns the hyperbolic cosine of z. 392 export fn coshc128(z: c128) c128 = { 393 if (z.0 == 0f64 && (math::isinf(z.1) || math::isnan(z.1))) { 394 return (math::NAN, z.0 * math::copysignf64(0f64, z.1)); 395 } else if (math::isinf(z.0)) { 396 if (z.1 == 0f64) { 397 return (math::INF, z.1 * math::copysignf64(0f64, z.0)); 398 } else if (math::isinf(z.1) || math::isnan(z.1)) { 399 return (math::INF, math::NAN); 400 }; 401 } else if (z.1 == 0f64 && math::isnan(z.0)) { 402 return (math::NAN, z.1); 403 }; 404 const shch = sinhcosh(z.0); 405 return (math::cosf64(z.1) * shch.1, math::sinf64(z.1) * shch.0); 406 }; 407 408 // Returns the arccosine, in radians, of z. 409 export fn acosc128(z: c128) c128 = { 410 const w = asinc128(z); 411 return (math::PI / 2f64 - w.0, -w.1); 412 }; 413 414 // Returns the inverse hyperbolic cosine of z. 415 export fn acoshc128(z: c128) c128 = { 416 if (z.0 == 0f64 && z.1 == 0f64) { 417 return (0f64, math::copysignf64(math::PI / 2f64, z.1)); 418 }; 419 const w = acosc128(z); 420 if (w.1 <= 0f64) { 421 return (-w.1, w.0); // i * w 422 }; 423 return (w.1, -w.0); // -i * w 424 }; 425 426 fn sinhcosh(x: f64) (f64, f64) = { 427 if (math::absf64(x) <= 0.5) { 428 return (math::sinhf64(x), math::coshf64(x)); 429 }; 430 let e = math::expf64(x); 431 const ei = 0.5 / e; 432 e *= 0.5; 433 return (e - ei, e + ei); 434 }; 435 436 // reducePi reduces the input argument x to the range (-Pi/2, Pi/2]. 437 // x must be greater than or equal to 0. For small arguments it 438 // uses Cody-Waite reduction in 3 f64 parts based on: 439 // "Elementary Function Evaluation: Algorithms and Implementation" 440 // Jean-Michel Muller, 1997. 441 // For very large arguments it uses Payne-Hanek range reduction based on: 442 // "ARGUMENT REDUCTION FOR HUGE ARGUMENTS: Good to the Last Bit" 443 // K. C. Ng et al, March 24, 1992. 444 fn reducePi(x: f64) f64 = { 445 // reduceThreshold is the maximum value of x where the reduction using 446 // Cody-Waite reduction still gives accurate results. This threshold 447 // is set by t*PIn being representable as a f64 without error 448 // where t is given by t = floor(x * (1 / Pi)) and PIn are the leading partial 449 // terms of Pi. Since the leading terms, PI1 and PI2 below, have 30 and 32 450 // trailing zero bits respectively, t should have less than 30 significant bits. 451 // t < 1<<30 -> floor(x*(1/Pi)+0.5) < 1<<30 -> x < (1<<30-1) * Pi - 0.5 452 // So, conservatively we can take x < 1<<30. 453 const reduceThreshold = (1u64 << 30): f64; 454 if (math::absf64(x) < reduceThreshold) { 455 // Use Cody-Waite reduction in three parts. 456 // PI1, PI2 and PI3 comprise an extended precision value of PI 457 // such that PI ~= PI1 + PI2 + PI3. The parts are chosen so 458 // that PI1 and PI2 have an approximately equal number of trailing 459 // zero bits. This ensures that t*PI1 and t*PI2 are exact for 460 // large integer values of t. The full precision PI3 ensures the 461 // approximation of PI is accurate to 102 bits to handle cancellation 462 // during subtraction. 463 const PI1 = 3.141592502593994; // 0x400921fb40000000 464 const PI2 = 1.5099578831723193e-07; // 0x3e84442d00000000 465 const PI3 = 1.0780605716316238e-14; // 0x3d08469898cc5170 466 let t = x / math::PI; 467 t += 0.5; 468 t = (t: i64): f64; 469 return ((x - t*PI1) - t*PI2) - t*PI3; 470 }; 471 // Must apply Payne-Hanek range reduction 472 const mask: u64 = 0x7FF; 473 const shift: u64 = 64 - 11 - 1; 474 const bias: u64 = 1023; 475 const fracMask: u64 = (1u64 << shift) - 1; 476 477 // Extract out the integer and exponent such that, 478 // x = ix * 2 ** exp. 479 let ix: u64 = math::f64bits(x); 480 let exp: u64 = (ix >> shift & mask) - bias - shift; 481 ix &= fracMask; 482 ix |= 1u64 << shift; 483 484 // mPi is the binary digits of 1/Pi as a u64 array, 485 // that is, 1/Pi = Sum mPi[i]*2^(-64*i). 486 // 19 64-bit digits give 1216 bits of precision 487 // to handle the largest possible float64 exponent. 488 let mPi: [_]u64 = [ 489 0x0000000000000000, 490 0x517cc1b727220a94, 491 0xfe13abe8fa9a6ee0, 492 0x6db14acc9e21c820, 493 0xff28b1d5ef5de2b0, 494 0xdb92371d2126e970, 495 0x0324977504e8c90e, 496 0x7f0ef58e5894d39f, 497 0x74411afa975da242, 498 0x74ce38135a2fbf20, 499 0x9cc8eb1cc1a99cfa, 500 0x4e422fc5defc941d, 501 0x8ffc4bffef02cc07, 502 0xf79788c5ad05368f, 503 0xb69b3f6793e584db, 504 0xa7a31fb34f2ff516, 505 0xba93dd63f5f2f8bd, 506 0x9e839cfbc5294975, 507 0x35fdafd88fc6ae84, 508 0x2b0198237e3db5d5, 509 ]; 510 // Use the exponent to extract the 3 appropriate u64 digits from mPi, 511 // B ~ (z0, z1, z2), such that the product leading digit has the exponent -64. 512 // Note, exp >= 50 since x >= reduceThreshold and exp < 971 for maximum f64. 513 let digit: u64 = (exp + 64): u64 / 64; 514 let bitshift: u64 = (exp + 64): u64 % 64; 515 let z0: u64 = (mPi[digit] << bitshift) | (mPi[digit+1] >> (64 - bitshift)); 516 let z1: u64 = (mPi[digit+1] << bitshift) | (mPi[digit+2] >> (64 - bitshift)); 517 let z2: u64 = (mPi[digit+2] << bitshift) | (mPi[digit+3] >> (64 - bitshift)); 518 // Multiply mantissa by the digits and extract the upper two digits (hi, lo). 519 let (z2hi, z2lo) = math::mulu64(z2, ix); 520 let (z1hi, z1lo) = math::mulu64(z1, ix); 521 let z0lo: u64 = z0 * ix; 522 let (lo, c) = math::addu64(z1lo, z2hi, 0); 523 let (hi, _) = math::addu64(z0lo, z1hi, c); 524 // Find the magnitude of the fraction. 525 let lz: u8 = math::leading_zeros_u64(hi); 526 let e: u64 = (bias - (lz + 1)): u64; 527 // Clear implicit mantissa bit and shift into place. 528 hi = (hi << (lz + 1)) | (lo >> (64 - (lz + 1))); 529 hi >>= 64 - shift; 530 // Include the exponent and convert to a float. 531 hi |= e << shift; 532 x = math::f64frombits(hi); 533 // map to (-Pi/2, Pi/2] 534 if (x > 0.5) { 535 x -= 1f64; 536 }; 537 return math::PI * x; 538 }; 539 540 // Taylor series expansion for cosh(2y) - cos(2x) 541 fn tanSeries(z: c128) f64 = { 542 const MACHEP = 1f64/(1u64 << 53): f64; 543 let x = math::absf64(2f64 * z.0); 544 let y = math::absf64(2f64 * z.1); 545 x = reducePi(x); 546 x = x * x; 547 y = y * y; 548 549 let x2 = 1f64; 550 let y2 = 1f64; 551 let f = 1f64; 552 let rn = 0f64; 553 let d = 0f64; 554 555 for (true) { 556 rn += 1f64; 557 f *= rn; 558 rn += 1f64; 559 f *= rn; 560 x2 *= x; 561 y2 *= y; 562 let t = y2 + x2; 563 t /= f; 564 d += t; 565 566 rn += 1f64; 567 f *= rn; 568 rn += 1f64; 569 f *= rn; 570 x2 *= x; 571 y2 *= y; 572 t = y2 - x2; 573 t /= f; 574 d += t; 575 if (!(math::absf64(t/d) > MACHEP)) { 576 // Caution: Use ! and > instead of <= for correct behavior if t/d is NaN. 577 // See issue https://github.com/golang/go/issues/17577. 578 break; 579 }; 580 }; 581 return d; 582 }; 583 584 // Returns the tangent of x. 585 export fn tanc128(x: c128) c128 = { 586 if (math::isinf(x.1)) { 587 if (math::isinf(x.0) || math::isnan(x.0)) { 588 return (math::copysign(0f64, x.0), math::copysign(1f64, x.1)); 589 }; 590 return (math::copysign(0f64, math::sinf64(2f64*x.0)), math::copysign(1f64, x.1)); 591 }; 592 if (x.0 == 0f64 && math::isnan(x.1)) { 593 return x; 594 }; 595 let d = math::cosf64(2f64*x.0) + math::coshf64(2f64*x.1); 596 if (math::absf64(d) < 0.25f64) { 597 d = tanSeries(x); 598 }; 599 if (d == 0f64) { 600 return (math::INF, math::INF); 601 }; 602 return (math::sinf64(2f64*x.0)/d, math::sinhf64(2f64*x.1)/d); 603 }; 604 605 // Returns the hyperbolic tangent of x. 606 export fn tanhc128(x: c128) c128 = { 607 if (math::isinf(x.0)) { 608 if (math::isinf(x.1) || math::isnan(x.1)) { 609 return (math::copysign(1f64, x.0), math::copysign(0f64, x.1)); 610 }; 611 return (math::copysign(1f64, x.0), math::copysign(0f64, math::sinf64(2f64*x.1))); 612 }; 613 if (x.1 == 0f64 && math::isnan(x.0)) { 614 return x; 615 }; 616 let d = math::coshf64(2f64*x.0) + math::cosf64(2f64*x.1); 617 if (d == 0f64) { 618 return (math::INF, math::INF); 619 }; 620 return (math::sinhf64(2f64*x.0)/d, math::sinf64(2f64*x.1)/d); 621 }; 622 623 // Returns the inverse tangent of x. 624 export fn atanc128(x: c128) c128 = { 625 if (x.1 == 0f64) { 626 return (math::atanf64(x.0), x.1); 627 } else if (x.0 == 0f64 && math::absf64(x.1) <= 1f64) { 628 return (x.0, math::atanhf64(x.1)); 629 } else if (math::isinf(x.1) || math::isinf(x.0)) { 630 if (math::isnan(x.0)) { 631 return (math::NAN, math::copysign(0f64, x.1)); 632 }; 633 return (math::copysign(math::PI/2f64, x.0), math::copysign(0f64, x.1)); 634 } else if (math::isnan(x.0) || math::isnan(x.1)) { 635 return (math::NAN, math::NAN); 636 }; 637 let x2 = x.0 * x.0; 638 let a = 1f64 - x2 - x.1 * x.1; 639 if (a == 0f64) { 640 return (math::NAN, math::NAN); 641 }; 642 let t = 0.5f64 * math::atan2f64(2f64*x.0, a); 643 let w = reducePi(t); 644 t = x.1 - 1f64; 645 let b = x2 + t*t; 646 if (b == 0f64) { 647 return (math::NAN, math::NAN); 648 }; 649 t = x.1 + 1f64; 650 let c = (x2 + t*t) / b; 651 return (w, 0.25f64*math::logf64(c)); 652 }; 653 654 // Returns the inverse hyperbolic tangent of x. 655 export fn atanhc128(x: c128) c128 = { 656 let z = (-x.1, x.0); // z = i * x 657 z = atanc128(z); 658 return (z.1, -z.0); // z = -i * z 659 };