beta.c 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178
  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 "mconf.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) double a, b;
  74. {
  75. double y;
  76. int sign;
  77. sign = 1;
  78. if (a <= 0.0) {
  79. if (a == floor(a))
  80. goto over;
  81. }
  82. if (b <= 0.0) {
  83. if (b == floor(b))
  84. goto over;
  85. }
  86. y = a + b;
  87. if (fabs(y) > MAXGAM) {
  88. y = lgam(y);
  89. sign *= sgngam; /* keep track of the sign */
  90. y = lgam(b) - y;
  91. sign *= sgngam;
  92. y = lgam(a) + y;
  93. sign *= sgngam;
  94. if (y > MAXLOG) {
  95. over:
  96. mtherr("beta", OVERFLOW);
  97. return (sign * MAXNUM);
  98. }
  99. return (sign * exp(y));
  100. }
  101. y = gamma(y);
  102. if (y == 0.0)
  103. goto over;
  104. if (a > b) {
  105. y = gamma(a) / y;
  106. y *= gamma(b);
  107. } else {
  108. y = gamma(b) / y;
  109. y *= gamma(a);
  110. }
  111. return (y);
  112. }
  113. /* Natural log of |beta|. Return the sign of beta in sgngam. */
  114. double lbeta(a, b) double a, b;
  115. {
  116. double y;
  117. int sign;
  118. sign = 1;
  119. if (a <= 0.0) {
  120. if (a == floor(a))
  121. goto over;
  122. }
  123. if (b <= 0.0) {
  124. if (b == floor(b))
  125. goto over;
  126. }
  127. y = a + b;
  128. if (fabs(y) > MAXGAM) {
  129. y = lgam(y);
  130. sign *= sgngam; /* keep track of the sign */
  131. y = lgam(b) - y;
  132. sign *= sgngam;
  133. y = lgam(a) + y;
  134. sign *= sgngam;
  135. sgngam = sign;
  136. return (y);
  137. }
  138. y = gamma(y);
  139. if (y == 0.0) {
  140. over:
  141. mtherr("lbeta", OVERFLOW);
  142. return (sign * MAXNUM);
  143. }
  144. if (a > b) {
  145. y = gamma(a) / y;
  146. y *= gamma(b);
  147. } else {
  148. y = gamma(b) / y;
  149. y *= gamma(a);
  150. }
  151. if (y < 0) {
  152. sgngam = -1;
  153. y = -y;
  154. } else
  155. sgngam = 1;
  156. return (log(y));
  157. }