fdtrl.c 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237
  1. /* fdtrl.c
  2. *
  3. * F distribution, long double precision
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * int df1, df2;
  10. * long double x, y, fdtrl();
  11. *
  12. * y = fdtrl( df1, df2, x );
  13. *
  14. *
  15. *
  16. * DESCRIPTION:
  17. *
  18. * Returns the area from zero to x under the F density
  19. * function (also known as Snedcor's density or the
  20. * variance ratio density). This is the density
  21. * of x = (u1/df1)/(u2/df2), where u1 and u2 are random
  22. * variables having Chi square distributions with df1
  23. * and df2 degrees of freedom, respectively.
  24. *
  25. * The incomplete beta integral is used, according to the
  26. * formula
  27. *
  28. * P(x) = incbetl( df1/2, df2/2, (df1*x/(df2 + df1*x) ).
  29. *
  30. *
  31. * The arguments a and b are greater than zero, and x
  32. * x is nonnegative.
  33. *
  34. * ACCURACY:
  35. *
  36. * Tested at random points (a,b,x) in the indicated intervals.
  37. * x a,b Relative error:
  38. * arithmetic domain domain # trials peak rms
  39. * IEEE 0,1 1,100 10000 9.3e-18 2.9e-19
  40. * IEEE 0,1 1,10000 10000 1.9e-14 2.9e-15
  41. * IEEE 1,5 1,10000 10000 5.8e-15 1.4e-16
  42. *
  43. * ERROR MESSAGES:
  44. *
  45. * message condition value returned
  46. * fdtrl domain a<0, b<0, x<0 0.0
  47. *
  48. */
  49. /* fdtrcl()
  50. *
  51. * Complemented F distribution
  52. *
  53. *
  54. *
  55. * SYNOPSIS:
  56. *
  57. * int df1, df2;
  58. * long double x, y, fdtrcl();
  59. *
  60. * y = fdtrcl( df1, df2, x );
  61. *
  62. *
  63. *
  64. * DESCRIPTION:
  65. *
  66. * Returns the area from x to infinity under the F density
  67. * function (also known as Snedcor's density or the
  68. * variance ratio density).
  69. *
  70. *
  71. * inf.
  72. * -
  73. * 1 | | a-1 b-1
  74. * 1-P(x) = ------ | t (1-t) dt
  75. * B(a,b) | |
  76. * -
  77. * x
  78. *
  79. * (See fdtr.c.)
  80. *
  81. * The incomplete beta integral is used, according to the
  82. * formula
  83. *
  84. * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ).
  85. *
  86. *
  87. * ACCURACY:
  88. *
  89. * See incbet.c.
  90. * Tested at random points (a,b,x).
  91. *
  92. * x a,b Relative error:
  93. * arithmetic domain domain # trials peak rms
  94. * IEEE 0,1 0,100 10000 4.2e-18 3.3e-19
  95. * IEEE 0,1 1,10000 10000 7.2e-15 2.6e-16
  96. * IEEE 1,5 1,10000 10000 1.7e-14 3.0e-15
  97. *
  98. * ERROR MESSAGES:
  99. *
  100. * message condition value returned
  101. * fdtrcl domain a<0, b<0, x<0 0.0
  102. *
  103. */
  104. /* fdtril()
  105. *
  106. * Inverse of complemented F distribution
  107. *
  108. *
  109. *
  110. * SYNOPSIS:
  111. *
  112. * int df1, df2;
  113. * long double x, p, fdtril();
  114. *
  115. * x = fdtril( df1, df2, p );
  116. *
  117. * DESCRIPTION:
  118. *
  119. * Finds the F density argument x such that the integral
  120. * from x to infinity of the F density is equal to the
  121. * given probability p.
  122. *
  123. * This is accomplished using the inverse beta integral
  124. * function and the relations
  125. *
  126. * z = incbi( df2/2, df1/2, p )
  127. * x = df2 (1-z) / (df1 z).
  128. *
  129. * Note: the following relations hold for the inverse of
  130. * the uncomplemented F distribution:
  131. *
  132. * z = incbi( df1/2, df2/2, p )
  133. * x = df2 z / (df1 (1-z)).
  134. *
  135. * ACCURACY:
  136. *
  137. * See incbi.c.
  138. * Tested at random points (a,b,p).
  139. *
  140. * a,b Relative error:
  141. * arithmetic domain # trials peak rms
  142. * For p between .001 and 1:
  143. * IEEE 1,100 40000 4.6e-18 2.7e-19
  144. * IEEE 1,10000 30000 1.7e-14 1.4e-16
  145. * For p between 10^-6 and .001:
  146. * IEEE 1,100 20000 1.9e-15 3.9e-17
  147. * IEEE 1,10000 30000 2.7e-15 4.0e-17
  148. *
  149. * ERROR MESSAGES:
  150. *
  151. * message condition value returned
  152. * fdtril domain p <= 0 or p > 1 0.0
  153. * v < 1
  154. */
  155. /*
  156. Cephes Math Library Release 2.3: March, 1995
  157. Copyright 1984, 1995 by Stephen L. Moshier
  158. */
  159. #include <math.h>
  160. #ifdef ANSIPROT
  161. extern long double incbetl ( long double, long double, long double );
  162. extern long double incbil ( long double, long double, long double );
  163. #else
  164. long double incbetl(), incbil();
  165. #endif
  166. long double fdtrcl( ia, ib, x )
  167. int ia, ib;
  168. long double x;
  169. {
  170. long double a, b, w;
  171. if( (ia < 1) || (ib < 1) || (x < 0.0L) )
  172. {
  173. mtherr( "fdtrcl", DOMAIN );
  174. return( 0.0L );
  175. }
  176. a = ia;
  177. b = ib;
  178. w = b / (b + a * x);
  179. return( incbetl( 0.5L*b, 0.5L*a, w ) );
  180. }
  181. long double fdtrl( ia, ib, x )
  182. int ia, ib;
  183. long double x;
  184. {
  185. long double a, b, w;
  186. if( (ia < 1) || (ib < 1) || (x < 0.0L) )
  187. {
  188. mtherr( "fdtrl", DOMAIN );
  189. return( 0.0L );
  190. }
  191. a = ia;
  192. b = ib;
  193. w = a * x;
  194. w = w / (b + w);
  195. return( incbetl(0.5L*a, 0.5L*b, w) );
  196. }
  197. long double fdtril( ia, ib, y )
  198. int ia, ib;
  199. long double y;
  200. {
  201. long double a, b, w, x;
  202. if( (ia < 1) || (ib < 1) || (y <= 0.0L) || (y > 1.0L) )
  203. {
  204. mtherr( "fdtril", DOMAIN );
  205. return( 0.0L );
  206. }
  207. a = ia;
  208. b = ib;
  209. /* Compute probability for x = 0.5. */
  210. w = incbetl( 0.5L*b, 0.5L*a, 0.5L );
  211. /* If that is greater than y, then the solution w < .5.
  212. Otherwise, solve at 1-y to remove cancellation in (b - b*w). */
  213. if( w > y || y < 0.001L)
  214. {
  215. w = incbil( 0.5L*b, 0.5L*a, y );
  216. x = (b - b*w)/(a*w);
  217. }
  218. else
  219. {
  220. w = incbil( 0.5L*a, 0.5L*b, 1.0L - y );
  221. x = b*w/(a*(1.0L-w));
  222. }
  223. return(x);
  224. }