ndtri.c 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317
  1. /* ndtri.c
  2. *
  3. * Inverse of Normal distribution function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, ndtri();
  10. *
  11. * x = ndtri( y );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns the argument, x, for which the area under the
  18. * Gaussian probability density function (integrated from
  19. * minus infinity to x) is equal to y.
  20. *
  21. *
  22. * For small arguments 0 < y < exp(-2), the program computes
  23. * z = sqrt( -2.0 * log(y) ); then the approximation is
  24. * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z).
  25. * There are two rational functions P/Q, one for 0 < y < exp(-32)
  26. * and the other for y up to exp(-2). For larger arguments,
  27. * w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)).
  28. *
  29. *
  30. * ACCURACY:
  31. *
  32. * Relative error:
  33. * arithmetic domain # trials peak rms
  34. * DEC 0.125, 1 5500 9.5e-17 2.1e-17
  35. * DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17
  36. * IEEE 0.125, 1 20000 7.2e-16 1.3e-16
  37. * IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17
  38. *
  39. *
  40. * ERROR MESSAGES:
  41. *
  42. * message condition value returned
  43. * ndtri domain x <= 0 -MAXNUM
  44. * ndtri domain x >= 1 MAXNUM
  45. *
  46. */
  47. /*
  48. Cephes Math Library Release 2.8: June, 2000
  49. Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
  50. */
  51. #include "mconf.h"
  52. extern double MAXNUM;
  53. #ifdef UNK
  54. /* sqrt(2pi) */
  55. static double s2pi = 2.50662827463100050242E0;
  56. #endif
  57. #ifdef DEC
  58. static unsigned short s2p[] = {0040440, 0066230, 0177661, 0034055};
  59. #define s2pi *(double *)s2p
  60. #endif
  61. #ifdef IBMPC
  62. static unsigned short s2p[] = {0x2706, 0x1ff6, 0x0d93, 0x4004};
  63. #define s2pi *(double *)s2p
  64. #endif
  65. #ifdef MIEEE
  66. static unsigned short s2p[] = {0x4004, 0x0d93, 0x1ff6, 0x2706};
  67. #define s2pi *(double *)s2p
  68. #endif
  69. /* approximation for 0 <= |y - 0.5| <= 3/8 */
  70. #ifdef UNK
  71. static double P0[5] = {
  72. -5.99633501014107895267E1, 9.80010754185999661536E1,
  73. -5.66762857469070293439E1, 1.39312609387279679503E1,
  74. -1.23916583867381258016E0,
  75. };
  76. static double Q0[8] = {
  77. /* 1.00000000000000000000E0,*/
  78. 1.95448858338141759834E0, 4.67627912898881538453E0,
  79. 8.63602421390890590575E1, -2.25462687854119370527E2,
  80. 2.00260212380060660359E2, -8.20372256168333339912E1,
  81. 1.59056225126211695515E1, -1.18331621121330003142E0,
  82. };
  83. #endif
  84. #ifdef DEC
  85. static unsigned short P0[20] = {
  86. 0141557, 0155170, 0071360, 0120550, 0041704, 0000214, 0172417,
  87. 0067307, 0141542, 0132204, 0040066, 0156723, 0041136, 0163161,
  88. 0157276, 0007747, 0140236, 0116374, 0073666, 0051764,
  89. };
  90. static unsigned short Q0[32] = {
  91. /*0040200,0000000,0000000,0000000,*/
  92. 0040372, 0026256, 0110403, 0123707, 0040625, 0122024, 0020277, 0026661,
  93. 0041654, 0134161, 0124134, 0007244, 0142141, 0073162, 0133021, 0131371,
  94. 0042110, 0041235, 0043516, 0057767, 0141644, 0011417, 0036155, 0137305,
  95. 0041176, 0076556, 0004043, 0125430, 0140227, 0073347, 0152776, 0067251,
  96. };
  97. #endif
  98. #ifdef IBMPC
  99. static unsigned short P0[20] = {
  100. 0x142d, 0x0e5e, 0xfb4f, 0xc04d, 0xedd9, 0x9ea1, 0x8011,
  101. 0x4058, 0xdbba, 0x8806, 0x5690, 0xc04c, 0xc1fd, 0x3bd7,
  102. 0xdcce, 0x402b, 0xca7e, 0x8ef6, 0xd39f, 0xbff3,
  103. };
  104. static unsigned short Q0[36] = {
  105. /*0x0000,0x0000,0x0000,0x3ff0,*/
  106. 0x74f9, 0xd220, 0x4595, 0x3fff, 0xe5b6, 0x8417, 0xb482, 0x4012,
  107. 0x81d4, 0x350b, 0x970e, 0x4055, 0x365f, 0x56c2, 0x2ece, 0xc06c,
  108. 0xcbff, 0xa8e9, 0x0853, 0x4069, 0xb7d9, 0xe78d, 0x8261, 0xc054,
  109. 0x7563, 0xc104, 0xcfad, 0x402f, 0xcdd5, 0xfabf, 0xeedc, 0xbff2,
  110. };
  111. #endif
  112. #ifdef MIEEE
  113. static unsigned short P0[20] = {
  114. 0xc04d, 0xfb4f, 0x0e5e, 0x142d, 0x4058, 0x8011, 0x9ea1,
  115. 0xedd9, 0xc04c, 0x5690, 0x8806, 0xdbba, 0x402b, 0xdcce,
  116. 0x3bd7, 0xc1fd, 0xbff3, 0xd39f, 0x8ef6, 0xca7e,
  117. };
  118. static unsigned short Q0[32] = {
  119. /*0x3ff0,0x0000,0x0000,0x0000,*/
  120. 0x3fff, 0x4595, 0xd220, 0x74f9, 0x4012, 0xb482, 0x8417, 0xe5b6,
  121. 0x4055, 0x970e, 0x350b, 0x81d4, 0xc06c, 0x2ece, 0x56c2, 0x365f,
  122. 0x4069, 0x0853, 0xa8e9, 0xcbff, 0xc054, 0x8261, 0xe78d, 0xb7d9,
  123. 0x402f, 0xcfad, 0xc104, 0x7563, 0xbff2, 0xeedc, 0xfabf, 0xcdd5,
  124. };
  125. #endif
  126. /* Approximation for interval z = sqrt(-2 log y ) between 2 and 8
  127. * i.e., y between exp(-2) = .135 and exp(-32) = 1.27e-14.
  128. */
  129. #ifdef UNK
  130. static double P1[9] = {
  131. 4.05544892305962419923E0, 3.15251094599893866154E1,
  132. 5.71628192246421288162E1, 4.40805073893200834700E1,
  133. 1.46849561928858024014E1, 2.18663306850790267539E0,
  134. -1.40256079171354495875E-1, -3.50424626827848203418E-2,
  135. -8.57456785154685413611E-4,
  136. };
  137. static double Q1[8] = {
  138. /* 1.00000000000000000000E0,*/
  139. 1.57799883256466749731E1, 4.53907635128879210584E1,
  140. 4.13172038254672030440E1, 1.50425385692907503408E1,
  141. 2.50464946208309415979E0, -1.42182922854787788574E-1,
  142. -3.80806407691578277194E-2, -9.33259480895457427372E-4,
  143. };
  144. #endif
  145. #ifdef DEC
  146. static unsigned short P1[36] = {
  147. 0040601, 0143074, 0150744, 0073326, 0041374, 0031554, 0113253, 0146016,
  148. 0041544, 0123272, 0012463, 0176771, 0041460, 0051160, 0103560, 0156511,
  149. 0041152, 0172624, 0117772, 0030755, 0040413, 0170713, 0151545, 0176413,
  150. 0137417, 0117512, 0022154, 0131671, 0137017, 0104257, 0071432, 0007072,
  151. 0135540, 0143363, 0063137, 0036166,
  152. };
  153. static unsigned short Q1[32] = {
  154. /*0040200,0000000,0000000,0000000,*/
  155. 0041174, 0075325, 0004736, 0120326, 0041465, 0110044, 0047561, 0045567,
  156. 0041445, 0042321, 0012142, 0030340, 0041160, 0127074, 0166076, 0141051,
  157. 0040440, 0046055, 0040745, 0150400, 0137421, 0114146, 0067330, 0010621,
  158. 0137033, 0175162, 0025555, 0114351, 0135564, 0122773, 0145750, 0030357,
  159. };
  160. #endif
  161. #ifdef IBMPC
  162. static unsigned short P1[36] = {
  163. 0x8edb, 0x9a3c, 0x38c7, 0x4010, 0x7982, 0x92d5, 0x866d, 0x403f, 0x7fbf,
  164. 0x42a6, 0x94d7, 0x404c, 0x1ba9, 0x10ee, 0x0a4e, 0x4046, 0x463e, 0x93ff,
  165. 0x5eb2, 0x402d, 0xbfa1, 0x7a6c, 0x7e39, 0x4001, 0x9677, 0x448d, 0xf3e9,
  166. 0xbfc1, 0x41c7, 0xee63, 0xf115, 0xbfa1, 0xe78f, 0x6ccb, 0x18de, 0xbf4c,
  167. };
  168. static unsigned short Q1[32] = {
  169. /*0x0000,0x0000,0x0000,0x3ff0,*/
  170. 0xd41b, 0xa13b, 0x8f5a, 0x402f, 0x296f, 0x89ee, 0xb204, 0x4046,
  171. 0x461c, 0x228c, 0xa89a, 0x4044, 0xd845, 0x9d87, 0x15c7, 0x402e,
  172. 0xba20, 0xa83c, 0x0985, 0x4004, 0x0232, 0xcddb, 0x330c, 0xbfc2,
  173. 0xb31d, 0x456d, 0x7f4e, 0xbfa3, 0x061e, 0x797d, 0x94bf, 0xbf4e,
  174. };
  175. #endif
  176. #ifdef MIEEE
  177. static unsigned short P1[36] = {
  178. 0x4010, 0x38c7, 0x9a3c, 0x8edb, 0x403f, 0x866d, 0x92d5, 0x7982, 0x404c,
  179. 0x94d7, 0x42a6, 0x7fbf, 0x4046, 0x0a4e, 0x10ee, 0x1ba9, 0x402d, 0x5eb2,
  180. 0x93ff, 0x463e, 0x4001, 0x7e39, 0x7a6c, 0xbfa1, 0xbfc1, 0xf3e9, 0x448d,
  181. 0x9677, 0xbfa1, 0xf115, 0xee63, 0x41c7, 0xbf4c, 0x18de, 0x6ccb, 0xe78f,
  182. };
  183. static unsigned short Q1[32] = {
  184. /*0x3ff0,0x0000,0x0000,0x0000,*/
  185. 0x402f, 0x8f5a, 0xa13b, 0xd41b, 0x4046, 0xb204, 0x89ee, 0x296f,
  186. 0x4044, 0xa89a, 0x228c, 0x461c, 0x402e, 0x15c7, 0x9d87, 0xd845,
  187. 0x4004, 0x0985, 0xa83c, 0xba20, 0xbfc2, 0x330c, 0xcddb, 0x0232,
  188. 0xbfa3, 0x7f4e, 0x456d, 0xb31d, 0xbf4e, 0x94bf, 0x797d, 0x061e,
  189. };
  190. #endif
  191. /* Approximation for interval z = sqrt(-2 log y ) between 8 and 64
  192. * i.e., y between exp(-32) = 1.27e-14 and exp(-2048) = 3.67e-890.
  193. */
  194. #ifdef UNK
  195. static double P2[9] = {
  196. 3.23774891776946035970E0, 6.91522889068984211695E0,
  197. 3.93881025292474443415E0, 1.33303460815807542389E0,
  198. 2.01485389549179081538E-1, 1.23716634817820021358E-2,
  199. 3.01581553508235416007E-4, 2.65806974686737550832E-6,
  200. 6.23974539184983293730E-9,
  201. };
  202. static double Q2[8] = {
  203. /* 1.00000000000000000000E0,*/
  204. 6.02427039364742014255E0, 3.67983563856160859403E0,
  205. 1.37702099489081330271E0, 2.16236993594496635890E-1,
  206. 1.34204006088543189037E-2, 3.28014464682127739104E-4,
  207. 2.89247864745380683936E-6, 6.79019408009981274425E-9,
  208. };
  209. #endif
  210. #ifdef DEC
  211. static unsigned short P2[36] = {
  212. 0040517, 0033507, 0036236, 0125641, 0040735, 0044616, 0014473, 0140133,
  213. 0040574, 0012567, 0114535, 0102541, 0040252, 0120340, 0143474, 0150135,
  214. 0037516, 0051057, 0115361, 0031211, 0036512, 0131204, 0101511, 0125144,
  215. 0035236, 0016627, 0043160, 0140216, 0033462, 0060512, 0060141, 0010641,
  216. 0031326, 0062541, 0101304, 0077706,
  217. };
  218. static unsigned short Q2[32] = {
  219. /*0040200,0000000,0000000,0000000,*/
  220. 0040700, 0143322, 0132137, 0040501, 0040553, 0101155, 0053221, 0140257,
  221. 0040260, 0041071, 0052573, 0010004, 0037535, 0066472, 0177261, 0162330,
  222. 0036533, 0160475, 0066666, 0036132, 0035253, 0174533, 0027771, 0044027,
  223. 0033502, 0016147, 0117666, 0063671, 0031351, 0047455, 0141663, 0054751,
  224. };
  225. #endif
  226. #ifdef IBMPC
  227. static unsigned short P2[36] = {
  228. 0xd574, 0xe793, 0xe6e8, 0x4009, 0x780b, 0xc327, 0xa931, 0x401b, 0xb0ac,
  229. 0xf32b, 0x82ae, 0x400f, 0x9a0c, 0x18e7, 0x541c, 0x3ff5, 0x2651, 0xf35e,
  230. 0xca45, 0x3fc9, 0x354d, 0x9069, 0x5650, 0x3f89, 0x1812, 0xe8ce, 0xc3b2,
  231. 0x3f33, 0x2234, 0x4c0c, 0x4c29, 0x3ec6, 0x8ff9, 0x3058, 0xccac, 0x3e3a,
  232. };
  233. static unsigned short Q2[32] = {
  234. /*0x0000,0x0000,0x0000,0x3ff0,*/
  235. 0xe828, 0x568b, 0x18da, 0x4018, 0x3816, 0xaad2, 0x704d, 0x400d,
  236. 0x6200, 0x2aaf, 0x0847, 0x3ff6, 0x3c9b, 0x5fd6, 0xada7, 0x3fcb,
  237. 0xc78b, 0xadb6, 0x7c27, 0x3f8b, 0x2903, 0x65ff, 0x7f2b, 0x3f35,
  238. 0xccf7, 0xf3f6, 0x438c, 0x3ec8, 0x6b3d, 0xb876, 0x29e5, 0x3e3d,
  239. };
  240. #endif
  241. #ifdef MIEEE
  242. static unsigned short P2[36] = {
  243. 0x4009, 0xe6e8, 0xe793, 0xd574, 0x401b, 0xa931, 0xc327, 0x780b, 0x400f,
  244. 0x82ae, 0xf32b, 0xb0ac, 0x3ff5, 0x541c, 0x18e7, 0x9a0c, 0x3fc9, 0xca45,
  245. 0xf35e, 0x2651, 0x3f89, 0x5650, 0x9069, 0x354d, 0x3f33, 0xc3b2, 0xe8ce,
  246. 0x1812, 0x3ec6, 0x4c29, 0x4c0c, 0x2234, 0x3e3a, 0xccac, 0x3058, 0x8ff9,
  247. };
  248. static unsigned short Q2[32] = {
  249. /*0x3ff0,0x0000,0x0000,0x0000,*/
  250. 0x4018, 0x18da, 0x568b, 0xe828, 0x400d, 0x704d, 0xaad2, 0x3816,
  251. 0x3ff6, 0x0847, 0x2aaf, 0x6200, 0x3fcb, 0xada7, 0x5fd6, 0x3c9b,
  252. 0x3f8b, 0x7c27, 0xadb6, 0xc78b, 0x3f35, 0x7f2b, 0x65ff, 0x2903,
  253. 0x3ec8, 0x438c, 0xf3f6, 0xccf7, 0x3e3d, 0x29e5, 0xb876, 0x6b3d,
  254. };
  255. #endif
  256. #ifdef ANSIPROT
  257. extern double polevl(double, void *, int);
  258. extern double p1evl(double, void *, int);
  259. extern double log(double);
  260. extern double sqrt(double);
  261. #else
  262. double polevl(), p1evl(), log(), sqrt();
  263. #endif
  264. double ndtri(y0) double y0;
  265. {
  266. double x, y, z, y2, x0, x1;
  267. int code;
  268. if (y0 <= 0.0) {
  269. mtherr("ndtri", DOMAIN);
  270. return (-MAXNUM);
  271. }
  272. if (y0 >= 1.0) {
  273. mtherr("ndtri", DOMAIN);
  274. return (MAXNUM);
  275. }
  276. code = 1;
  277. y = y0;
  278. if (y > (1.0 - 0.13533528323661269189)) /* 0.135... = exp(-2) */
  279. {
  280. y = 1.0 - y;
  281. code = 0;
  282. }
  283. if (y > 0.13533528323661269189) {
  284. y = y - 0.5;
  285. y2 = y * y;
  286. x = y + y * (y2 * polevl(y2, P0, 4) / p1evl(y2, Q0, 8));
  287. x = x * s2pi;
  288. return (x);
  289. }
  290. x = sqrt(-2.0 * log(y));
  291. x0 = x - log(x) / x;
  292. z = 1.0 / x;
  293. if (x < 8.0) /* y > exp(-32) = 1.2664165549e-14 */
  294. x1 = z * polevl(z, P1, 8) / p1evl(z, Q1, 8);
  295. else
  296. x1 = z * polevl(z, P2, 8) / p1evl(z, Q2, 8);
  297. x = x0 - x1;
  298. if (code != 0)
  299. x = -x;
  300. return (x);
  301. }