stdtr.c 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
  1. /* stdtr.c
  2. *
  3. * Student's t distribution
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double t, stdtr();
  10. * short k;
  11. *
  12. * y = stdtr( k, t );
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Computes the integral from minus infinity to t of the Student
  18. * t distribution with integer k > 0 degrees of freedom:
  19. *
  20. * t
  21. * -
  22. * | |
  23. * - | 2 -(k+1)/2
  24. * | ( (k+1)/2 ) | ( x )
  25. * ---------------------- | ( 1 + --- ) dx
  26. * - | ( k )
  27. * sqrt( k pi ) | ( k/2 ) |
  28. * | |
  29. * -
  30. * -inf.
  31. *
  32. * Relation to incomplete beta integral:
  33. *
  34. * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z )
  35. * where
  36. * z = k/(k + t**2).
  37. *
  38. * For t < -2, this is the method of computation. For higher t,
  39. * a direct method is derived from integration by parts.
  40. * Since the function is symmetric about t=0, the area under the
  41. * right tail of the density is found by calling the function
  42. * with -t instead of t.
  43. *
  44. * ACCURACY:
  45. *
  46. * Tested at random 1 <= k <= 25. The "domain" refers to t.
  47. * Relative error:
  48. * arithmetic domain # trials peak rms
  49. * IEEE -100,-2 50000 5.9e-15 1.4e-15
  50. * IEEE -2,100 500000 2.7e-15 4.9e-17
  51. */
  52. /* stdtri.c
  53. *
  54. * Functional inverse of Student's t distribution
  55. *
  56. *
  57. *
  58. * SYNOPSIS:
  59. *
  60. * double p, t, stdtri();
  61. * int k;
  62. *
  63. * t = stdtri( k, p );
  64. *
  65. *
  66. * DESCRIPTION:
  67. *
  68. * Given probability p, finds the argument t such that stdtr(k,t)
  69. * is equal to p.
  70. *
  71. * ACCURACY:
  72. *
  73. * Tested at random 1 <= k <= 100. The "domain" refers to p:
  74. * Relative error:
  75. * arithmetic domain # trials peak rms
  76. * IEEE .001,.999 25000 5.7e-15 8.0e-16
  77. * IEEE 10^-6,.001 25000 2.0e-12 2.9e-14
  78. */
  79. /*
  80. Cephes Math Library Release 2.8: June, 2000
  81. Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
  82. */
  83. #include "mconf.h"
  84. extern double PI, MACHEP, MAXNUM;
  85. #ifdef ANSIPROT
  86. extern double sqrt(double);
  87. extern double atan(double);
  88. extern double incbet(double, double, double);
  89. extern double incbi(double, double, double);
  90. extern double fabs(double);
  91. #else
  92. double sqrt(), atan(), incbet(), incbi(), fabs();
  93. #endif
  94. double stdtr(k, t) int k;
  95. double t;
  96. {
  97. double x, rk, z, f, tz, p, xsqk;
  98. int j;
  99. if (k <= 0) {
  100. mtherr("stdtr", DOMAIN);
  101. return (0.0);
  102. }
  103. if (t == 0)
  104. return (0.5);
  105. if (t < -2.0) {
  106. rk = k;
  107. z = rk / (rk + t * t);
  108. p = 0.5 * incbet(0.5 * rk, 0.5, z);
  109. return (p);
  110. }
  111. /* compute integral from -t to + t */
  112. if (t < 0)
  113. x = -t;
  114. else
  115. x = t;
  116. rk = k; /* degrees of freedom */
  117. z = 1.0 + (x * x) / rk;
  118. /* test if k is odd or even */
  119. if ((k & 1) != 0) {
  120. /* computation for odd k */
  121. xsqk = x / sqrt(rk);
  122. p = atan(xsqk);
  123. if (k > 1) {
  124. f = 1.0;
  125. tz = 1.0;
  126. j = 3;
  127. while ((j <= (k - 2)) && ((tz / f) > MACHEP)) {
  128. tz *= (j - 1) / (z * j);
  129. f += tz;
  130. j += 2;
  131. }
  132. p += f * xsqk / z;
  133. }
  134. p *= 2.0 / PI;
  135. }
  136. else {
  137. /* computation for even k */
  138. f = 1.0;
  139. tz = 1.0;
  140. j = 2;
  141. while ((j <= (k - 2)) && ((tz / f) > MACHEP)) {
  142. tz *= (j - 1) / (z * j);
  143. f += tz;
  144. j += 2;
  145. }
  146. p = f * x / sqrt(z * rk);
  147. }
  148. /* common exit */
  149. if (t < 0)
  150. p = -p; /* note destruction of relative accuracy */
  151. p = 0.5 + 0.5 * p;
  152. return (p);
  153. }
  154. double stdtri(k, p) int k;
  155. double p;
  156. {
  157. double t, rk, z;
  158. int rflg;
  159. if (k <= 0 || p <= 0.0 || p >= 1.0) {
  160. mtherr("stdtri", DOMAIN);
  161. return (0.0);
  162. }
  163. rk = k;
  164. if (p > 0.25 && p < 0.75) {
  165. if (p == 0.5)
  166. return (0.0);
  167. z = 1.0 - 2.0 * p;
  168. z = incbi(0.5, 0.5 * rk, fabs(z));
  169. t = sqrt(rk * z / (1.0 - z));
  170. if (p < 0.5)
  171. t = -t;
  172. return (t);
  173. }
  174. rflg = -1;
  175. if (p >= 0.5) {
  176. p = 1.0 - p;
  177. rflg = 1;
  178. }
  179. z = incbi(0.5 * rk, 0.5, 2.0 * p);
  180. if (MAXNUM * z < rk)
  181. return (rflg * MAXNUM);
  182. t = sqrt(rk / z - rk);
  183. return (rflg * t);
  184. }