bdtrl.c 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260
  1. /* bdtrl.c
  2. *
  3. * Binomial distribution
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * int k, n;
  10. * long double p, y, bdtrl();
  11. *
  12. * y = bdtrl( k, n, p );
  13. *
  14. *
  15. *
  16. * DESCRIPTION:
  17. *
  18. * Returns the sum of the terms 0 through k of the Binomial
  19. * probability density:
  20. *
  21. * k
  22. * -- ( n ) j n-j
  23. * > ( ) p (1-p)
  24. * -- ( j )
  25. * j=0
  26. *
  27. * The terms are not summed directly; instead the incomplete
  28. * beta integral is employed, according to the formula
  29. *
  30. * y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ).
  31. *
  32. * The arguments must be positive, with p ranging from 0 to 1.
  33. *
  34. *
  35. *
  36. * ACCURACY:
  37. *
  38. * Tested at random points (k,n,p) with a and b between 0
  39. * and 10000 and p between 0 and 1.
  40. * Relative error:
  41. * arithmetic domain # trials peak rms
  42. * IEEE 0,10000 3000 1.6e-14 2.2e-15
  43. *
  44. * ERROR MESSAGES:
  45. *
  46. * message condition value returned
  47. * bdtrl domain k < 0 0.0
  48. * n < k
  49. * x < 0, x > 1
  50. *
  51. */
  52. /* bdtrcl()
  53. *
  54. * Complemented binomial distribution
  55. *
  56. *
  57. *
  58. * SYNOPSIS:
  59. *
  60. * int k, n;
  61. * long double p, y, bdtrcl();
  62. *
  63. * y = bdtrcl( k, n, p );
  64. *
  65. *
  66. *
  67. * DESCRIPTION:
  68. *
  69. * Returns the sum of the terms k+1 through n of the Binomial
  70. * probability density:
  71. *
  72. * n
  73. * -- ( n ) j n-j
  74. * > ( ) p (1-p)
  75. * -- ( j )
  76. * j=k+1
  77. *
  78. * The terms are not summed directly; instead the incomplete
  79. * beta integral is employed, according to the formula
  80. *
  81. * y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ).
  82. *
  83. * The arguments must be positive, with p ranging from 0 to 1.
  84. *
  85. *
  86. *
  87. * ACCURACY:
  88. *
  89. * See incbet.c.
  90. *
  91. * ERROR MESSAGES:
  92. *
  93. * message condition value returned
  94. * bdtrcl domain x<0, x>1, n<k 0.0
  95. */
  96. /* bdtril()
  97. *
  98. * Inverse binomial distribution
  99. *
  100. *
  101. *
  102. * SYNOPSIS:
  103. *
  104. * int k, n;
  105. * long double p, y, bdtril();
  106. *
  107. * p = bdtril( k, n, y );
  108. *
  109. *
  110. *
  111. * DESCRIPTION:
  112. *
  113. * Finds the event probability p such that the sum of the
  114. * terms 0 through k of the Binomial probability density
  115. * is equal to the given cumulative probability y.
  116. *
  117. * This is accomplished using the inverse beta integral
  118. * function and the relation
  119. *
  120. * 1 - p = incbi( n-k, k+1, y ).
  121. *
  122. * ACCURACY:
  123. *
  124. * See incbi.c.
  125. * Tested at random k, n between 1 and 10000. The "domain" refers to p:
  126. * Relative error:
  127. * arithmetic domain # trials peak rms
  128. * IEEE 0,1 3500 2.0e-15 8.2e-17
  129. *
  130. * ERROR MESSAGES:
  131. *
  132. * message condition value returned
  133. * bdtril domain k < 0, n <= k 0.0
  134. * x < 0, x > 1
  135. */
  136. /* bdtr() */
  137. /*
  138. Cephes Math Library Release 2.3: March, 1995
  139. Copyright 1984, 1995 by Stephen L. Moshier
  140. */
  141. #include <math.h>
  142. #ifdef ANSIPROT
  143. extern long double incbetl ( long double, long double, long double );
  144. extern long double incbil ( long double, long double, long double );
  145. extern long double powl ( long double, long double );
  146. extern long double expm1l ( long double );
  147. extern long double log1pl ( long double );
  148. #else
  149. long double incbetl(), incbil(), powl(), expm1l(), log1pl();
  150. #endif
  151. long double bdtrcl( k, n, p )
  152. int k, n;
  153. long double p;
  154. {
  155. long double dk, dn;
  156. if( (p < 0.0L) || (p > 1.0L) )
  157. goto domerr;
  158. if( k < 0 )
  159. return( 1.0L );
  160. if( n < k )
  161. {
  162. domerr:
  163. mtherr( "bdtrcl", DOMAIN );
  164. return( 0.0L );
  165. }
  166. if( k == n )
  167. return( 0.0L );
  168. dn = n - k;
  169. if( k == 0 )
  170. {
  171. if( p < .01L )
  172. dk = -expm1l( dn * log1pl(-p) );
  173. else
  174. dk = 1.0L - powl( 1.0L-p, dn );
  175. }
  176. else
  177. {
  178. dk = k + 1;
  179. dk = incbetl( dk, dn, p );
  180. }
  181. return( dk );
  182. }
  183. long double bdtrl( k, n, p )
  184. int k, n;
  185. long double p;
  186. {
  187. long double dk, dn, q;
  188. if( (p < 0.0L) || (p > 1.0L) )
  189. goto domerr;
  190. if( (k < 0) || (n < k) )
  191. {
  192. domerr:
  193. mtherr( "bdtrl", DOMAIN );
  194. return( 0.0L );
  195. }
  196. if( k == n )
  197. return( 1.0L );
  198. q = 1.0L - p;
  199. dn = n - k;
  200. if( k == 0 )
  201. {
  202. dk = powl( q, dn );
  203. }
  204. else
  205. {
  206. dk = k + 1;
  207. dk = incbetl( dn, dk, q );
  208. }
  209. return( dk );
  210. }
  211. long double bdtril( k, n, y )
  212. int k, n;
  213. long double y;
  214. {
  215. long double dk, dn, p;
  216. if( (y < 0.0L) || (y > 1.0L) )
  217. goto domerr;
  218. if( (k < 0) || (n <= k) )
  219. {
  220. domerr:
  221. mtherr( "bdtril", DOMAIN );
  222. return( 0.0L );
  223. }
  224. dn = n - k;
  225. if( k == 0 )
  226. {
  227. if( y > 0.8L )
  228. p = -expm1l( log1pl(y-1.0L) / dn );
  229. else
  230. p = 1.0L - powl( y, 1.0L/dn );
  231. }
  232. else
  233. {
  234. dk = k + 1;
  235. p = incbetl( dn, dk, y );
  236. if( p > 0.5 )
  237. p = incbil( dk, dn, 1.0L-y );
  238. else
  239. p = 1.0 - incbil( dn, dk, y );
  240. }
  241. return( p );
  242. }