Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0113/cmodv.bas
There are 2 other files named cmodv.bas in the archive. Click here to see a list.
00020REM*****************************************************************
00030REM    CMODV    CMODV     CMODV     CMODV     CMODV    CMODV
00040  FILES RFILE1,RFILE2,RFILE3
00050X=0
00090RESTORE#1
00091  INPUT#  1,I1,I2,I3
00100SCRATCH#1
00101  PRINT #  1,31,I2,I3
00110PRINT L$
00120PRINT "             EVALUATION  OF  BINOMIAL  DISTRIBUTION"
00130PRINT
00140PRINT "THIS MODULE WILL HELP YOU EXAMINE THE CHARACTERISTICS OF A"
00150PRINT "BINOMIAL DISTRIBUTION."
00160PRINT
00170PRINT "INPUT THE PARAMETERS OF THE BINOMIAL DISTRIBUTION YOU WANT TO"
00180PRINT "EXAMINE."
00190PRINT
00200PRINT "INPUT THE PROCESS PARAMETER P.";
00210GOSUB 9000
00220P=O1
00230IF P>0 THEN 260
00240PRINT "REENTER.  P MUST BE BETWEEN 0 AND 1."
00250GOTO 210
00260IF P >= 1 THEN 240
00270PRINT
00280PRINT "INPUT THE SIZE PARAMETER N.";
00290GOSUB 9000
00300IF INT(O1)>0 THEN 320
00310PRINT "REENTER.  N MUST BE GREATER THAN 0."
00320N=O1
00330PRINT L$
00340PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
00350PRINT "     1. PROBABILITIES THAT THE NUMBER OF SUCCESSES WILL BE"
00360PRINT "        LESS THAN X, EQUAL TO X, AND GREATER THAN X."
00370PRINT "     2. PROBABILITY THAT THE NUMBER OF SUCCESSES WILL BE"
00380PRINT "        AT LEAST X1 BUT NOT MORE THAN X2."
00390PRINT "     3. EXIT MODULE."
00400GOSUB 9000
00410IF O1=3 THEN 460
00420IF O1=1 THEN 470
00430IF O1=2 THEN 700
00440PRINT "REENTER.  INPUT MUST BE NUMBER OF AVAILABLE OPTION."
00450GOTO 400
00460CHAIN "RSTRT"
00470PRINT L$
00480PRINT "     OPTION 1:  PROBABILITIES THAT THE NUMBER OF SUCCESSES (S)"
00490PRINT "                WILL BE LESS THAN X, EQUAL TO X, AND MORE THAN X."
00500PRINT
00510PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED TO INPUT X."
00520GOSUB 1120
00530PRINT"                        0   P( S < X )   P( S=X )   P( S >X ) " 
00540REM
00550PRINT "INPUT X.";
00560GOSUB 9000
00570IF O1=-1 THEN 1010
00580IF O1 >= 0 THEN 630
00590PRINT "REENTER.  X MUST BE"
00600PRINT "AT LEAST 0 BUT NOT"
00610PRINT "GREATER THAN N."
00620GOTO 560
00630IF O1>N THEN 590
00640X=O1
00650R=X
00660GOSUB 1200
00670:                    #####     ##.##       ##.##       ##.##
00680PRINT  USING 670,R,G1,G2,G3
00690GOTO 550
00700PRINT L$
00710PRINT "     OPTION 2:  PROBABILITY THAT THE NUMBER OF SUCCESSES (S)"
00720PRINT "                WILL BE AT LEAST X1 BUT NOT MORE THAN X2."
00730PRINT
00740PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED FOR INPUT."
00750GOSUB 1120
00760PRINT "INPUT X1 AND X2.";
00770GOSUB 9050
00780IF O1 <> -1 THEN 810
00790IF O2=-1 THEN 1010
00800GOTO 900
00810X1=O1
00820X2=O2
00830IF X2>X1 THEN 860
00840PRINT "REENTER.  INPUT THE LARGER X (X2) FIRST."
00850GOTO 770
00860IF X2 <= N THEN 890
00870PRINT "REENTER.  X'S MUST BE NO LARGER THAN N."
00880GOTO 770
00890IF X1 >= 0 THEN 920
00900PRINT "REENTER.  X'S MUST BE AT LEAST 0."
00910GOTO 770
00920R=X1
00930T8=R
00940GOSUB 1200
00950T9=G1
00960R=X2
00970GOSUB 1200
00980:                         PROB(#####<= S <=##### ) =##.##
00990PRINT  USING 980,T8,R,1-G3-T9
01000GOTO 760
01010PRINT L$
01020PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
01030PRINT "     1. FURTHER EVALUATE THIS BINOMIAL DISTRIBUTION."
01040PRINT "     2. EVALUATE ANOTHER BINOMIAL DISTRIBUTION."
01050PRINT "     3. EXIT MODULE."
01060GOSUB 9000
01070IF O1=3 THEN 460
01080IF O1=1 THEN 330
01090IF O1=2 THEN 1100
01100PRINT L$
01110GOTO 170
01120PRINT "---------------------------------------------------------------"
01130PRINT "               BINOMIAL   DISTRIBUTION"
01140:SIZE PARAMETER N =#####           MEAN =#####
01150PRINT  USING 1140,N,N*P
01160:PROCESS PARAMETER P =##.##        STANDARD DEVIATION =###.##
01170PRINT  USING 1160,P,SQR(P*(1-P)*N)
01180PRINT "---------------------------------------------------------------"
01190RETURN
01200REM
01210DEF FNA(X)=S2*(P**(INT(X1/2)))*((1-P)**(INT((N-X1)/2)))*FNZ(X)
01215DEF FNZ(X)=S9*(P**(X1-INT(X1/2)))*((1-P)**((N-X1)-(INT((N-X1)/2))))
01220G1=0
01230G3=0
01240M1=N*P
01250S5=6*(SQR(N*P*(1-P)))
01260H=(INT(M1+S5))+1
01270L=INT(M1-S5)
01280IF H>N THEN 1310
01290IF L<0 THEN 1330
01300GOTO 1340
01310H=N
01320GOTO 1290
01330L=0
01340K=15
01350K2=40
01360IF N <= K2 THEN 1410
01370T3=N*P
01372IF P<1-P THEN 1380
01374T3=N*(1-P)
01380IF T3>K THEN 2030
01382IF N>20000 THEN 2030
01390IF T3 <= .8*K THEN 1395
01391IF N>1001 THEN 2030
01395IF T3 <= 8.5/15*K THEN 1400
01396IF N>2001 THEN 2030
01400IF T3 <= 7/15*K THEN 1405
01401IF N>5001 THEN 2030
01405IF T3 <= 5.6/15*K THEN 1410
01406IF N>10001 THEN 2030
01410IF R <= H THEN 1420
01415IF H <> N THEN 1450
01420IF R >= L THEN 1430
01425IF L <> 0 THEN 1490
01430IF (R-L)>(H-R) THEN 1850
01440GOTO 1530
01450G1=1
01460G2=0
01470G3=0
01480GOTO 2270
01490G1=0
01500G2=0
01510G3=1
01520GOTO 2270
01530IF R=0 THEN 1750
01540IF R=L THEN 1790
01550FOR X1=L TO R-1
01560GOSUB 1610
01570S2=FNA(X)
01580G1=G1+S2
01590NEXT X1
01600GOTO 1800
01610IF X1=0 THEN 1720
01615IF X1=N THEN 1720
01620S2=1
01630S9=1
01640J=X1
01642IF X1<N-X1 THEN 1650
01644J=N-X1
01650FOR I=1 TO J
01660IF S2>1.E+33 THEN 1690
01670S2=S2*((N+1)-I)/I
01680GOTO 1700
01690S9=S9*((N+1)-I)/I
01700NEXT I
01710GOTO 1740
01720S2=1
01730S9=1
01740RETURN
01750G1=0
01760G2=(1-P)**N
01770G3=1-G2
01780GOTO 2270
01790G1=0
01800X1=R
01810GOSUB 1610
01820G2=FNA(X)
01830G3=1-(G2+G1)
01840GOTO 2270
01850IF R <> N THEN 1900
01860G3=0
01870G2=P**N
01880G1=1-G2
01890GOTO 2270
01900IF R <> H THEN 1930
01910G3=0
01920GOTO 1980
01930FOR X1=R+1 TO H
01940GOSUB 1610
01950S2=FNA(X)
01960G3=G3+S2
01970NEXT X1
01980X1=R
01990GOSUB 1610
02000G2=FNA(X)
02010G1=1-(G2+G3)
02020GOTO 2270
02030REM
02040S5=(SQR(N*P*(1-P)))
02050M1=N*P
02060U1=(R-M1-.5)/S5
02070Q=1-P
02080DEF FNB(X)=U1+((Q-P)/S5*((-1*(U1**2))+1)/6)+FNY(X)
02085DEF FNY(X)=((1/(S5**2))*(((5-(14*P*Q))*(U1**3))+((-2+(2*P*Q))*U1))/72)
02090DEF FNC(X)=((Q-P)/S5/S5/S5*(FNX(X)+((79-28*P*Q)*U1*U1)+128-26*P*Q)/6480)
02095DEF FNX(X)=((-249+(438*P*Q))*(U1**4))
02100Z=FNB(X)+FNC(X)
02110GOSUB 2190
02120G1=P1
02130U1=(R-M1+.5)/S5
02140Z=FNB(X)+FNC(X)
02150GOSUB 2190
02160G2=P1-G1
02170G3=1-P1
02180GOTO 2270
02190A1=ABS(Z)
02200T=1/(1+(.231642*A1))
02210D=.398942*EXP(-Z*Z/2)
02220P1=1-D*T*((((1.33027*T-1.82126)*T+1.78148)*T-.356564)*T+.319381)
02230IF Z<0 THEN 2250
02240GOTO 2260
02250P1=1-P1
02260RETURN
02270RETURN
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