Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50422/cmodw.bas
There are 2 other files named cmodw.bas in the archive. Click here to see a list.
00020REM*****************************************************************
00025REM    CMODW     CMODW     CMODW     CMODW     CMODW    CMODW
00030REM*****************************************************************
00060  FILES RFILE1,RFILE2,RFILE3
00070X=0
00110RESTORE#1
00111  INPUT#  1,I1,I2,I3
00160SCRATCH#1
00161  PRINT #  1,32,I2,I3
00170PRINT L$
00180PRINT "          EVALUATION OF PASCAL DISTRIBUTION"
00190PRINT
00200PRINT "THIS MODULE WILL HELP YOU EXAMINE THE CHARACTERISTICS OF A"
00210PRINT "PASCAL DISTRIBUTION."
00212PRINT
00214PRINT "THE PASCAL DISTRIBUTION IS THE DISTRIBUTION OF THE NUMBER OF"
00215PRINT "TRIALS REQUIRED TO GET S SUCCESSES WHEN THE PROBABILITY OF A"
00216PRINT "SUCCESS ON ANY TRIAL IS P, THE PROCESS PARAMETER."
00217PRINT
00230PRINT "INPUT THE PARAMETERS OF THE PASCAL DISTRIBUTION."
00250PRINT
00260PRINT "INPUT THE PROCESS PARAMETER P.";
00270GOSUB 9000
00280P=O1
00290IF P>0 THEN 320
00300PRINT "REENTER.  P MUST BE BETWEEN 0 AND 1."
00310GOTO 270
00320IF P >= 1 THEN 300
00330PRINT
00340PRINT "INPUT THE SUCCESSES PARAMETER S (MAX=200)";
00350GOSUB 9000
00360IF INT(O1)>0 THEN 380
00370PRINT "REENTER.  MINIMUM IS 0.  MAXIMUM IS 200."
00375GOTO 350
00380IF INT(O1)>200 THEN 370
00381R=INT(O1)
00390PRINT L$
00400PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
00410PRINT "     1. PROBABILITIES THAT THE NUMBER (N) OF TRIALS NEEDED"
00420PRINT "        WILL BE LESS THAN X, EQUAL TO X, AND GREATER THAN X."
00430PRINT "     2. PROBABILITY THAT THE NUMBER (N) OF TRIALS NEEDED "
00440PRINT "        WILL BE BETWEEN X1 AND X2 INCLUSIVE."
00450PRINT "     3. EXIT MODULE."
00460GOSUB 9000
00470IF O1=3 THEN 520
00480IF O1=1 THEN 530
00490IF O1=2 THEN 745
00500PRINT "REENTER.  INPUT MUST BE NUMBER OF AVAILABLE OPTION."
00510GOTO 460
00520CHAIN "RSTRT"
00530PRINT L$
00540PRINT "     OPTION 1: PROBABILITIES THAT THE NUMBER (N) OF TRIALS"
00550PRINT "     NEEDED WILL BE LESS THAN X, EQUAL TO X, AND GREATER THAN X."
00560PRINT
00570PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED TO INPUT X."
00580GOSUB 1120
00590PRINT"                        X    P( N<X )    P( N=X )    P( N>X ) " 
00600 REM
00610PRINT "INPUT X.";
00620GOSUB 9000
00630IF O1=-1 THEN 1010
00640IF O1 >= R THEN 680
00650PRINT "REENTER.  N MUST BE AT LEAST AS LARGE AS S."
00670GOTO 620
00680X=O1
00690N=X
00700GOSUB 1200
00710:                    #####    ##.###      ##.###      ##.###
00720G4=R*G2/N
00730PRINT  USING 710,N,G2+G3-G4,G4,1-G2-G3
00740GOTO 610
00745PRINT L$
00750PRINT "     OPTION 2: PROBABILITY THAT THE NUMBER (N) OF TRIALS"
00760PRINT "     WILL BE BETWEEN X1 AND X2 INCLUSIVE."
00770PRINT
00780PRINT "TO EXIT ROUTINE TYPE '-1' WHEN ASKED FOR INPUT."
00790GOSUB 1120
00800PRINT "INPUT X1 AND X2.";
00810GOSUB 9050
00820IF O1 <> -1 THEN 850
00830IF O2=-1 THEN 1010
00840GOTO 950
00850X1=O1
00860X2=O2
00870IF X2>X1 THEN 900
00880PRINT "REENTER.  INPUT THE LARGER X (X2) FIRST."
00890GOTO 810
00900IF X1 >= R THEN 930
00910PRINT "REENTER.  N MUST BE AT LEAST AS LARGE AS S."
00920GOTO 810
00930N=X1
00940GOSUB 1200
00950T9=G3+G2-R*G2/N
00960N=X2
00970GOSUB 1200
00980:                         PROB(#####    < S <##### ) =##.##
00990PRINT  USING 980,X1,X2,G3+G2-T9
01000GOTO 800
01010PRINT L$
01020PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
01030PRINT "     1. FURTHER EVALUATE THIS DISTRIBUTION."
01040PRINT "     2. EVALUATE ANOTHER PASCAL DISTRIBUTION."
01050PRINT "     3. EXIT MODULE."
01060GOSUB 9000
01070IF O1=3 THEN 520
01080IF O1=1 THEN 390
01090IF O1=2 THEN 1100
01100PRINT L$
01110GOTO 230
01120PRINT "---------------------------------------------------------------"
01130PRINT "                 PASCAL DISTRIBUTION"
01140:SUCCESS PARAMETER S =#####        MEAN =########.##
01150PRINT  USING 1140,R,R/P
01160:PROCESS PARAMETER P =##.##        STANDARD DEVIATION =###.##
01170PRINT  USING 1160,P,SQR(R/P*(1-P)/P)
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