betaf.c 1.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122
  1. /* betaf.c
  2. *
  3. * Beta function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float a, b, y, betaf();
  10. *
  11. * y = betaf( 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. * IEEE 0,30 10000 4.0e-5 6.0e-6
  33. * IEEE -20,0 10000 4.9e-3 5.4e-5
  34. *
  35. * ERROR MESSAGES:
  36. *
  37. * message condition value returned
  38. * betaf 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.2: July, 1992
  45. Copyright 1984, 1987 by Stephen L. Moshier
  46. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  47. */
  48. #include <math.h>
  49. #define fabsf(x) ( (x) < 0 ? -(x) : (x) )
  50. #define MAXGAM 34.84425627277176174
  51. extern float MAXLOGF, MAXNUMF;
  52. extern int sgngamf;
  53. #ifdef ANSIC
  54. float gammaf(float), lgamf(float), expf(float), floorf(float);
  55. #else
  56. float gammaf(), lgamf(), expf(), floorf();
  57. #endif
  58. float betaf( float aa, float bb )
  59. {
  60. float a, b, y;
  61. int sign;
  62. sign = 1;
  63. a = aa;
  64. b = bb;
  65. if( a <= 0.0 )
  66. {
  67. if( a == floorf(a) )
  68. goto over;
  69. }
  70. if( b <= 0.0 )
  71. {
  72. if( b == floorf(b) )
  73. goto over;
  74. }
  75. y = a + b;
  76. if( fabsf(y) > MAXGAM )
  77. {
  78. y = lgamf(y);
  79. sign *= sgngamf; /* keep track of the sign */
  80. y = lgamf(b) - y;
  81. sign *= sgngamf;
  82. y = lgamf(a) + y;
  83. sign *= sgngamf;
  84. if( y > MAXLOGF )
  85. {
  86. over:
  87. mtherr( "betaf", OVERFLOW );
  88. return( sign * MAXNUMF );
  89. }
  90. return( sign * expf(y) );
  91. }
  92. y = gammaf(y);
  93. if( y == 0.0 )
  94. goto over;
  95. if( a > b )
  96. {
  97. y = gammaf(a)/y;
  98. y *= gammaf(b);
  99. }
  100. else
  101. {
  102. y = gammaf(b)/y;
  103. y *= gammaf(a);
  104. }
  105. return(y);
  106. }