igamf.c 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223
  1. /* igamf.c
  2. *
  3. * Incomplete gamma integral
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float a, x, y, igamf();
  10. *
  11. * y = igamf( a, x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * The function is defined by
  18. *
  19. * x
  20. * -
  21. * 1 | | -t a-1
  22. * igam(a,x) = ----- | e t dt.
  23. * - | |
  24. * | (a) -
  25. * 0
  26. *
  27. *
  28. * In this implementation both arguments must be positive.
  29. * The integral is evaluated by either a power series or
  30. * continued fraction expansion, depending on the relative
  31. * values of a and x.
  32. *
  33. *
  34. *
  35. * ACCURACY:
  36. *
  37. * Relative error:
  38. * arithmetic domain # trials peak rms
  39. * IEEE 0,30 20000 7.8e-6 5.9e-7
  40. *
  41. */
  42. /* igamcf()
  43. *
  44. * Complemented incomplete gamma integral
  45. *
  46. *
  47. *
  48. * SYNOPSIS:
  49. *
  50. * float a, x, y, igamcf();
  51. *
  52. * y = igamcf( a, x );
  53. *
  54. *
  55. *
  56. * DESCRIPTION:
  57. *
  58. * The function is defined by
  59. *
  60. *
  61. * igamc(a,x) = 1 - igam(a,x)
  62. *
  63. * inf.
  64. * -
  65. * 1 | | -t a-1
  66. * = ----- | e t dt.
  67. * - | |
  68. * | (a) -
  69. * x
  70. *
  71. *
  72. * In this implementation both arguments must be positive.
  73. * The integral is evaluated by either a power series or
  74. * continued fraction expansion, depending on the relative
  75. * values of a and x.
  76. *
  77. *
  78. *
  79. * ACCURACY:
  80. *
  81. * Relative error:
  82. * arithmetic domain # trials peak rms
  83. * IEEE 0,30 30000 7.8e-6 5.9e-7
  84. *
  85. */
  86. /*
  87. Cephes Math Library Release 2.2: June, 1992
  88. Copyright 1985, 1987, 1992 by Stephen L. Moshier
  89. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  90. */
  91. #include <math.h>
  92. /* BIG = 1/MACHEPF */
  93. #define BIG 16777216.
  94. extern float MACHEPF, MAXLOGF;
  95. #ifdef ANSIC
  96. float lgamf(float), expf(float), logf(float), igamf(float, float);
  97. #else
  98. float lgamf(), expf(), logf(), igamf();
  99. #endif
  100. #define fabsf(x) ( (x) < 0 ? -(x) : (x) )
  101. float igamcf( float aa, float xx )
  102. {
  103. float a, x, ans, c, yc, ax, y, z;
  104. float pk, pkm1, pkm2, qk, qkm1, qkm2;
  105. float r, t;
  106. static float big = BIG;
  107. a = aa;
  108. x = xx;
  109. if( (x <= 0) || ( a <= 0) )
  110. return( 1.0 );
  111. if( (x < 1.0) || (x < a) )
  112. return( 1.0 - igamf(a,x) );
  113. ax = a * logf(x) - x - lgamf(a);
  114. if( ax < -MAXLOGF )
  115. {
  116. mtherr( "igamcf", UNDERFLOW );
  117. return( 0.0 );
  118. }
  119. ax = expf(ax);
  120. /* continued fraction */
  121. y = 1.0 - a;
  122. z = x + y + 1.0;
  123. c = 0.0;
  124. pkm2 = 1.0;
  125. qkm2 = x;
  126. pkm1 = x + 1.0;
  127. qkm1 = z * x;
  128. ans = pkm1/qkm1;
  129. do
  130. {
  131. c += 1.0;
  132. y += 1.0;
  133. z += 2.0;
  134. yc = y * c;
  135. pk = pkm1 * z - pkm2 * yc;
  136. qk = qkm1 * z - qkm2 * yc;
  137. if( qk != 0 )
  138. {
  139. r = pk/qk;
  140. t = fabsf( (ans - r)/r );
  141. ans = r;
  142. }
  143. else
  144. t = 1.0;
  145. pkm2 = pkm1;
  146. pkm1 = pk;
  147. qkm2 = qkm1;
  148. qkm1 = qk;
  149. if( fabsf(pk) > big )
  150. {
  151. pkm2 *= MACHEPF;
  152. pkm1 *= MACHEPF;
  153. qkm2 *= MACHEPF;
  154. qkm1 *= MACHEPF;
  155. }
  156. }
  157. while( t > MACHEPF );
  158. return( ans * ax );
  159. }
  160. /* left tail of incomplete gamma function:
  161. *
  162. * inf. k
  163. * a -x - x
  164. * x e > ----------
  165. * - -
  166. * k=0 | (a+k+1)
  167. *
  168. */
  169. float igamf( float aa, float xx )
  170. {
  171. float a, x, ans, ax, c, r;
  172. a = aa;
  173. x = xx;
  174. if( (x <= 0) || ( a <= 0) )
  175. return( 0.0 );
  176. if( (x > 1.0) && (x > a ) )
  177. return( 1.0 - igamcf(a,x) );
  178. /* Compute x**a * exp(-x) / gamma(a) */
  179. ax = a * logf(x) - x - lgamf(a);
  180. if( ax < -MAXLOGF )
  181. {
  182. mtherr( "igamf", UNDERFLOW );
  183. return( 0.0 );
  184. }
  185. ax = expf(ax);
  186. /* power series */
  187. r = a;
  188. c = 1.0;
  189. ans = 1.0;
  190. do
  191. {
  192. r += 1.0;
  193. c *= x/r;
  194. ans += c;
  195. }
  196. while( c/ans > MACHEPF );
  197. return( ans * ax/a );
  198. }