psif.c 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. /* psif.c
  2. *
  3. * Psi (digamma) function
  4. *
  5. *
  6. * SYNOPSIS:
  7. *
  8. * float x, y, psif();
  9. *
  10. * y = psif( x );
  11. *
  12. *
  13. * DESCRIPTION:
  14. *
  15. * d -
  16. * psi(x) = -- ln | (x)
  17. * dx
  18. *
  19. * is the logarithmic derivative of the gamma function.
  20. * For integer x,
  21. * n-1
  22. * -
  23. * psi(n) = -EUL + > 1/k.
  24. * -
  25. * k=1
  26. *
  27. * This formula is used for 0 < n <= 10. If x is negative, it
  28. * is transformed to a positive argument by the reflection
  29. * formula psi(1-x) = psi(x) + pi cot(pi x).
  30. * For general positive x, the argument is made greater than 10
  31. * using the recurrence psi(x+1) = psi(x) + 1/x.
  32. * Then the following asymptotic expansion is applied:
  33. *
  34. * inf. B
  35. * - 2k
  36. * psi(x) = log(x) - 1/2x - > -------
  37. * - 2k
  38. * k=1 2k x
  39. *
  40. * where the B2k are Bernoulli numbers.
  41. *
  42. * ACCURACY:
  43. * Absolute error, relative when |psi| > 1 :
  44. * arithmetic domain # trials peak rms
  45. * IEEE -33,0 30000 8.2e-7 1.2e-7
  46. * IEEE 0,33 100000 7.3e-7 7.7e-8
  47. *
  48. * ERROR MESSAGES:
  49. * message condition value returned
  50. * psi singularity x integer <=0 MAXNUMF
  51. */
  52. /*
  53. Cephes Math Library Release 2.2: June, 1992
  54. Copyright 1984, 1987, 1992 by Stephen L. Moshier
  55. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  56. */
  57. #include <math.h>
  58. static float A[] = {
  59. -4.16666666666666666667E-3,
  60. 3.96825396825396825397E-3,
  61. -8.33333333333333333333E-3,
  62. 8.33333333333333333333E-2
  63. };
  64. #define EUL 0.57721566490153286061
  65. extern float PIF, MAXNUMF;
  66. float floorf(float), logf(float), tanf(float);
  67. float polevlf(float, float *, int);
  68. float psif(float xx)
  69. {
  70. float p, q, nz, x, s, w, y, z;
  71. int i, n, negative;
  72. x = xx;
  73. nz = 0.0;
  74. negative = 0;
  75. if( x <= 0.0 )
  76. {
  77. negative = 1;
  78. q = x;
  79. p = floorf(q);
  80. if( p == q )
  81. {
  82. mtherr( "psif", SING );
  83. return( MAXNUMF );
  84. }
  85. nz = q - p;
  86. if( nz != 0.5 )
  87. {
  88. if( nz > 0.5 )
  89. {
  90. p += 1.0;
  91. nz = q - p;
  92. }
  93. nz = PIF/tanf(PIF*nz);
  94. }
  95. else
  96. {
  97. nz = 0.0;
  98. }
  99. x = 1.0 - x;
  100. }
  101. /* check for positive integer up to 10 */
  102. if( (x <= 10.0) && (x == floorf(x)) )
  103. {
  104. y = 0.0;
  105. n = x;
  106. for( i=1; i<n; i++ )
  107. {
  108. w = i;
  109. y += 1.0/w;
  110. }
  111. y -= EUL;
  112. goto done;
  113. }
  114. s = x;
  115. w = 0.0;
  116. while( s < 10.0 )
  117. {
  118. w += 1.0/s;
  119. s += 1.0;
  120. }
  121. if( s < 1.0e8 )
  122. {
  123. z = 1.0/(s * s);
  124. y = z * polevlf( z, A, 3 );
  125. }
  126. else
  127. y = 0.0;
  128. y = logf(s) - (0.5/s) - y - w;
  129. done:
  130. if( negative )
  131. {
  132. y -= nz;
  133. }
  134. return(y);
  135. }