Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50422/cmody.bas
There are 2 other files named cmody.bas in the archive. Click here to see a list.
00020REM*****************************************************************
00030REM CMODY CMODY CMODY CMODY CMODY CMODY CMODY
00040REM*****************************************************************
00050 FILES RFILE1,RFILE2,RFILE3
00060X=0
00070L9=0
00110RESTORE#1
00111 INPUT# 1,I1,I2,I3
00120SCRATCH#1
00121 PRINT # 1,34,I2,I3
00130RESTORE#3
00131 INPUT# 3,A,B
00140IF A=0 THEN 180
00150L9=1
00160R1=A
00170N1=A+B
00180PRINT L$
00190PRINT " EVALUATION OF BETA PASCAL DISTRIBUTION"
00200PRINT
00210S9=0
00220S7=0
00230PRINT "THIS MODULE WILL HELP YOU EXAMINE THE CHARACTERISTICS OF A"
00240PRINT "BETA PASCAL DISTRIBUTION."
00250PRINT
00260PRINT "N IS ASSUMED TO HAVE A PASCAL DISTRIBUTION WITH"
00270PRINT "SUCCESS PARAMETER S AND PROCESS (PROPORTION) PARAMETER P."
00280PRINT
00290PRINT "P IS ASSUMED TO HAVE A BETA DISTRIBUTION WITH PARAMETERS A"
00300PRINT "AND B."
00310PRINT
00320IF L9=1 THEN 500
00330PRINT "INPUT THE PARAMETERS OF THE BETA DISTRIBUTION ON THE PROCESS"
00340PRINT "PARAMETER P."
00350PRINT
00360PRINT "INPUT A.";
00370GOSUB 9000
00380R1=O1
00390IF R1 >= 1.15 THEN 420
00400PRINT "REENTER. PARAMETERS MUST BE AT LEAST 1.15."
00410GOTO 370
00420PRINT "INPUT B.";
00430S7=0
00440GOSUB 9000
00450IF O1 >= 1.15 THEN 480
00460PRINT "REENTER. PARAMETERS MUST BE AT LEAST 1.15."
00470GOTO 440
00480N1=O1+R1
00490PRINT
00500PRINT "INPUT THE SUCCESS PARAMETER S.";
00510GOSUB 9000
00520IF O1 >= 1 THEN 550
00530PRINT "REENTER. S MUST BE AT LEAST 1."
00540GOTO 510
00550R0=O1
00560PRINT L$
00570PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
00580PRINT " 1. PROBABILITIES THAT THE NUMBER (N) OF TRIALS NEEDED"
00590PRINT " WILL BE LESS THAN X, EQUAL TO X, AND GREATER THAN X."
00600PRINT " 2. PROBABILITY THAT THE NUMBER (N) OF TRIALS NEEDED "
00610PRINT " WILL BE BETWEEN X1 AND X2 INCLUSIVE."
00620IF L9=1 THEN 650
00630PRINT " 3. EXIT MODULE."
00640GOTO 720
00650PRINT " 3. EVALUATE POSTERIOR DISTRIBUTION."
00660PRINT " 4. EXIT MODULE."
00670GOSUB 9000
00680IF O1 <> 3 THEN 700
00690CHAIN "CMODB"
00700IF O1=4 THEN 790
00710GOTO 740
00720GOSUB 9000
00730IF O1=3 THEN 790
00740IF O1=1 THEN 800
00750IF O1=2 THEN 1350
00760PRINT "REENTER. INPUT MUST BE NUMBER OF AVAILABLE OPTION."
00770IF L9=1 THEN 670
00780GOTO 720
00790CHAIN "RSTRT"
00800PRINT L$
00810PRINT " OPTION 1: PROBABILITIES THAT THE NUMBER (N) OF TRIALS"
00820PRINT " NEEDED WILL BE LESS THAN X, EQUAL TO X, AND GREATER THAN X."
00830PRINT
00840PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED TO INPUT X."
00850GOSUB 1730
00860PRINT" X P( N<X ) P( N=X ) P( N>X )"
00880PRINT "INPUT X.";
00890GOSUB 9000
00900IF O1=-1 THEN 1600
00910IF O1 >= R0 THEN 1310
00920PRINT "REENTER. N MUST BE"
00930PRINT "AT LEAST AS LARGE AS S."
00940GOTO 890
00950PRINT "REENTER. CAN NOT COMPUTE PROBABILITIES FOR AN N THIS LARGE."
00960GOTO 890
00970IF O1>R0+5 THEN 1170
00980IF O1=R0 THEN 1100
00990R=R0
01000G1=0
01010FOR N=R0 TO O1-1
01020GOSUB 1820
01030G1=G1+F8
01040NEXT N
01050N=O1
01060GOSUB 1820
01070G2=F8
01080G3=1-G1-G2
01090RETURN
01100N=O1
01110R=R0
01120GOSUB 1820
01130G1=0
01140G2=F8
01150G3=1-F8
01160RETURN
01170M=R0+R1-1
01180R=R0
01190N0=O1-1
01200N=N0+N1-1
01210GOSUB 7000
01220R=R0
01230N0=N0+1
01240N=N0+N1-1
01250Q0=G3+G2
01260GOSUB 7000
01270G1=Q0
01280G2=G3+G2-Q0
01290G3=1-G1-G2
01300RETURN
01310GOSUB 970
01320: ##### ##.## ##.## ##.##
01330PRINT USING 1320,O1,G1,G2,G3
01340GOTO 880
01350PRINT L$
01360PRINT " OPTION 2: PROBABILITY THAT THE NUMBER (N) OF TRIALS"
01370PRINT " WILL BE BETWEEN X1 AND X2 INCLUSIVE."
01380PRINT
01390PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED FOR INPUT."
01400GOSUB 1730
01410PRINT "INPUT X1 AND X2.";
01420GOSUB 9050
01430IF O1 <> -1 THEN 1460
01440IF O2=-1 THEN 1600
01450GOTO 1490
01460X1=O1
01470X2=O2
01480IF X2>X1 THEN 1510
01490PRINT "REENTER. INPUT THE LARGER X (X2) FIRST."
01500GOTO 1420
01510O1=X1
01520GOSUB 970
01530Q7=G1
01540O1=X2
01550GOSUB 970
01560G2=1-Q7-G3
01570: PROB(##### <= S <=##### ) =##.##
01580PRINT USING 1570,X1,X2,G2
01590GOTO 1410
01600PRINT L$
01610IF L9=1 THEN 570
01620PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
01630PRINT " 1. FURTHER EVALUATE THIS DISTRIBUTION."
01640PRINT " 2. EVALUATE ANOTHER BETA PASCAL DISTRIBUTION."
01650PRINT " 3. EXIT MODULE."
01660GOSUB 9000
01670IF O1=3 THEN 790
01680IF O1=1 THEN 560
01690IF O1=2 THEN 1700
01700PRINT L$
01710S9=0
01720GOTO 330
01730PRINT "---------------------------------------------------------------"
01740PRINT " BETA PASCAL DISTRIBUTION"
01750:P DISTRIBUTED BETA ( A =#####.## B =#####.## )
01760PRINT USING 1750,R1,N1-R1
01770:SUCCESS PARAMETER S =#### MEAN =####.##
01780PRINT USING 1770,R0,R0*(N1-1)/(R1-1)
01790PRINT "---------------------------------------------------------------"
01800RETURN
01810REM------------ BETA PASCAL PDF ----------------------
01820 DIM N(4),D(5)
01830N(1)=R+R1-1
01840N(2)=N+N1-R-R1-1
01850N(3)=N-1
01860N(4)=N1-1
01870D(1)=R-1
01880D(2)=R1-1
01890D(3)=N-R
01900D(4)=N1-R1-1
01910D(5)=N+N1-1
01920F0=0
01930FOR K5=1 TO 4
01940G9=N(K5)
01950G9=G9+1
01960GOSUB 2100
01970F0=F0+G0
01980G9=D(K5)
01990G9=G9+1
02000GOSUB 2100
02010F0=F0-G0
02020NEXT K5
02030G9=D(5)
02040G9=G9+1
02050GOSUB 2100
02060F0=F0-G0
02070N8=N
02080F8=EXP(F0)
02090RETURN
02100REM ****************************************************
02110REM LOG GAMMA ROUTINE
02120REM INPUT G9
02130REM OUTPUT G0
02140G5=G9
02150IF G9 <= 1.E+30 THEN 2180
02160G0=1.E+38
02170RETURN
02180IF G9>1.E-09 THEN 2210
02190G0=0
02200RETURN
02210IF G9<1.E+10 THEN 2240
02220G0=G9*(LOG(G9)-1)
02230RETURN
02240G6=1
02250IF 18<G5 THEN 2290
02260G6=G6*G5
02270G5=G5+1
02280GOTO 2250
02290R8=1/G5**2
02300G0=(G5-.5)*LOG(G5)-G5+.918939-LOG(G6)
02310C1=8.33333E-02
02320C2=2.77778E-03
02330C3=7.93651E-04
02340C4=5.95238E-04
02350G0=G0+1/G5*(C1-(R8*(C2+(R8*(C3-(R8*(C4)))))))
02360RETURN
02370REM END OF LOG GAMMA ROUTINE
02380REM ****************************************************
07000 DIM A(18),B(18)
07010G2=0
07020G1=0
07030G3=0
07040GOSUB 7230
07050GOSUB 7330
07060G1=P
07070R=R+1
07080GOSUB 7230
07090GOSUB 7330
07100G2=P-G1
07110G3=1-P
07130R=R-1
07140O1=0
07142IF O1>N0-N+M THEN 7144
07143O1=N0-N+M
07144IF R=O1 THEN 7170
07150O1=M
07152IF O1<N0 THEN 7154
07153O1=N0
07154IF R=O1 THEN 7200
07160RETURN
07170G3=G3+G1
07180G1=0
07190RETURN
07200G1=G1+G3
07210G3=0
07220RETURN
07230T8=SQR((M*N0*(N-M)*(N-N0))/(N**3))
07240X8=((R-.5)-((N0*M)/N))/T8
07250M8=(N-N0)/N
07260N8=N0/N
07270R8=M/N
07280S8=(N-M)/N
07290DEF FNA(X)=((5-(14*M8*N8)-(14*R8*S8)+(38*M8*N8*R8*S8))*(X8**3))
07300DEF FNB(X)=((-2+(2*M8*N8)+(2*R8*S8)+(10*M8*N8*R8*S8))*X8)
07310Z=X8+((M8-N8)*(S8-R8)*(1-(X8**2)))/(6*T8)+(FNA(X)+FNB(X))/(72*(T8**2))
07320RETURN
07330A1=ABS(Z)
07340T=1/(1+(.231642*A1))
07350D=.398942*EXP(-Z*Z/2)
07360P=1-D*T*((((1.33027*T-1.82126)*T+1.78148)*T-.356564)*T+.319381)
07370IF Z<0 THEN 7390
07380GOTO 7400
07390P=1-P
07400RETURN
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
09999 END