unityl.c 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. /* unityl.c
  2. *
  3. * Relative error approximations for function arguments near
  4. * unity.
  5. *
  6. * log1p(x) = log(1+x)
  7. * expm1(x) = exp(x) - 1
  8. * cosm1(x) = cos(x) - 1
  9. *
  10. */
  11. /* log1p(x) = log(1 + x)
  12. * Relative error:
  13. * arithmetic domain # trials peak rms
  14. * IEEE 0.5, 2 30000 1.4e-19 4.1e-20
  15. *
  16. */
  17. #include <math.h>
  18. /* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
  19. * 1/sqrt(2) <= x < sqrt(2)
  20. * Theoretical peak relative error = 2.32e-20
  21. */
  22. static long double LP[] = {
  23. 4.5270000862445199635215E-5L,
  24. 4.9854102823193375972212E-1L,
  25. 6.5787325942061044846969E0L,
  26. 2.9911919328553073277375E1L,
  27. 6.0949667980987787057556E1L,
  28. 5.7112963590585538103336E1L,
  29. 2.0039553499201281259648E1L,
  30. };
  31. static long double LQ[] = {
  32. /* 1.0000000000000000000000E0L,*/
  33. 1.5062909083469192043167E1L,
  34. 8.3047565967967209469434E1L,
  35. 2.2176239823732856465394E2L,
  36. 3.0909872225312059774938E2L,
  37. 2.1642788614495947685003E2L,
  38. 6.0118660497603843919306E1L,
  39. };
  40. #define SQRTH 0.70710678118654752440L
  41. #define SQRT2 1.41421356237309504880L
  42. #ifdef ANSIPROT
  43. extern long double logl ( long double );
  44. extern long double expl ( long double );
  45. extern long double cosl ( long double );
  46. extern long double polevll ( long double, void *, int );
  47. extern long double p1evll ( long double, void *, int );
  48. #else
  49. long double logl(), expl(), cosl(), polevll(), p1evll();
  50. #endif
  51. long double log1pl(x)
  52. long double x;
  53. {
  54. long double z;
  55. z = 1.0L + x;
  56. if( (z < SQRTH) || (z > SQRT2) )
  57. return( logl(z) );
  58. z = x*x;
  59. z = -0.5L * z + x * ( z * polevll( x, LP, 6 ) / p1evll( x, LQ, 6 ) );
  60. return (x + z);
  61. }
  62. /* expm1(x) = exp(x) - 1 */
  63. /* e^x = 1 + 2x P(x^2)/( Q(x^2) - P(x^2) )
  64. * -0.5 <= x <= 0.5
  65. */
  66. static long double EP[3] = {
  67. 1.2617719307481059087798E-4L,
  68. 3.0299440770744196129956E-2L,
  69. 9.9999999999999999991025E-1L,
  70. };
  71. static long double EQ[4] = {
  72. 3.0019850513866445504159E-6L,
  73. 2.5244834034968410419224E-3L,
  74. 2.2726554820815502876593E-1L,
  75. 2.0000000000000000000897E0L,
  76. };
  77. long double expm1l(x)
  78. long double x;
  79. {
  80. long double r, xx;
  81. if( (x < -0.5L) || (x > 0.5L) )
  82. return( expl(x) - 1.0L );
  83. xx = x * x;
  84. r = x * polevll( xx, EP, 2 );
  85. r = r/( polevll( xx, EQ, 3 ) - r );
  86. return (r + r);
  87. }
  88. /* cosm1(x) = cos(x) - 1 */
  89. static long double coscof[7] = {
  90. 4.7377507964246204691685E-14L,
  91. -1.1470284843425359765671E-11L,
  92. 2.0876754287081521758361E-9L,
  93. -2.7557319214999787979814E-7L,
  94. 2.4801587301570552304991E-5L,
  95. -1.3888888888888872993737E-3L,
  96. 4.1666666666666666609054E-2L,
  97. };
  98. extern long double PIO4L;
  99. long double cosm1l(x)
  100. long double x;
  101. {
  102. long double xx;
  103. if( (x < -PIO4L) || (x > PIO4L) )
  104. return( cosl(x) - 1.0L );
  105. xx = x * x;
  106. xx = -0.5L*xx + xx * xx * polevll( xx, coscof, 6 );
  107. return xx;
  108. }