beta.c 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201
  1. /* beta.c
  2. *
  3. * Beta function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double a, b, y, beta();
  10. *
  11. * y = beta( a, b );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * - -
  18. * | (a) | (b)
  19. * beta( a, b ) = -----------.
  20. * -
  21. * | (a+b)
  22. *
  23. * For large arguments the logarithm of the function is
  24. * evaluated using lgam(), then exponentiated.
  25. *
  26. *
  27. *
  28. * ACCURACY:
  29. *
  30. * Relative error:
  31. * arithmetic domain # trials peak rms
  32. * DEC 0,30 1700 7.7e-15 1.5e-15
  33. * IEEE 0,30 30000 8.1e-14 1.1e-14
  34. *
  35. * ERROR MESSAGES:
  36. *
  37. * message condition value returned
  38. * beta overflow log(beta) > MAXLOG 0.0
  39. * a or b <0 integer 0.0
  40. *
  41. */
  42. /* beta.c */
  43. /*
  44. Cephes Math Library Release 2.0: April, 1987
  45. Copyright 1984, 1987 by Stephen L. Moshier
  46. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  47. */
  48. #include <math.h>
  49. #ifdef UNK
  50. #define MAXGAM 34.84425627277176174
  51. #endif
  52. #ifdef DEC
  53. #define MAXGAM 34.84425627277176174
  54. #endif
  55. #ifdef IBMPC
  56. #define MAXGAM 171.624376956302725
  57. #endif
  58. #ifdef MIEEE
  59. #define MAXGAM 171.624376956302725
  60. #endif
  61. #ifdef ANSIPROT
  62. extern double fabs ( double );
  63. extern double gamma ( double );
  64. extern double lgam ( double );
  65. extern double exp ( double );
  66. extern double log ( double );
  67. extern double floor ( double );
  68. #else
  69. double fabs(), gamma(), lgam(), exp(), log(), floor();
  70. #endif
  71. extern double MAXLOG, MAXNUM;
  72. extern int sgngam;
  73. double beta( a, b )
  74. double a, b;
  75. {
  76. double y;
  77. int sign;
  78. sign = 1;
  79. if( a <= 0.0 )
  80. {
  81. if( a == floor(a) )
  82. goto over;
  83. }
  84. if( b <= 0.0 )
  85. {
  86. if( b == floor(b) )
  87. goto over;
  88. }
  89. y = a + b;
  90. if( fabs(y) > MAXGAM )
  91. {
  92. y = lgam(y);
  93. sign *= sgngam; /* keep track of the sign */
  94. y = lgam(b) - y;
  95. sign *= sgngam;
  96. y = lgam(a) + y;
  97. sign *= sgngam;
  98. if( y > MAXLOG )
  99. {
  100. over:
  101. mtherr( "beta", OVERFLOW );
  102. return( sign * MAXNUM );
  103. }
  104. return( sign * exp(y) );
  105. }
  106. y = gamma(y);
  107. if( y == 0.0 )
  108. goto over;
  109. if( a > b )
  110. {
  111. y = gamma(a)/y;
  112. y *= gamma(b);
  113. }
  114. else
  115. {
  116. y = gamma(b)/y;
  117. y *= gamma(a);
  118. }
  119. return(y);
  120. }
  121. /* Natural log of |beta|. Return the sign of beta in sgngam. */
  122. double lbeta( a, b )
  123. double a, b;
  124. {
  125. double y;
  126. int sign;
  127. sign = 1;
  128. if( a <= 0.0 )
  129. {
  130. if( a == floor(a) )
  131. goto over;
  132. }
  133. if( b <= 0.0 )
  134. {
  135. if( b == floor(b) )
  136. goto over;
  137. }
  138. y = a + b;
  139. if( fabs(y) > MAXGAM )
  140. {
  141. y = lgam(y);
  142. sign *= sgngam; /* keep track of the sign */
  143. y = lgam(b) - y;
  144. sign *= sgngam;
  145. y = lgam(a) + y;
  146. sign *= sgngam;
  147. sgngam = sign;
  148. return( y );
  149. }
  150. y = gamma(y);
  151. if( y == 0.0 )
  152. {
  153. over:
  154. mtherr( "lbeta", OVERFLOW );
  155. return( sign * MAXNUM );
  156. }
  157. if( a > b )
  158. {
  159. y = gamma(a)/y;
  160. y *= gamma(b);
  161. }
  162. else
  163. {
  164. y = gamma(b)/y;
  165. y *= gamma(a);
  166. }
  167. if( y < 0 )
  168. {
  169. sgngam = -1;
  170. y = -y;
  171. }
  172. else
  173. sgngam = 1;
  174. return( log(y) );
  175. }