Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmod92.bas
There are 2 other files named cmod92.bas in the archive. Click here to see a list.
00015REM ***************************************************************
00020REM CMOD92 CMOD92 CMOD92 CMOD92 CMOD92 CMOD92
00025REM ***************************************************************
00030REM RESTRICTED SELECTION - FINDING THE CUT SCORES
00035REM
00040REM ***************************************************************
00045REM ***************************************************************
00050X=0
00055GOSUB 6060
00060 FILES RFILE1,RFILE2,RFILE3
00080RESTORE#1
00081 INPUT# 1,I1,I2,I3
00085SCRATCH#1
00086 PRINT # 1,92,I2,I3
00090Z7=0
00095 DIM U(8),P(7,2)
00100RESTORE#3
00101 INPUT# 3,U
00105IF U=0 THEN 130
00110 FOR I=1 TO 8
00112 INPUT#3,U(I)
00113 NEXT I
00115GOTO 145
00120X=0
00125Z7=0
00130MAT U=ZER
00135U(1)=.0001
00140U(4)=.001
00145PRINT L$
00150O6=0
00155Z7=0
00160O6=0
00165PRINT " DETERMINATION OF CUT SCORES - RESTRICTED SELECTION"
00170PRINT
00175PRINT "THIS MODULE FINDS THE CUT SCORES FOR THE TWO GROUPS THAT DEFINE"
00180PRINT "THE SELECTION PROCEDURE THAT MAXIMIZES THE EXPECTED UTILITY GIVEN"
00185PRINT "THE CONSTRAINT THAT ONLY A CERTAIN PERCENTAGE OF THE TOTAL POOL"
00190PRINT "OF APPLICANTS IS TO BE ACCEPTED."
00195PRINT
00200PRINT "IT IS ASSUMED THAT THERE IS A SINGLE PREDICTOR AND THE PREDICTION"
00205PRINT "EQUATION IS LINEAR. THE PREDICTOR IS ASSUMED TO BE DISTRIBUTED"
00210PRINT "NORMALLY."
00215PRINT
00220GOTO 230
00225PRINT L$
00230PRINT "THERE IS A DEMONSTRATION DATA SET."
00235PRINT
00240PRINT "IF YOU WANT TO USE THE DEMONSTRATION DATA TYPE '1', ELSE '0'.";
00245GOSUB 9000
00250Z8=O1
00255I=1
00260GOSUB 2095
00265I=2
00270GOSUB 2095
00275X=0
00280X5=P(2,1)
00285Y6=P(4,1)
00290B6=P(5,1)*P(6,1)/P(3,1)
00295W6=P(1,1)
00300V6=W6*P(3,1)*P(3,1)
00305Y8=P(4,2)
00310X7=P(2,2)
00315B8=P(5,2)*P(6,2)/P(3,2)
00320W8=P(1,2)
00325V8=W8*P(3,2)*P(3,2)
00330S5=P(5,1)*P(5,1)*(1-P(6,1)*P(6,1))*W6
00335D8=P(3,2)
00340D6=P(3,1)
00345S7=P(5,2)*P(5,2)*(1-P(6,2)*P(6,2))*W8
00350PRINT L$
00355PRINT "HERE ARE THE DATA."
00360PRINT
00365PRINT " GROUP 1 GROUP 2"
00370:1. SAMPLE SIZE N ###### #######
00375PRINT USING 370,P(1,1),P(1,2)
00380:2. MEAN OF PREDICTOR X. ######.#### ######.####
00385PRINT USING 380,P(2,1),P(2,2)
00390:3. ST. DEV. OF PREDICTOR S.D.X######.#### ######.####
00395PRINT USING 390,P(3,1),P(3,2)
00400:4. MEAN OF CRITERION Y. ######.#### ######.####
00405PRINT USING 400,P(4,1),P(4,2)
00410:5. ST. DEV. OF CRITERION S.D.Y######.#### ######.####
00415PRINT USING 410,P(5,1),P(5,2)
00420:6. CORRELATION COEFFICIENT R ######.#### ######.####
00425PRINT USING 420,P(6,1),P(6,2)
00430PRINT
00435PRINT "IF THESE ARE THE DATA YOU WANT TYPE '1', ELSE '0'.";
00440GOSUB 9000
00445IF O1=1 THEN 455
00450GOTO 235
00455R7=W8/(W8+W6)
00460R6=1-R7
00465PRINT
00470PRINT "WHAT IS THE CRITERION THRESHOLD VALUE";
00475GOSUB 9000
00480C7=O1
00485IF O6=1 THEN 715
00490PRINT L$
00495PRINT "HERE ARE THE UTILITY STRUCTURES."
00500PRINT
00505:A = ACCEPTED AND SUCCESSFUL ###.## ###.##
00510PRINT USING 505,U(1),U(5)
00515:B = REJECTED AND SUCCESSFUL ###.## ###.##
00520PRINT USING 515,U(2),U(6)
00525:C = REJECTED AND UNSUCCESSFUL ###.## ###.##
00530PRINT USING 525,U(3),U(7)
00535:D = ACCEPTED AND UNSUCCESSFUL ###.## ###.##
00540PRINT USING 535,U(4),U(8)
00545PRINT
00550IF U(1)>U(4) THEN 565
00555PRINT "PLEASE SPECIFY THE UTILITY STRUCTURES FOR THE TWO GROUPS."
00560GOTO 585
00565PRINT "IF YOU WANT TO CHANGE THE UTILITIES TYPE '1', ELSE '0'.";
00570GOSUB 9000
00575IF O1=1 THEN 585
00580GOTO 715
00585PRINT
00590PRINT "INPUT A,B,C, AND D FOR GROUP 1";
00595GOSUB 9150
00600GOSUB 675
00605J=1
00610U(1)=O1
00615U(2)=O2
00620U(3)=O3
00625U(4)=O4
00630PRINT
00635PRINT "INPUT A,B,C, AND D FOR GROUP 2.";
00640GOSUB 9150
00645GOSUB 675
00650U(5)=O1
00655U(6)=O2
00660U(7)=O3
00665U(8)=O4
00670GOTO 465
00675IF O1>O2 THEN 690
00680PRINT "REENTER. A MUST BE GREATER THAN B AND C GREATER THAN D."
00685GOTO 705
00690IF O3>O4 THEN 700
00695GOTO 680
00700RETURN
00705GOSUB 9150
00710GOTO 675
00715W2=(U(1)-U(2)+U(3)-U(4))/(U(5)-U(6)+U(7)-U(8))
00720W1=(U(5)-U(6)-U(1)+U(2))/(U(2)-U(1)+U(4)-U(3))
00725PRINT L$
00730PRINT "HERE ARE CUT SCORES AND PERCENTAGES FOR QUOTA-FREE SELECTION."
00735PRINT
00740PRINT " GROUP 1 GROUP 2"
00745G=W6-2
00750P4=(U(1)-U(2))/(U(1)-U(2)+U(3)-U(4))
00755GOSUB 2520
00760IF J2>0 THEN 800
00765X6=X5+4*D6
00770GOSUB 1800
00775IF P<P4 THEN 785
00780GOTO 870
00785E1=X6
00790E0=C7/B6-Y6/B6+X5
00795GOTO 830
00800X6=X5-4*D6
00805GOSUB 1800
00810IF P>P4 THEN 820
00815GOTO 870
00820E0=X6
00825E1=C7/B6-Y6/B6+X5
00830X6=E0+.5*(E1-E0)
00835GOSUB 1800
00840IF ABS(P-P4)<.0045 THEN 870
00845IF P4>P THEN 860
00850E0=X6
00855GOTO 830
00860E1=X6
00865GOTO 830
00870G=W8-2
00875P4=(U(5)-U(6))/(U(5)-U(6)+U(7)-U(8))
00880GOSUB 2520
00885IF J2>0 THEN 925
00890X8=X7+4*D8
00895GOSUB 1865
00900IF P<P4 THEN 910
00905GOTO 995
00910E0=C7/B8-Y8/B8+X7
00915E1=X8
00920GOTO 955
00925X8=X7-4*D8
00930GOSUB 1865
00935IF P>P4 THEN 945
00940GOTO 995
00945E0=X8
00950E1=C7/B8-Y8/B8+X7
00955X8=E0+.5*(E1-E0)
00960GOSUB 1865
00965IF ABS(P4-P)<.0045 THEN 995
00970IF P4>P THEN 985
00975E0=X8
00980GOTO 955
00985E1=X8
00990GOTO 955
00995GOSUB 1745
01000:PREDICTOR CUT SCORE ######.# ######.#
01005PRINT USING 1000,X6,X8
01010:PERCENTAGE OF GROUP ACCEPTED######## ########
01015PRINT USING 1010,100-100*P6,100-100*P8
01020PRINT
01025:PERCENTAGE OF TOTAL APPLICANT POOL ACCEPTED########
01030PRINT USING 1025,100-P9*100
01035PRINT
01040PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
01045GOSUB 9000
01050PRINT L$
01055PRINT "HERE ARE THE CUT SCORES AND THE PERCENTAGES OF EACH GROUP"
01060PRINT "ACCEPTED GIVEN THAT A CERTAIN PERCENTAGE OF THE TOTAL IS"
01065PRINT "ACCEPTED."
01070PRINT
01075PRINT " PERCENT GROUP 1 GROUP 2"
01080PRINT " ACCEPTED CUT SCORE PERCENT CUT SCORE PERCENT"
01085U0=X7-5*D8
01090U1=X7+5*D8
01095FOR H9=.9 TO .1 STEP -.1
01100GOSUB 1110
01105GOTO 1275
01110U2=U0+.5*(U1-U0)
01115X8=U2
01120GOSUB 1660
01125: ### ######.# ### ######.# ###
01130IF ABS(H9-P9)<.0045 THEN 1265
01135IF H9>P9 THEN 1220
01140U1=U2
01145IF U1>X7-4*D8 THEN 1215
01150P8=0
01155P4=H9/R6
01160G=1000
01165GOSUB 2520
01170X6=X5+J2*D6
01175P6=P4
01180P9=P6*R6+P8*R7
01185RETURN
01190IF P8=0 THEN 1205
01195PRINT USING 1295,100-100*P9,X6,100-100*P6
01200GOTO 1360
01205PRINT USING 1310,100-100*P9,X6,100-100*P6
01210GOTO 1360
01215GOTO 1110
01220U0=U2
01225IF U0<X7+4*D8 THEN 1260
01230P8=1
01235P4=(H9-R7)/R6
01240GOSUB 2520
01245X6=X5+J2*D6
01250GOTO 1175
01255GOTO 1155
01260GOTO 1110
01265RETURN
01270:### #######.# ### #######.# ###
01275IF P6=1 THEN 1345
01280IF P6=0 THEN 1325
01285IF P8=0 THEN 1315
01290IF P8 <> 1 THEN 1355
01295: ### #######.# ### NONE
01300PRINT USING 1295,100-100*P9,X6,100-100*P6
01305GOTO 1360
01310: ### #######.# ### ALL
01315PRINT USING 1310,100-100*P9,X6,100-100*P6
01320GOTO 1360
01325: ### ALL ######.# ###
01330PRINT USING 1325,100-100*P9,X8,100-100*P8
01335GOTO 1360
01340: ### NONE ######.# ###
01345PRINT USING 1340,100-100*P9,X8,100-100*P8
01350GOTO 1360
01355PRINT USING 1125,100-100*P9,X6,100-100*P6,X8,100-100*P8
01360U1=X7+5*D8
01365U0=X7-5*D8
01370NEXT H9
01375PRINT
01380PRINT "IF YOU WANT TO SPECIFY THE PERCENTAGE ACCEPTED TYPE '1'."
01385PRINT "IF YOU DO NOT TYPE '0'.";
01390GOSUB 9000
01395IF O1=1 THEN 1495
01400PRINT L$
01405PRINT "HERE ARE THE AVAILABLE OPTIONS."
01410O6=0
01415PRINT
01420PRINT " 1. CHANGE THE SAMPLE DATA AND UTILITY STRUCTURES"
01425PRINT " 2. CHANGE THE SAMPLE DATA"
01430PRINT " 3. CHANGE THE UTILITIES"
01435PRINT
01440PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT (NONE=0).";
01445GOSUB 9000
01450IF O1 <> 0 THEN 1460
01455CHAIN "RSTRT"
01460IF O1=1 THEN 255
01465IF O1=2 THEN 1485
01470IF O1=3 THEN 490
01475PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
01480GOTO 1445
01485O6=1
01490GOTO 255
01495PRINT L$
01500PRINT "INPUT THE PERCENTAGE (NONE=0).";
01505GOSUB 9000
01510IF O1=0 THEN 1400
01515IF O1 >= 1 THEN 1530
01520PRINT "REENTER. PERCENTAGE MUST BE AT LEAST 1 AND NOT GREATER THAN 99."
01525GOTO 1505
01530IF O1>99 THEN 1520
01535H9=1-O1/100
01540U0=X7-5*D8
01545U1=X7+5*D8
01550GOSUB 1110
01555PRINT
01560IF P6<.995 THEN 1580
01565:GROUP ## NONE
01570PRINT USING 1565,1
01575GOTO 1610
01580IF P6>.0049 THEN 1600
01585:GROUP ## ALL
01590PRINT USING 1585,1
01595GOTO 1610
01600:GROUP ## CUT SCORE =######.# PERCENT =###
01605PRINT USING 1600,1,X6,100-100*P6
01610IF P8<.995 THEN 1625
01615PRINT USING 1565,2
01620GOTO 1645
01625IF P8>.0049 THEN 1640
01630PRINT USING 1585,2
01635GOTO 1645
01640PRINT USING 1600,2,X8,100-100*P8
01645PRINT
01650GOTO 1500
01655REM
01660GOSUB 1865
01665P4=W1+P/W2
01670IF P4>.001 THEN 1705
01675U0=X8
01680X8=U1
01685GOSUB 1865
01690IF W1+P/W2 <= .001 THEN 2335
01695X8=U0+.5*(U1-U0)
01700GOTO 1660
01705IF P4<.999 THEN 1740
01710U1=X8
01715X8=U0
01720GOSUB 1865
01725IF W1+P/W2 >= .999 THEN 2430
01730X8=U0+.5*U1-U0*.5
01735GOTO 1660
01740GOSUB 1910
01745Y3=(X6-X5)/D6
01750GOSUB 8000
01755P6=P
01760Y3=(X8-X7)/D8
01765GOSUB 8000
01770P8=P
01775P9=R6*P6+R7*P8
01780RETURN
01785REM
01790REM FINDING THE PREDICTIVE DISTRIBUTION FOR GROUP 1
01795REM
01800M6=Y6+B6*(X6-X5)
01805S6=S5*(1+1/W6+(X6-X5)*(X6-X5)/V6)
01810G=W6-2
01815J6=(C7-M6)/SQR(S6/G)
01820IF Z7=1 THEN 2005
01825J2=ABS(J6)
01830GOSUB 6000
01835IF J6 >= 0 THEN 1845
01840P=1-P
01845RETURN
01850REM
01855REM FINDING THE PREDICTIVE DISTRIBUTION FOR GROUP 2
01860REM
01865M8=Y8+B8*(X8-X7)
01870S8=S7*(1+1/W8+(X8-X7)*(X8-X7)/V8)
01875G=W8-2
01880J6=(C7-M8)/SQR(S8/G)
01885J2=ABS(J6)
01890GOSUB 6000
01895IF J6 >= 0 THEN 1905
01900P=1-P
01905RETURN
01910REM LOOKING FOR P4
01915Z7=1
01920P2=P4
01925G=W6-2
01930GOSUB 2520
01935Q2=J2
01940E0=X5-4*D6
01945E1=X5+4*D6
01950IF P4>.5 THEN 1975
01955E0=B6*X5-Y6+C7-Q2*SQR(S5/W6+S5/W6/W6)
01960E0=E0/B6
01965X6=E0+.001*(E1-E0)
01970GOTO 2000
01975E1=B6*X5-Y6+C7-Q2*SQR(S5/W6+S5/W6/W6)
01980E1=E1/B6
01985X6=E0+.995*(E1-E0)
01990GOTO 2000
01995X6=E0+.5*(E1-E0)
02000GOTO 1800
02005IF ABS(Q2-J6)<.0005 THEN 2085
02010IF Q2>J6 THEN 2060
02015E0=X6
02020IF E0<X5+4*D6 THEN 2055
02025P6=1
02030RETURN
02035G=1000
02040GOSUB 2520
02045X8=X7+J2*D8
02050RETURN
02055GOTO 1995
02060E1=X6
02065IF E1>X5-4*D6 THEN 2080
02070P6=0
02075RETURN
02080GOTO 1995
02085Z7=0
02090RETURN
02095PRINT L$
02100IF Z8 <> 1 THEN 2170
02105P(1,1)=2182
02110P(2,1)=19.03
02115P(3,1)=5.2763
02120P(4,1)=2.07
02125P(5,1)=1.0148
02130P(6,1)=.3732
02135P(1,2)=305
02140P(2,2)=13.47
02145P(3,2)=4.7872
02150P(4,2)=1.68
02155P(5,2)=1.0148
02160P(6,2)=.2772
02165GOTO 2330
02170PRINT "INPUT THE DATA FOR GROUP ";I
02175PRINT
02180PRINT "SAMPLE SIZE (N) =";
02185GOSUB 9000
02190IF O1>6 THEN 2205
02195PRINT "REENTER. MUST BE GREATER THAN 6."
02200GOTO 2185
02205P(1,I)=O1
02210PRINT "MEAN OF PREDICTOR (X.) =";
02215GOSUB 9000
02220P(2,I)=O1
02225PRINT "ST. DEV. OF PREDICTOR (S.D.X) =";
02230GOSUB 9000
02235IF O1>0 THEN 2250
02240PRINT "REENTER. STANDARD DEVIATION MUST BE GREATER THAN 0."
02245GOTO 2230
02250P(3,I)=O1
02255PRINT "MEAN OF CRITERION (Y.) =";
02260GOSUB 9000
02265P(4,I)=O1
02270PRINT "ST. DEV. OF CRITERION (S.D.Y) =";
02275GOSUB 9000
02280IF O1>0 THEN 2295
02285PRINT "REENTER. STANDARD DEVIATION MUST BE GREATER THAN 0."
02290GOTO 2275
02295P(5,I)=O1
02300PRINT "CORRELATION COEFFICIENT (R) =";
02305GOSUB 9000
02310IF O1>0 THEN 2325
02315PRINT "REENTER. CORRELATION COEFFICIENT MUST BE GREATER THAN 0"
02320PRINT "BUT NOT GGREATER THAN 1."
02325P(6,I)=O1
02330RETURN
02335REM ALL OF GROUP 2 ARE BETTER THAN THE REMAINING GROUP 1
02340Y3=(X8-X7)/D8
02350GOSUB 8000
02355P8=P
02360IF P8*R7+R6>H9 THEN 2395
02365G=2000
02370P4=(H9-R6)/R7
02375GOSUB 2520
02380X8=X7+J2*D8
02385P9=H9
02390RETURN
02395P4=(H9-P8*R7)/R6
02400G=2000
02405GOSUB 2520
02410X6=X5+J2*D6
02415P6=P4
02420P9=H9
02425RETURN
02430REM ALL OF GROUP 1 ARE BETTER THAN THE REMAINING GROUP 2
02435P9=H9
02440PRINT 4155
02445IF H9>R7 THEN 2485
02450P4=1-(R7-H9)/R7
02455G=2000
02460GOSUB 2520
02465X8=X7+J2*D8
02470P8=P4
02475P6=0
02480RETURN
02485P4=(H9-R7)/R6
02490G=2000
02495GOSUB 2520
02500X6=X5+J2*D6
02505P8=1
02510P6=P4
02515RETURN
02520REM********************** PERCENTILE FINDER **************************
05001P0=P4
05005P5=2
05010P6=2
05015P2=P0
05020GOSUB 5150
05025IF ABS(P-P0)<.0009 THEN 5145
05030IF P>P0 THEN 5065
05035E5=J2
05040P5=P
05045IF P6 <> 2 THEN 5095
05050P2=P2+.001
05055GOTO 5020
05060GOTO 5025
05065E6=J2
05070P6=P
05075IF P5 <> 2 THEN 5095
05080P2=P2-.001
05085GOTO 5020
05090GOTO 5025
05095J6=.5*(E6+E5)
05096J2=ABS(J6)
05100GOSUB 6000
05102IF J6 >= 0 THEN 5105
05103P=1-P
05104J2=-J2
05105IF ABS(P-P0)<.0009 THEN 5145
05110IF P>P0 THEN 5130
05115P5=P
05120E5=J6
05125GOTO 5095
05130E6=J6
05135P6=P
05140GOTO 5095
05145RETURN
05150P3=P2
05155IF P2 <= .5 THEN 5165
05160P2=1-P2
05165A1=SQR(LOG(1/P2/P2))
05170A2=2.51552+.802853*A1+.010328*A1*A1
05175A2=A2/(1+1.43279*A1+.189269*A1*A1+.001308*A1*A1*A1)
05180A2=A1-A2
05185J2=SQR(G*EXP(A2*(G-5/6)*A2/(G-2/3+.1/G)/(G-2/3+.1/G))-G)
05190GOSUB 6000
05195IF P3 <= .5 THEN 5210
05200P2=P3
05205GOTO 5220
05210J2=-J2
05215P=1-P
05220RETURN
05850REM ****************************************************
05852REM LOG GAMMA ROUTINE
05853REM INPUT G9
05854REM OUTPUT G0
05860G5=G9
05863IF G9 <= 1.E+30 THEN 5872
05866G0=1.E+38
05869RETURN
05872IF G9>1.E-09 THEN 5881
05875G0=0
05878RETURN
05881IF G9<1.E+10 THEN 5890
05884G0=G9*(LOG(G9)-1)
05887RETURN
05890G6=1
05893IF 18<G5 THEN 5905
05896G6=G6*G5
05899G5=G5+1
05902GOTO 5893
05905R8=1/G5/G5
05908G0=(G5-.5)*LOG(G5)-G5+.918939-LOG(G6)
05911C1=8.33333E-02
05914C2=2.77778E-03
05917C3=7.93651E-04
05920C4=5.95238E-04
05923G0=G0+1/G5*(C1-(R8*(C2+(R8*(C3-(R8*(C4)))))))
05926RETURN
05927REM END OF LOG GAMMA ROUTINE
05928REM ****************************************************
06000REM****************************************************************
06002REM STUDENT'S T CDF ROUTINE
06004REM INPUT G J2
06006REM OUTPUT P
06007REM PRIOR GOSUB 6060
06008P=0
06009IF J2<.0001 THEN 6056
06010GOTO 6015
06011IF J2<6 THEN 6016
06012P=1
06014GOTO 6058
06015IF J2>12 THEN 6012
06016 DIM W(16),O(16)
06018Y3=J2
06020GOTO 6026
06021Y3=(G-2/3+.1/G)*SQR(ABS(LOG(1+J2*J2/G))/(G-5/6))
06022GOSUB 8000
06024GOTO 6058
06025REM PEIZER PRATT APPROXIMATION
06026IF G=1 THEN 6098
06028J1=0
06030N=G
06032P=0
06034GOSUB 6084
06036D0=(J2-J1)*.5
06038D1=(J1+J2)*.5
06040FOR I1=1 TO 16
06042D9=D0*O(I1)+D1
06044IF D9=0 THEN 6050
06046IF D9=1 THEN 6050
06048P=P+W(I1)*(EXP(-(N+1)/2*LOG(1+D9*D9/N)))
06050NEXT I1
06052P=P*F0
06054P=P*D0
06056P=P+.5
06058RETURN
06060FOR I1=1 TO 16
06062READ W(I1),O(I1)
06064NEXT I1
06066DATA 2.71525E-02,-.989401
06068DATA 6.22535E-02,-.944575,9.51585E-02,-.865631
06070DATA .124629,-.755404,.149596,-.617876
06072DATA .169156,-.458017,.182603,-.281604,.189451,-9.50125E-02
06074DATA .189451,9.50125E-02,.182603,.281604,.169156,.458017
06076DATA .149596,.617876,.124629,.755404
06078DATA 9.51585E-02,.865631,6.22535E-02,.944575,2.71525E-02
06080DATA .989401
06082RETURN
06084G9=(N+1)/2
06086GOSUB 5850
06088F0=G0
06090G9=N/2
06092GOSUB 5850
06094F0=EXP(F0-G0)/SQR(3.14159*N)
06096RETURN
06098REM FOLLOWING FOR NU=1
06100P=.5+1/3.14159*ATN(Y3)
06102RETURN
06104REM END OF STUDENT'S T CDF ROUTINE
06106REM*************************************************************
07500REM ************************************************************
07501REM STUDENT'S T DISTRIBUTION HIGHEST DENSITY REGIONS
07502REM INPUTS G J5
07503REM J2
07504REM
07505Z8=.5
07506N=G
07507X9=1
07508J1=0
07509J2=X9
07510GOSUB 6000
07511P=2*P-1
07512Z9=P
07513IF P>J5 THEN 7517
07514X9=X9+2
07515Z8=Z9
07516GOTO 7508
07517X0=X9-2
07518X2=X9
07519X9=X0+(J5-Z8)*(X2-X0)/(Z9-Z8)
07520J1=0
07521J2=X9
07522GOSUB 6000
07523P=2*P-1
07524IF ABS(X2-X9)<.0001 THEN 7541
07525IF P<J5 THEN 7538
07526X2=X9
07527Z9=P
07528X9=(J5-Z8)/(Z9-Z8)
07530IF X9<.85 THEN 7533
07531X9=X0+.85*(X2-X0)
07532GOTO 7520
07533IF X9>.15 THEN 7536
07534X9=X0+.15*(X2-X0)
07535GOTO 7520
07536X9=X0+X9*(X2-X0)
07537GOTO 7520
07538X0=X9
07539Z8=P
07540GOTO 7528
07541J2=X9
07542RETURN
07543REM
07544REM END OF STUDENT'S T HDR ROUTINE
07545REM *********************************************************
08000REM **********************************************************
08001REM ROUTINE CALCULATES THE CDF FOR NORMAL DISTRIBUTION
08002REM INPUT Y3
08003REM OUTPUT P
08004REM
08005Y4=ABS(Y3)
08010X1=X
08015X=Y3
08020T=1/(1+.231642*Y4)
08021IF X*X/2<80 THEN 8025
08022D=0
08023GOTO 8030
08025D=.398942*EXP(-X*X/2)
08030C1=1.33027
08035C2=1.82126
08040C3=1.78148
08045C4=.356564
08050C5=.319382
08055P=1-D*T*((((C1*T-C2)*T+C3)*T-C4)*T+C5)
08060IF X >= 0 THEN 8070
08065P=1-P
08070X=X1
08075RETURN
08076REM
08077REM END OF NORMAL CDF ROUTINE
08078REM **********************************************************
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09050REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 2 INPUTS
09055INPUT O1,O2
09065IF O1=-9999 THEN 9080
09070IF O2=-9999 THEN 9080
09075RETURN
09080CHAIN "RSTRT"
09090REM*************END ROUTINE
09100REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 3 INPUTS
09105INPUT O1,O2,O3
09115IF O1=-9999 THEN 9135
09120IF O2=-9999 THEN 9135
09125IF O3=-9999 THEN 9135
09130RETURN
09135CHAIN "RSTRT"
09145REM*************END ROUTINE
09150REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED
09160REM--4 INPUTS
09170INPUT O1,O2,O3,O4
09200IF O1=-9999 THEN 9250
09210IF O2=-9999 THEN 9250
09220IF O3=-9999 THEN 9250
09230IF O4=-9999 THEN 9250
09240RETURN
09250REM
09255CHAIN "RSTRT"
09270REM*************END ROUTINE
09999 END