Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50422/cmodx.bas
There are 2 other files named cmodx.bas in the archive. Click here to see a list.
00020REM*****************************************************************
00030REM CMODX CMODX CMODX CMODX CMODX CMODX CMODX
00040REM*****************************************************************
00050 FILES RFILE1,RFILE2,RFILE3
00060X=0
00070L9=0
00110RESTORE#1
00111 INPUT# 1,I1,I2,I3
00120SCRATCH#1
00121 PRINT # 1,33,I2,I3
00130RESTORE#3
00131 INPUT# 3,A,B
00140IF A=0 THEN 180
00150L9=1
00160R1=A
00170N1=A+B
00180PRINT L$
00190PRINT " EVALUATIN OF A BETA-BINOMIAL DISTRIBUTION"
00200PRINT
00210PRINT "THIS MODULE WILL HELP YOU EXAMINE THE CHARACTERISTICS OF A"
00220PRINT "BETA BINOMIAL DISTRIBUTION."
00230PRINT
00240PRINT "X IS ASSUMED TO HAVE A BINOMIAL DISTRIBUTION WITH SAMPLE SIZE"
00250PRINT "PARAMETER N AND PROCESS (PROPORTION) PARAMETER P."
00260PRINT "(NOTE: N MUST NOT BE GREATER THAN 200.)"
00270PRINT
00280PRINT "P IS ASSUMED TO HAVE A BETA DISTRIBUTION WITH PARAMETERS A "
00290PRINT "AND B."
00300PRINT
00305IF L9=1 THEN 480
00310PRINT "INPUT THE PARAMETERS OF THE BETA DISTRIBUTION ON THE"
00320PRINT "PARAMETER P."
00330PRINT
00350PRINT "INPUT A.";
00360GOSUB 9000
00370R1=O1
00380IF R1 >= 1.15 THEN 410
00390PRINT "REENTER. PARAMETERS MUST BE AT LEAST 1.15."
00400GOTO 360
00410PRINT "INPUT B.";
00420GOSUB 9000
00430IF O1 >= 1.15 THEN 460
00440PRINT "REENTER. PARAMETERS MUST BE AT LEAST 1.15."
00450GOTO 420
00460N1=O1+R1
00470PRINT
00480PRINT "INPUT THE SAMPLE SIZE PARAMETER N (MAX=200).";
00490GOSUB 9000
00500IF O1>200 THEN 520
00510IF O1 >= 1 THEN 540
00520PRINT "REENTER. N MUST BE AT LEAST 1 AND NOT GREATER THAN 1000."
00530GOTO 490
00540N=O1
00550V2=N*R1/N1
00560V3=SQR(N*(N+N1)*R1*(N1-R1)/N1/N1/(N1+1))
00570GOSUB 1700
00580PRINT L$
00590PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
00600PRINT " 1. PROBABILITIES THAT THE NUMBER OF SUCCESSES WILL BE"
00610PRINT " LESS THAN X, EQUAL TO X, AND GREATER THAN X."
00620PRINT " 2. PROBABILITY THAN THE NUMBER OF SUCCESSES WILL BE"
00630PRINT " FROM X1 THROUGH X2."
00640IF L9=0 THEN 710
00650PRINT " 3. EVALUATE POSTERIOR DISTRIBUTION."
00660PRINT " 4. EXIT MODULE."
00670GOSUB 9000
00680IF O1=4 THEN 790
00690IF O1 <> 3 THEN 740
00700CHAIN "CMODB"
00710PRINT " 3. EXIT MODULE."
00720GOSUB 9000
00730IF O1=3 THEN 790
00740IF O1=1 THEN 800
00750IF O1=2 THEN 1030
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 OF SUCCESSES (S)"
00820PRINT " 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 1460
00860PRINT" X P( S<X ) P( S=X ) P( S>X ) "
00870 REM
00880PRINT "INPUT X.";
00890GOSUB 9000
00900IF O1=-1 THEN 1340
00910IF O1 >= 0 THEN 960
00920PRINT "REENTER. X MUST BE"
00930PRINT "AT LEAST 0 BUT NOT"
00940PRINT "GREATER THAN N."
00950GOTO 890
00960IF O1>N THEN 920
00970X=O1
00980R=X
00990GOSUB 1560
01000: ##### ##.## ##.## ##.##
01010PRINT USING 1000,R,G1,G2,G3
01020GOTO 880
01030PRINT L$
01040PRINT " OPTION 2: PROBABILITY THAT NUMBER OF SUCCESSES (S) WILL"
01050PRINT " FROM X1 TO X2 INCLUSIVE."
01060PRINT
01070PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED FOR INPUT."
01080GOSUB 1460
01090PRINT "INPUT X1 AND X2.";
01100GOSUB 9050
01110IF O1 <> -1 THEN 1140
01120IF O2=-1 THEN 1340
01130GOTO 1230
01140X1=O1
01150X2=O2
01160IF X2>X1 THEN 1190
01170PRINT "REENTER. INPUT THE LARGER X (X2) FIRST."
01180GOTO 1100
01190IF X2 <= N THEN 1220
01200PRINT "REENTER. X'S MUST BE NO LARGER THAN N."
01210GOTO 1100
01220IF X1 >= 0 THEN 1250
01230PRINT "REENTER. X'S MUST BE AT LEAST 0."
01240GOTO 1100
01250R=X1
01260T8=R
01270GOSUB 1560
01280T9=G1
01290R=X2
01300GOSUB 1560
01310: PROB(##### <= S <=##### ) =##.##
01320PRINT USING 1310,T8,R,1-G3-T9
01330GOTO 1090
01340PRINT L$
01350IF L9=1 THEN 590
01360PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
01370PRINT " 1. FURTHER EVALUATE THIS BETA BINOMIAL DISTRIBUTION."
01380PRINT " 2. EVALUATE ANOTHER BETA BINOMIAL DISTRIBUTION."
01390PRINT " 3. EXIT MODULE."
01400GOSUB 9000
01410IF O1=3 THEN 790
01420IF O1=1 THEN 580
01430IF O1=2 THEN 1440
01440PRINT L$
01450GOTO 310
01460PRINT "---------------------------------------------------------------"
01470PRINT " BETA BINOMIAL DISTRIBUTION"
01480:PROCESS PARAMETER P: BETA (A =####.## B =####.##)
01490PRINT USING 1480,R1,N1-R1
01500:SAMPLE SIZE PARAMETER N =####
01510PRINT USING 1500,N
01520:MEAN =####.## STANDARD DEVIATION =####.##
01530PRINT USING 1520,N*R1/N1,V3
01540PRINT "---------------------------------------------------------------"
01550RETURN
01560IF R=0 THEN 1620
01570IF R=N THEN 1660
01580G1=B(R)
01590G2=B(R+1)-G1
01600G3=1-B(R+1)
01610RETURN
01620G2=B(1)
01630G1=0
01640G3=1-G2
01650RETURN
01660G3=0
01670G1=B(R)
01680G2=1-G1
01690RETURN
01700 DIM B(1001)
01710MAT B=ZER
01720REM************************** BETA-BINOMIAL *******************
01730 DIM N(4),D(5)
01740R=INT(R1*N/N1)
01750N(1)=R+R1-1
01760N(2)=N+N1-R-R1-1
01770N(3)=N
01780N(4)=N1-1
01790D(1)=R
01800D(2)=R1-1
01810D(3)=N-R
01820D(4)=N1-R1-1
01830D(5)=N+N1-1
01840F0=0
01850FOR K5=1 TO 4
01860G9=N(K5)
01870G9=G9+1
01880GOSUB 5850
01890F0=F0+G0
01900G9=D(K5)
01910G9=G9+1
01920GOSUB 5850
01930F0=F0-G0
01940NEXT K5
01950G9=D(5)
01960G9=G9+1
01970GOSUB 5850
01980F0=F0-G0
01990N8=N
02000F8=EXP(F0)
02010F6=F8
02020T8=F8
02030B(R+1)=F8
02040FOR R8=R+1 TO N
02050IF F8<1.E-11 THEN 2100
02060GOSUB 2230
02070F8=F8*F7
02080T8=T8+F8
02090B(R8+1)=F8
02100NEXT R8
02110F8=F6
02120FOR R8=R TO 1 STEP -1
02130IF F8<1.E-11 THEN 2220
02140GOSUB 2230
02150F8=F8/F7
02160T8=T8+F8
02170B(R8)=F8
02180NEXT R8
02190FOR I8=2 TO 201
02200B(I8)=B(I8)+B(I8-1)
02210NEXT I8
02220RETURN
02230F7=(R1-1+R8)*(N8+1-R8)/(R8*(N8+N1-R1-R8))
02240RETURN
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**2
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 ****************************************************
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