home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / educ / pstat2.zip / PROB111.BQS / prob111.bas
BASIC Source File  |  1986-12-17  |  19KB  |  330 lines
  1. 10 REM PROB.BAS V1.1, PLACED IN THE PUBLIC DOMAIN  5/26/86
  2. 20 REM BY JOSEPH C. HUDSON 4198 WARBLER DR FLINT MI 48504
  3. 30 S6 = .7745966692# : PI = 3.1415922536# : ERRTOL = .000005
  4. 40 S2PI = 2.5066282746#
  5. 50 CLS : KEY OFF : PRINT "SELECT A DISTRIBUTION:" : PRINT
  6. 60 PRINT"                1 BINOMIAL         2 NEGATIVE BINOMIAL"
  7. 70 PRINT"                3 POISSON          4 HYPERGEOMETRIC"
  8. 80 PRINT"                5 STD NORMAL       6 STD NORMAL  INVERSE"
  9. 90 PRINT"                7 STUDENT'S T      8 STUDENT'S T INVERSE"
  10. 100 PRINT"                9 CHI SQUARE      10 CHI SQUARE  INVERSE"
  11. 110 PRINT"               11 F               12 F           INVERSE"
  12. 120 LOCATE 25,1 : PRINT "Enter Q to quit";: LOCATE 10,1 : INPUT A$
  13. 130 IF LEFT$(A$,1) = "q" OR LEFT$(A$,1) = "Q" THEN KEY ON : END
  14. 140 A = VAL(A$) : IF A < 1 OR A > 12 THEN 150 ELSE 160
  15. 150 LOCATE 1,CSRLIN : PRINT SPACE$(80) : GOTO 120
  16. 160 CLS : ON A GOTO 270,480,660,790,1190,1400,1630,1900,2150,2340,2580,2960
  17. 170 LOCATE CLINE,1 : PRINT SPACE$(80) : LOCATE 25,1
  18. 180 PRINT "Enter M to return to menu, Q to quit";: LOCATE CLINE,2
  19. 190 INPUT A$ : IF A$ = "M" OR A$ = "m" THEN 50
  20. 200            IF A$ = "Q" OR A$ = "q" THEN KEY ON : END
  21. 210 LOCATE 25,1 : PRINT SPACE$(80);
  22. 220 LOCATE CLINE,1 : PRINT SPACE$(80);: RETURN
  23. 230 LOCATE 23,5 : PRINT "THE SCREEN IS ABOUT TO BE ERASED";
  24. 240 PRINT " ENTER Shift PrtSc TO COPY, ANY KEY TO CONTINUE";
  25. 250 A$ = INKEY$ : IF A$ = "" THEN 250
  26. 260 CLS : RETURN
  27. 270 PRINT " BINOMIAL DISTRIBUTION" : PRINT : CLINE = 4
  28. 280 PRINT "    N      P       x        Pr( X = x )     Pr( X <= x )";
  29. 290 GOSUB 170 : BN = VAL(A$) : IF BN < 1 OR BN <> INT(BN) THEN BEEP : GOTO 290
  30. 300 LOCATE CLINE, 3 : PRINT USING "###"; BN;: LOCATE CLINE,10
  31. 310 INPUT A$ : BP = VAL(A$) : LOCATE CLINE,10 : PRINT SPACE$(LEN(A$)+5);
  32. 320 IF BP < ERRTOL OR BP > 1-ERRTOL THEN BEEP : LOCATE CLINE,10 : GOTO 310
  33. 330 LOCATE CLINE,10 : PRINT USING ".####"; BP;: LOCATE CLINE,19
  34. 340 INPUT A$ : BR = VAL(A$) : LOCATE CLINE,19 : PRINT SPACE$(LEN(A$)+5);
  35. 350 IF BR < 0 OR BR <> INT(BR) THEN BEEP : LOCATE CLINE,19 : GOTO 340
  36. 360 LOCATE CLINE,19 : PRINT USING "###"; BR;: GOSUB 400
  37. 370 LOCATE CLINE,31 : PRINT USING "#.####"; BPX ;
  38. 380 LOCATE CLINE,48 : PRINT USING "#.####"; BF  ;
  39. 390 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 270 ELSE GOTO 290
  40. 400 IF BR > BN THEN BPX = 0 : BF = 1 : RETURN
  41. 410 BI=0 : IF BR > BN-BR-1 THEN BI = 1 : BP = 1 - BP : BR = BN - BR - 1
  42. 420 BL = BN * LOG(1-BP) : BF = EXP(BL) : IF BR <= 0 THEN 450
  43. 430 FOR BJ = 1 TO BR : BL = BL - LOG(BJ) + LOG(BN-BJ+1) + LOG(BP) - LOG(1-BP)
  44. 440 BF = BF + EXP(BL) : NEXT BJ
  45. 450 IF BI=1 AND BR>=0 THEN BL=BL+LOG(BP)-LOG(1-BP)-LOG(BR+1)+LOG(BN-BR):BF=1-BF
  46. 460 IF BR = -1 THEN BF = 1
  47. 470 BPX = EXP(BL) : RETURN
  48. 480 PRINT "NEGATIVE BINOMIAL DISTRIBUTION" : PRINT : CLINE = 4
  49. 490 PRINT "    N      P       x        Pr( X = x )     Pr( X <= x )";
  50. 500 GOSUB 170 : N = VAL(A$) : IF N < 1 OR N <> INT(N) THEN BEEP : GOTO 500
  51. 510 LOCATE CLINE,3 : PRINT USING "###"; N : LOCATE CLINE,10
  52. 520 INPUT A$ : P = VAL(A$) : LOCATE CLINE,10 : PRINT SPACE$(LEN(A$)+5)
  53. 530 IF P < ERRTOL OR P > 1 - ERRTOL THEN BEEP : LOCATE CLINE,10 : GOTO 520
  54. 540 LOCATE CLINE,10 : PRINT USING ".####"; P : LOCATE CLINE,19
  55. 550 INPUT A$ : X = VAL(A$) : LOCATE CLINE,19 : PRINT SPACE$(LEN(A$)+5)
  56. 560 IF X <> INT(X) THEN BEEP : LOCATE CLINE,19 : GOTO 550
  57. 570 LOCATE CLINE,19 : PRINT USING "###"; X : GOSUB 610
  58. 580 LOCATE CLINE,31 : PRINT USING "#.####"; LP ;
  59. 590 LOCATE CLINE,48 : PRINT USING "#.####"; CD ;
  60. 600 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 480 ELSE GOTO 500
  61. 610 IF X < N THEN LP = 0 : CD = 0 : RETURN
  62. 620 LP = N * LOG(P) : CD = EXP(LP) : IF X = N THEN LP = CD : RETURN
  63. 630 FOR K = 1 TO X - N
  64. 640 LP = LP + LOG(1-P) + LOG(N+K-1) - LOG(K) : CD = CD + EXP(LP) : NEXT K
  65. 650 LP = EXP(LP) : RETURN
  66. 660 PRINT "POISSON DISTRIBUTION" : PRINT : CLINE = 4
  67. 670 PRINT "    Mu        x        Pr( X = x )      Pr( X <= x )";
  68. 680 GOSUB 170 : MU = VAL(A$) : IF MU < ERRTOL THEN BEEP : GOTO 680
  69. 690 LOCATE CLINE,3 : PRINT USING "###.##"; MU : LOCATE CLINE,14
  70. 700 INPUT A$ : R = VAL(A$) : LOCATE CLINE,14 : PRINT SPACE$(LEN(A$)+5)
  71. 710 IF R < 0 OR R <> INT(R) THEN BEEP : LOCATE CLINE,14 : GOTO 700
  72. 720 LOCATE CLINE,14 : PRINT USING "###"; R : GOSUB 760
  73. 730 LOCATE CLINE,26 : PRINT USING "#.####"; PX
  74. 740 LOCATE CLINE,44 : PRINT USING "#.####"; F
  75. 750 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 660 ELSE GOTO 680
  76. 760 LX = -MU : F = EXP(LX) :IF R = 0 THEN 780
  77. 770 FOR X = 1 TO R : LX = LX + LOG(MU) - LOG(X) : F = F + EXP(LX) : NEXT X
  78. 780 PX = EXP(LX) : RETURN
  79. 790 PRINT "HYPERGEOMETRIC DISTRIBUTION" : PRINT : CLINE = 4
  80. 800 PRINT "  N    n    k     Min   Max    x    Pr( X = x )     PR( X <= x )";
  81. 810 GOSUB 170 : N = VAL(A$) : IF N < 1 OR N <> INT(N) THEN BEEP : GOTO 810
  82. 820 LOCATE CLINE,2 : PRINT USING "###"; N : LOCATE CLINE,7
  83. 830 INPUT A$ : NS = VAL(A$) : LOCATE CLINE,7 : PRINT SPACE$(LEN(A$)+5)
  84. 840 IF NS < 1 OR NS > N OR NS <> INT(NS) THEN BEEP : LOCATE CLINE,7 : GOTO 830
  85. 850 LOCATE CLINE,7 : PRINT USING "###"; NS : LOCATE CLINE,12
  86. 860 INPUT A$ : K = VAL(A$) : LOCATE CLINE,12 : PRINT SPACE$(LEN(A$)+5)
  87. 870 IF K < 1 OR K > N OR K <> INT(K) THEN BEEP : LOCATE CLINE,12 : GOTO 860
  88. 880 LOCATE CLINE,12 : PRINT USING "###"; K
  89. 890 IF NS + K < N THEN MI = 0 ELSE MI = NS + K - N
  90. 900 IF NS < K THEN MA = NS ELSE MA = K
  91. 910 LOCATE CLINE,19 : PRINT USING "###"; MI : LOCATE CLINE,25
  92. 920 PRINT USING "###"; MA : LOCATE CLINE,31
  93. 930 INPUT A$ : R = VAL(A$) : LOCATE CLINE,31 : PRINT SPACE$(LEN(A$)+5)
  94. 940 IF R < MI OR R > MA OR R <> INT(R) THEN BEEP : LOCATE CLINE,31 : GOTO 930
  95. 950 LOCATE CLINE,31 : PRINT USING "###"; R : GOSUB 990
  96. 960 LOCATE CLINE,39 : PRINT USING "#.####"; PX
  97. 970 LOCATE CLINE,56 : PRINT USING "#.####"; CD
  98. 980 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 790 ELSE GOTO 810
  99. 990 SR = 1 : EN = R : IF R-MI+1 <= MA-R THEN BE=MI ELSE BE=MA : SR=-1 : EN=R+1
  100. 1000 A = K   : B = BE    : GOSUB 1150 : CD = LF
  101. 1010 A = N-K : B = NS-BE : GOSUB 1150 : CD = CD+LF
  102. 1020 A = N    :B = NS    : GOSUB 1150 : CD = CD-LF : LF = CD : CD = EXP(CD)
  103. 1030 IF BE =  EN THEN 1120
  104. 1040 IF EN <= MA THEN 1050 ELSE CD = 1 : SR = 1 : GOTO 1140
  105. 1050 IF SR =  -1 THEN 1090
  106. 1060 FOR I = BE + 1 TO EN
  107. 1070 LF = LF - LOG(I) + LOG(K-I+1) + LOG(NS-I+1) - LOG(N-K-NS+I)
  108. 1080 CD = CD + EXP(LF) : NEXT I : GOTO 1140
  109. 1090 FOR I = BE - 1 TO EN STEP -1
  110. 1100 LF = LF + LOG(I+1) - LOG(K-I) - LOG(NS-I) + LOG(N-K-NS+I+1)
  111. 1110 CD = CD + EXP(LF) : NEXT I
  112. 1120 IF SR = -1 THEN CD = 1 - CD
  113. 1130 IF SR = -1 THEN LF=LF+LOG(EN)-LOG(K-EN+1)-LOG(NS-EN+1)+LOG(N-K-NS+EN)
  114. 1140 PX = EXP(LF) : RETURN
  115. 1150 IF A = B     OR B = 0 THEN LF = 0      : RETURN
  116. 1160 IF A = B + 1 OR B = 1 THEN LF = LOG(A) : RETURN
  117. 1170 LF = 0 : FOR J = A - B + 1 TO A : LF = LF + LOG(J) : NEXT J
  118. 1180          FOR J = 2         TO B : LF = LF - LOG(J) : NEXT J : RETURN
  119. 1190 PRINT "STANDARD NORMAL DISTRIBUTION" : PRINT : CLINE = 4 
  120. 1195 ETOL = ERRTOL * S2PI
  121. 1200 PRINT "   z       Pr( Z < z )      Pr( Z > z )      Pr( |Z| > |z| )"
  122. 1210 GOSUB 170 : Z = VAL(A$)
  123. 1220 LOCATE CLINE, 2 : PRINT USING "##.###"; Z : GOSUB 1280
  124. 1230 LOCATE CLINE,14 : PRINT USING "#.####"; ZCD
  125. 1240 LOCATE CLINE,31 : PRINT USING "#.####"; 1 - ZCD
  126. 1250 IF ZCD < .5 THEN ZCDA = 2 * ZCD ELSE ZCDA = 2 * (1 - ZCD )
  127. 1260 LOCATE CLINE,50 : PRINT USING "#.####"; ZCDA
  128. 1270 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 1190 : ELSE GOTO 1210
  129. 1280 ZIP = 0 : IF Z < 0 THEN Z = -Z : ZIP = 1
  130. 1290 IF Z = 0 THEN ZCD = .5 : RETURN ELSE GOSUB 1310
  131. 1300 IF ZIP = 1 THEN ZCD = 1 - ZCD : RETURN ELSE RETURN
  132. 1310 ZZ = Z * Z : IF ABS(Z) < 2 THEN 1360
  133. 1320 ZB = 1 : Z1 = 1 : ZT = 1 : ZJ = 1 : EETOL = Z * ETOL * EXP(ZZ/2)
  134. 1330 ZB = 1 / ( 1 + ZJ * ZB / ZZ ) : Z1 = ( ZB - 1 ) * Z1 : ZT = ZT + Z1
  135. 1340 IF ABS(Z1) > EETOL THEN ZJ = ZJ + 1 : GOTO 1330
  136. 1350 ZCD = 1 - ZT * EXP( - ZZ / 2 ) / ( S2PI * Z ) : RETURN
  137. 1360 Z1 = Z : ZT = Z1 : ZJ = 1
  138. 1370 Z1 = - Z1 * ZZ * ( 2*ZJ - 1 ) / ( 2*ZJ * ( 2*ZJ + 1 ) ) : ZT = ZT + Z1
  139. 1380 IF ABS(Z1) > ETOL THEN ZJ = ZJ + 1 : GOTO 1370
  140. 1390 ZCD = .5 + ZT / S2PI : RETURN
  141. 1400 PRINT "PERCENTAGE POINTS OF THE STANDARD NORMAL DISTRIBUTION" : PRINT
  142. 1410 PRINT "Enter PROB, program returns z, where Pr( Z > z ) = PROB"
  143. 1420 PRINT : CLINE = 6
  144. 1430 PRINT "  PROB        z " :
  145. 1440 GOSUB 170 : YPR = VAL(A$) : LOCATE CLINE,2
  146. 1450 IF YPR < ERRTOL OR YPR > 1 - ERRTOL THEN BEEP : GOTO 1440
  147. 1460 PRINT USING "#.####"; YPR : GOSUB 1500
  148. 1470 IF YIP = 0 THEN Y3 = -Y3
  149. 1480 LOCATE CLINE,13 : PRINT USING "##.###"; Y3
  150. 1490 CLINE = CLINE+1 : IF CLINE=21 THEN GOSUB 230 : GOTO 1400 : ELSE GOTO 1440
  151. 1500 YIP = 0 : IF YPR < .5 THEN YPR = 1 - YPR : YIP = 1
  152. 1510 IF YPR = .5 THEN Y3 = 0 : RETURN
  153. 1520 Y1=0 : YP1=.5 : YIU=2 : Y2=1 : YP2 = .84134474607# : GOTO 1610
  154. 1530 ZCD = 0 : Z = Y3 : GOSUB 1310 : YP3 = ZCD
  155. 1540 IF ABS(YP3 - YPR) < ERRTOL THEN RETURN
  156. 1550 IF YP3 >  1 - ERRTOL AND YIU = 1 THEN Y3 = Y3 - (Y3 - Y1) / 2 : GOTO 1530
  157. 1560 IF YP3 >  1 - ERRTOL AND YIU = 2 THEN Y3 = Y3 - (Y3 - Y2) / 2 : GOTO 1530
  158. 1570 IF YP3 < .5 + ERRTOL AND YIU = 1 THEN Y3 = Y3 - (Y3 - Y2) / 2 : GOTO 1530
  159. 1580 IF YP3 < .5 - ERRTOL AND YIU = 2 THEN Y3 = Y3 - (Y3 - Y1) / 2 : GOTO 1530
  160. 1590 IF ABS(YPR-YP1) < ABS(YPR-YP2) THEN YP2=YP3 : Y2=Y3 : YIU=2 : GOTO 1610
  161. 1600 YP1 = YP3 : Y1 = Y3 : YIU = 1
  162. 1610 YK = (Y2-Y1)/(LOG(1/YP1-1)-LOG(1/YP2-1)) : YA = Y2 + YK*LOG(1/YP2-1)
  163. 1620 Y3 = YA - YK * LOG(1/YPR-1) : GOTO 1530
  164. 1630 PRINT "STUDENT'S T DISTRIBUTION" : PRINT : CLINE = 4
  165. 1640 PRINT "    DF      t       Pr( T < t )   Pr( T > t )   Pr( |T| > |t| )";
  166. 1650 GOSUB 170 : DF = VAL(A$) : IF DF < 1 OR DF <> INT(DF) THEN BEEP:GOTO 1650
  167. 1660 LOCATE CLINE,4 : PRINT USING "###"; DF : LOCATE CLINE,11
  168. 1670 INPUT A$ : T = VAL(A$) : LOCATE CLINE,11 : PRINT SPACE$(LEN(A$)+5)
  169. 1680 LOCATE CLINE,11 : PRINT USING "##.###"; T : GOSUB 1740
  170. 1690 LOCATE CLINE,23 : PRINT USING "#.####"; CD
  171. 1700 LOCATE CLINE,37 : PRINT USING "#.####"; 1-CD
  172. 1710 IF CD < .5 THEN CDA = 2 * CD ELSE CDA = 2 * ( 1 - CD )
  173. 1720 LOCATE CLINE,53 : PRINT USING "#.####"; CDA
  174. 1730 CLINE = CLINE+1 : IF CLINE=21 THEN GOSUB 230 : GOTO 1630 : ELSE GOTO 1650
  175. 1740 IPT = 0 : IF T < 0 THEN T = -T : IPT = 1
  176. 1750 IF T = 0 THEN CD = .5 : RETURN
  177. 1760 GOSUB 1770 : IF IPT = 1 THEN CD = 1 - CD : RETURN
  178. 1770 THETA = ATN( T / SQR(DF) )
  179. 1780 IF DF MOD 2 <> 0 THEN 1830
  180. 1790 SUM = 1 : CS = COS(THETA) : SS = SIN(THETA)
  181. 1800 IF DF = 2 THEN 1820 ELSE DS = CS * CS : TM = 1
  182. 1810 FOR I = 2 TO DF-2 STEP 2 : TM=TM*DS*(I-1)/I : SUM = SUM + TM : NEXT I
  183. 1820 SUM = SS * SUM : GOTO 1890
  184. 1830 SMS = 0 : IF DF = 1 THEN 1880
  185. 1840 SS = SIN(THETA) : CS = COS(THETA) : DS = CS * CS : SMS = CS : TM = CS
  186. 1850 IF DF = 3 THEN 1870
  187. 1860 FOR I = 3 TO DF-2 STEP 2 : TM=TM*DS*(I-1)/I : SMS = SMS + TM : NEXT I
  188. 1870 SMS = SS * SMS
  189. 1880 SUM = 2 * (THETA+SMS) / PI
  190. 1890 CD = (SUM+1) / 2 : RETURN
  191. 1900 PRINT "PERCENTAGE POINTS OF THE STUDENT'S T DISTRIBUTION" : PRINT
  192. 1910 PRINT "Enter PROB, program returns t, where Pr( T > t ) = PROB"
  193. 1920 PRINT : CLINE = 6
  194. 1930 PRINT "    DF     PROB       t";
  195. 1940 GOSUB 170 : DF = VAL(A$) : IF DF < 1 OR DF <> INT(DF) THEN BEEP:GOTO 1940
  196. 1950 LOCATE CLINE,4 : PRINT USING "###"; DF : LOCATE CLINE,11
  197. 1960 INPUT A$ : PR = VAL(A$) : LOCATE CLINE,11 : PRINT SPACE$(LEN(A$)+5)
  198. 1970 IF PR <= 0 OR PR >= 1 THEN BEEP : LOCATE CLINE,11 : GOTO 1960
  199. 1980 LOCATE CLINE,11 : PRINT USING "#.####"; PR : GOSUB 2020
  200. 1990 IF IPTI = 0 THEN T3 = -T3
  201. 2000 LOCATE CLINE,21 : PRINT USING "##.###"; T3
  202. 2010 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 1900 : ELSE GOTO 1940
  203. 2020 IPTI = 0 : IF PR < .5 THEN PR = 1 - PR : IPTI = 1
  204. 2030 IF PR = .5 THEN T3 = 0 : RETURN
  205. 2040 T1=0 : P1=.5 : IU = 2 : T2=1 : T=T2 : GOSUB 1770 : P2=CD : GOTO 2130
  206. 2050 CD = 0 : T = T3 : GOSUB 1770 : P3 = CD
  207. 2060 IF ABS(PR-P3) < ERRTOL THEN RETURN
  208. 2070 IF P3 >  1 - ERRTOL AND IU = 1 THEN T3 = T3 - (T3 - T1) / 2 : GOTO 2050
  209. 2080 IF P3 >  1 - ERRTOL AND IU = 2 THEN T3 = T3 - (T3 - T2) / 2 : GOTO 2050
  210. 2090 IF P3 < .5 + ERRTOL AND IU = 1 THEN T3 = T3 - (T3 - T2) / 2 : GOTO 2050
  211. 2100 IF P3 < .5 - ERRTOL AND IU = 2 THEN T3 = T3 - (T3 - T1) / 2 : GOTO 2050
  212. 2110 IF ABS(PR-P1) < ABS(PR-P2) THEN P2 = P3 : T2 = T3 : IU = 2 : GOTO 2130
  213. 2120 P1 = P3 : T1 = T3 : IU = 1
  214. 2130 K1 = (T2-T1)/(LOG(1/P1-1)-LOG(1/P2-1)) : A1 = T2 + K1*LOG(1/P2-1)
  215. 2140 T3 = A1 - K1 * LOG(1/PR-1) : GOTO 2050
  216. 2150 PRINT "CHI - SQUARE DISTRIBUTION" : PRINT : CLINE = 4
  217. 2160 PRINT "    DF      x²     Pr( X² < x² )    Pr( X² > x² )"
  218. 2170 GOSUB 170 : DF = VAL(A$) : IF DF < 1 OR DF <> INT(DF) THEN BEEP:GOTO 2170
  219. 2180 LOCATE CLINE,4 : PRINT USING "###"; DF : LOCATE CLINE,10
  220. 2190 INPUT A$ : X = VAL(A$) : LOCATE CLINE,10 : PRINT SPACE$(LEN(A$)+5)
  221. 2200 LOCATE CLINE,10 : PRINT USING "###.###"; X : GOSUB 2240
  222. 2210 LOCATE CLINE,23 : PRINT USING "#.####"; CD
  223. 2220 LOCATE CLINE,40 : PRINT USING "#.####"; 1 - CD
  224. 2230 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 2150 ELSE GOTO 2170
  225. 2240 IF X <= 0 THEN CD = 0 : RETURN
  226. 2250 IF DF MOD 2 = 0 THEN SUM = EXP( - X / 2 ) : LOW = 2
  227. 2260 IF DF MOD 2 <> 0 THEN Z = SQR(X) : GOSUB 1280 : SUM = 2-2*ZCD : LOW = 1
  228. 2270 IF DF < 3 THEN CD = 1-SUM : RETURN
  229. 2280 LX2 = LOG(X/2) : LTERM = - (X/2)
  230. 2290 IF DF MOD 2 = 1 THEN LTERM =  LTERM - .5 * LX2 - LOG(SQR(PI))
  231. 2300 FOR I = LOW TO DF - 2 STEP 2
  232. 2310 LTERM = LTERM + LX2 - LOG(I/2)
  233. 2320 SUM = SUM + EXP(LTERM) : NEXT I
  234. 2330 CD = 1-SUM : RETURN
  235. 2340 PRINT "PERCENTAGE POINTS OF THE CHI - SQUARE DISTRIBUTION" : PRINT
  236. 2350 PRINT "Enter PROB, program returns x², where Pr( X² > x² ) = PROB"
  237. 2360 PRINT : CLINE = 6
  238. 2370 PRINT "    DF     PROB       x²"
  239. 2380 GOSUB 170 : DF = VAL(A$) : IF DF < 1 OR DF <> INT(DF) THEN BEEP:GOTO 2380
  240. 2390 LOCATE CLINE,4 : PRINT USING "###"; DF : LOCATE CLINE,11
  241. 2400 INPUT A$ : PR = VAL(A$) : LOCATE CLINE,11 : PRINT SPACE$(LEN(A$)+5)
  242. 2410 IF PR < ERRTOL OR PR > 1-ERRTOL THEN BEEP:LOCATE CLINE,11:GOTO 2400
  243. 2420 LOCATE CLINE,11 : PRINT USING "#.####"; PR : PR = 1 - PR : GOSUB 2450
  244. 2430 LOCATE CLINE,20 : PRINT USING "###.###"; X3
  245. 2440 CLINE = CLINE+1 : IF CLINE=21 THEN GOSUB 230 : GOTO 2340 ELSE GOTO 2380
  246. 2450 X1 = DF / 4 : X = X1 : GOSUB 2240 : P1 = CD : IU = 2
  247. 2460 X2 = DF     : X = X2 : GOSUB 2240 : P2 = CD : GOTO 2550
  248. 2470 CD = 0 : X = X3 : GOSUB 2240 : P3 = CD
  249. 2480 IF ABS(PR-P3) < ERRTOL THEN RETURN
  250. 2490 IF P3 >  1 - ERRTOL AND IU = 1 THEN X3 = X3 - (X3 - X1) / 2 : GOTO 2470
  251. 2500 IF P3 >  1 - ERRTOL AND IU = 2 THEN X3 = X3 - (X3 - X2) / 2 : GOTO 2470
  252. 2510 IF P3 <      ERRTOL AND IU = 1 THEN X3 = X3 - (X3 - X2) / 2 : GOTO 2470
  253. 2520 IF P3 <      ERRTOL AND IU = 2 THEN X3 = X3 - (X3 - X1) / 2 : GOTO 2470
  254. 2530 IF ABS(PR-P1) < ABS(PR-P2) THEN P2 = P3 : X2 = X3 : IU = 2 : GOTO 2550
  255. 2540 P1 = P3 : X1 = X3 : IU = 1
  256. 2550 A1 = LOG(LOG(1-P2)/LOG(1-P1)) / LOG(X2/X1)
  257. 2560 K1 = A1 * LOG(X2) - LOG(-LOG(1-P2))
  258. 2570 X3 = EXP( (LOG(-LOG(1-PR))+K1)/A1 ) : GOTO 2470
  259. 2580 PRINT "F DISTRIBUTION" : PRINT : CLINE = 4
  260. 2590 PRINT "  DF1   DF2     f       Pr( F < f )     Pr( F > f ) ";
  261. 2600 GOSUB 170 : DF1 = VAL(A$) : IF DF1<1 OR DF1<>INT(DF1) THEN BEEP:GOTO 2600
  262. 2610 LOCATE CLINE,3 : PRINT USING "###"; DF1 : LOCATE CLINE,9
  263. 2620 INPUT A$ : DF2 = VAL(A$) : IF DF2<1 OR DF2<>INT(DF2) THEN 2630 ELSE 2640
  264. 2630 LOCATE CLINE,9 : PRINT SPACE$(20) : LOCATE CLINE,9 : BEEP : GOTO 2620
  265. 2640 LOCATE CLINE,9 : PRINT SPACE$(LEN(A$)+5)
  266. 2650 LOCATE CLINE,9 : PRINT USING "###"; DF2 : LOCATE CLINE,14
  267. 2660 INPUT A$ : F = VAL(A$) : LOCATE CLINE,14 : PRINT SPACE$(LEN(A$)+5)
  268. 2670 LOCATE CLINE,14 : PRINT USING "###.###"; F : GOSUB 2710
  269. 2680 LOCATE CLINE,27 : PRINT USING "#.####"; CD
  270. 2690 LOCATE CLINE,43 : PRINT USING "#.####"; 1 - CD
  271. 2700 CLINE = CLINE+1 : IF CLINE = 21 THEN GOSUB 230 : GOTO 2580 ELSE GOTO 2600
  272. 2710 IF F <= 0 THEN CD = 0 : RETURN
  273. 2720 IF 0 = DF2 MOD 2 THEN 2780
  274. 2730 IF 0 <> DF1 MOD 2 THEN 2820
  275. 2740 TERM = 1 : SUM = 1 : XF = DF2/(DF2+DF1*F) : IF DF1 = 2 THEN 2770
  276. 2750 FOR I = 2 TO DF1-2 STEP 2
  277. 2760 TERM = (TERM/I)*(DF2+I-2)*(1-XF) : SUM = SUM + TERM : NEXT I
  278. 2770 CD = 1 - SUM * ( XF ^ (DF2/2) ) : RETURN
  279. 2780 TERM = 1 : SUM = 1 : XF = DF2/(DF2+DF1*F) : IF DF2 = 2 THEN 2810
  280. 2790 FOR I = 2 TO DF2-2 STEP 2
  281. 2800 TERM = (TERM/I)*(DF1+I-2)*XF : SUM = SUM + TERM : NEXT I
  282. 2810 CD = SUM * ( (1-XF) ^ (DF1/2) ) : RETURN
  283. 2820 IF DF2 = 1 AND DF1 = 1 THEN GOTO 2940
  284. 2830 IPF = 0:IF DF2 = 1 AND DF1 > 3 THEN IPF=DF1:DF1=DF2:DF2=IPF:F=1/F:IPF=1
  285. 2840 DF = DF2 : T = SQR(DF1*F) : GOSUB 1750 : AT = ABS(2 * CD - 1)
  286. 2850 IF DF1 = 1 THEN CD = AT : IF IPF=1 THEN 2950 ELSE RETURN
  287. 2860 SS = SQR( F * DF1 / ( DF2 + F * DF1 ) ) : CS = SQR( 1 - SS * SS )
  288. 2870 TERM = 1 : SUM = 1 : IF DF1 = 3 THEN GOTO 2910
  289. 2880 FOR I = 3 TO DF1 - 2 STEP 2
  290. 2890 TERM = TERM * ( DF2 + I - 2 ) * SS * SS / I
  291. 2900 SUM = SUM + TERM : NEXT I
  292. 2910 LF1 = 0 : FOR I=2 TO DF2-1 STEP 2 : LF1 = LF1+LOG(I)-LOG(I-1) : NEXT I
  293. 2920 BETA = ( SUM / PI ) * SS * (CS^DF2) * 2 * EXP(LF1)
  294. 2930 CD = AT - BETA : RETURN
  295. 2940 CD = 2 * ATN(SQR(F)) / PI : RETURN
  296. 2950 IPF = DF1 : DF1 = DF2 : DF2 = IPF : F = 1/F : CD = 1 - CD : RETURN
  297. 2960 PRINT "PERCENTAGE POINTS OF THE F DISTRIBUTION" : PRINT
  298. 2970 PRINT "Enter PROB, program returns f, where Pr( F > f ) = PROB"
  299. 2980 PRINT : CLINE = 6
  300. 2990 PRINT "  DF1    DF2      PROB       f"
  301. 3000 GOSUB 170 : DF1 = VAL(A$) : IF DF1<1 OR DF1<>INT(DF1) THEN BEEP:GOTO 3000
  302. 3010 LOCATE CLINE,3 : PRINT USING "###"; DF1 : LOCATE CLINE,10
  303. 3020 INPUT A$ : DF2 = VAL(A$) : IF DF2<1 OR DF2<>INT(DF2) THEN 3030 ELSE 3040
  304. 3030 LOCATE CLINE,10 : PRINT SPACE$(20) : LOCATE CLINE,10 : BEEP : GOTO 3020
  305. 3040 LOCATE CLINE,10 : PRINT SPACE$(LEN(A$)+5)
  306. 3050 LOCATE CLINE,10 : PRINT USING "###"; DF2 : LOCATE CLINE,18
  307. 3060 INPUT A$ : PR = VAL(A$) : LOCATE CLINE,18 : PRINT SPACE$(LEN(A$)+5)
  308. 3070 IF PR < ERRTOL OR PR > 1-ERRTOL THEN BEEP : LOCATE CLINE,18 : GOTO 3060
  309. 3080 LOCATE CLINE,18 : PRINT USING "#.####"; PR : PR = 1 - PR : GOSUB 3110
  310. 3090 LOCATE CLINE,27 : PRINT USING "###.###"; F3
  311. 3100 CLINE = CLINE+1 : IF CLINE=21 THEN GOSUB 230 : GOTO 2960 ELSE GOTO 3000
  312. 3110 F1 = DF1 / ( DF2 * 2 ) : IU = 2
  313. 3120 F = F1 : GOSUB 2710 : P1 = CD
  314. 3130 IF P1 < ERRTOL THEN F1 = F1 + (DF1/DF2 - F1)/2 : GOTO 3120
  315. 3140 F2 = 2 * DF1 / DF2
  316. 3150 F = F2 : GOSUB 2710 : P2 = CD
  317. 3160 IF P2 > 1 - ERRTOL THEN F2 = F2 - (F2 - DF1/DF2)/2 : GOTO 3150
  318. 3170 GOTO 3260
  319. 3180 CD = 0 : F = F3 : GOSUB 2710 : P3 = CD
  320. 3190 IF ABS(PR-P3) < ERRTOL THEN RETURN
  321. 3200 IF P3 >  1 - ERRTOL AND IU = 1 THEN F3 = F3 - (F3 - F1) / 2 : GOTO 3180
  322. 3210 IF P3 >  1 - ERRTOL AND IU = 2 THEN F3 = F3 - (F3 - X2) / 2 : GOTO 3180
  323. 3220 IF P3 <      ERRTOL AND IU = 1 THEN F3 = F3 - (F3 - F2) / 2 : GOTO 3180
  324. 3230 IF P3 <      ERRTOL AND IU = 2 THEN F3 = F3 - (F3 - F1) / 2 : GOTO 3180
  325. 3240 IF ABS(PR-P1) < ABS(PR-P2) THEN P2 = P3 : F2 = F3 : IU = 2 : GOTO 3260
  326. 3250 P1 = P3 : F1 = F3 : IU = 1
  327. 3260 A1 = LOG(LOG(1-P2)/LOG(1-P1)) / LOG(F2/F1)
  328. 3270 K1 = A1 * LOG(F2) - LOG(-LOG(1-P2))
  329. 3280 F3 = EXP( (LOG(-LOG(1-PR))+K1)/A1 ) : GOTO 3180
  330.