Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmode.bas
There are 2 other files named cmode.bas in the archive. Click here to see a list.
00015REM******************************************************************
00017REM CMODE CMODE CMODE CMODE CMODE CMODE
00019REM******************************************************************
00020REM
00030REM NORMAL DISTRIBUTION
00040REM
00050REM****************************************************************
00060 FILES RFILE1,RFILE2,RFILE3
00070X=0
00080S0=0
00130RESTORE#1
00131 INPUT# 1,I1,I2,I3
00140REM
00150REM I3=8 MEANS THAT ENTRY IS VIA EXPECTED UTILITY
00160REM
00170IF I3=8 THEN 2460
00180SCRATCH#1
00181 PRINT # 1,14,I2,I3
00190RESTORE#2
00191 INPUT# 2,M0,S0
00200L9=0
00210REM
00220REM S0=0 MEANS THAT THE PARAMETERS HAVE NOT BEEN PASSED
00230REM
00240X=0
00250IF S0=0 THEN 270
00260L9=1
00270PRINT L$
00280REM
00290PRINT " EVALUATION OF A NORMAL DISTRIBUTION"
00300REM
00310PRINT
00320PRINT "THIS MODULE ALLOWS YOU TO EXAMINE THE CHARACTERISTICS OF A"
00330PRINT "NORMAL DISTRIBUTION."
00340GOTO 490
00350PRINT L$
00360PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
00370PRINT " 1. PERCENTILES"
00380PRINT " 2. HIGHEST DENSITY REGIONS"
00390PRINT " 3. PROBABILITY X IS GREATER THAN SOME VALUE"
00400PRINT " 4. PROBABILITY X IS BETWEEN TWO VALUES"
00410PRINT " 5. GRAPH OF DENSITY FUNCTION"
00420PRINT " 6. EXIT MODULE"
00430GOSUB 9000
00440IF O1=6 THEN 2280
00450I=O1
00460GOTO 740
00470PRINT "REENTER. INPUT MUST BE 1,2,3,4,5, OR 6."
00480GOTO 430
00490PRINT
00500REM
00510REM L9=0 IF THE PARAMETERS WERE NOT PASSED
00520REM
00530IF L9=0 THEN 590
00540GOTO 350
00550REM ***********************************************************
00560REM INPUT PARAMETERS ROUTINE
00570REM
00580REM
00590PRINT "INPUT THE MEAN OF THE NORMAL DISTRIBUTION.";
00600L9=1
00610GOSUB 9000
00620M0=O1
00630PRINT
00640PRINT "INPUT THE STANDARD DEVIATION.";
00650GOSUB 9000
00660IF O1>0 THEN 690
00670PRINT "REENTER. STANDARD DEVIATION MUST BE POSITIVE."
00680GOTO 630
00690S0=O1
00700GOTO 350
00710REM
00720REM END OF THE INPUT ROUTINE
00730REM *****************************************************
00740REM
00750IF I=1 THEN 840
00760IF I=2 THEN 1340
00770IF I=3 THEN 1590
00780IF I=4 THEN 1810
00790IF I=5 THEN 3110
00800GOTO 470
00810REM ********************************************************************
00820REM
00830REM
00840PRINT L$
00850PRINT " OPTION 1: PERCENTILES"
00860PRINT
00870PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT."
00880PRINT "INPUT PERCENTILE AS NUMBER FROM 1 THROUGH 99."
00890GOSUB 2350
00900PRINT
00910PRINT "INPUT PERCENTILE";
00920GOSUB 9000
00930IF O1=0 THEN 2140
00940IF O1<1 THEN 960
00950IF O1 <= 99 THEN 980
00960PRINT "REENTER. INPUT MUST BE '0' OR ACCEPTABLE PERCENTILE VALUE."
00970GOTO 910
00980P0=O1
00985IF P0 <> 50 THEN 990
00987Y3=0
00988GOTO 1010
00990GOSUB 1070
01000: ##.#% =#####.##
01010IF O1>50 THEN 1030
01020Y3=-Y3
01030PRINT USING 1000,O1,M0+Y3*S0
01040GOTO 900
01050Y3=0
01060GOTO 1030
01070IF P0/100<.5 THEN 1100
01080P2=1-P0/100
01090GOTO 1110
01100P2=P0/100
01110E1=SQR(LOG(1/P2/P2))
01120E2=2.51552+.802853*E1+.010328*E1*E1
01130E2=E2/(1+1.43279*E1+.189269*E1*E1+.001308*E1*E1*E1)
01140E2=E1-E2
01150E1=E2-.1
01153Y3=E2
01160E2=E2+.1
01170Y3=.5*(E1+E2)
01190GOSUB 8000
01210IF ABS(1-P-P2)>.0005 THEN 1230
01220RETURN
01230IF P>1-P2 THEN 1260
01240E1=Y3
01250GOTO 1170
01260E2=Y3
01270GOTO 1170
01280REM
01290REM END OF THE PERCENTILES ROUTINE
01300REM
01310REM ************************************************************
01320REM
01330REM
01340PRINT L$
01350PRINT " OPTION 2: HIGHEST DENSITY REGIONS"
01360PRINT
01370PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT."
01380PRINT "INPUT P% AS NUMBER FROM 1 THROUGH 99."
01390GOSUB 2350
01400PRINT
01410PRINT "INPUT P%";
01420GOSUB 9000
01430IF O1=0 THEN 2140
01440IF O1<1 THEN 1510
01450IF O1>99 THEN 1510
01460P0=50+O1/2
01470GOSUB 1080
01480PRINT USING 1490,O1,M0-Y3*S0,M0+Y3*S0
01490: ##.#% HDR = #####.## TO#####.##
01500GOTO 1410
01510PRINT "REENTER. INPUT MUST BE '0' OR ACCEPTABLE P% VALUE."
01520GOTO 1410
01530REM
01540REM END OF HDR ROUTIN
01550REM
01560REM******************************************************
01570REM
01580REM
01590PRINT L$
01600PRINT " OPTION 3: PROBABILITY X IS GREATER THAN SOME VALUE."
01610PRINT
01620PRINT "TO EXIT ROUTINE TYPE '7777' WHEN ASKED FOR INPUT."
01630GOSUB 2350
01640PRINT
01650PRINT "INPUT VALUE";
01660GOSUB 9000
01670IF O1=7777 THEN 2140
01680Y3=(O1-M0)/S0
01690GOSUB 8000
01700PRINT USING 1720,O1,P
01710PRINT USING 1730,O1,1-P
01720: PROB ( X <#####.## ) =##.##
01730: PROB ( X >#####.## ) =##.##
01740GOTO 1640
01750REM
01760REM END OF LESS THAN ROUTINE
01770REM
01780REM ************************************************************
01790REM
01800REM
01810PRINT L$
01820PRINT " OPTION 4: PROBABILITY BETWEEN TWO VALUES"
01830PRINT
01840PRINT "TO EXIT ROUTINE TYPE '0'S WHEN ASKED FOR INPUT."
01850GOSUB 2350
01860PRINT
01870PRINT "INPUT SMALLER VALUE";
01880GOSUB 9000
01890X2=O1
01900PRINT "INPUT LARGER VALUE";
01910GOSUB 9000
01920IF X2=0 THEN 1940
01930GOTO 1950
01940IF O1=0 THEN 2140
01950IF O1>X2 THEN 1980
01960PRINT "REENTER. SECOND VALUE MUST BE LARGER THAN FIRST."
01970GOTO 1860
01980Y3=(O1-M0)/S0
01990GOSUB 8000
02000P0=P
02010Y3=(X2-M0)/S0
02020GOSUB 8000
02030P0=P0-P
02040PRINT USING 2050,X2,O1,P0
02050: PROB (#####.## < X <#####.## ) =##.##
02060GOTO 1870
02070REM
02080REM END OF THE BETWEEN TWO VALUES ROUTINE
02090REM
02100REM ***********************************************************
02110REM
02120REM SELECT OPTION AFTER COMPLETING ROUTINE
02130REM
02140PRINT L$
02150PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
02160PRINT " 1. FURTHER EVALUATE THIS DISTRIBUTION"
02170PRINT " 2. EVALUATE ANOTHER NORMAL DISTRIBUTION"
02180PRINT " 3. EXIT MODULE"
02190GOSUB 9000
02200IF O1=3 THEN 2280
02210IF O1=2 THEN 2250
02220IF O1=1 THEN 2290
02230PRINT "REENTER. INPUT MUST BE 1,2 OR 3."
02240GOTO 2190
02250L9=0
02260GOTO 490
02270GOTO 2290
02280CHAIN "RSTRT"
02290REM
02300GOTO 350
02310REM
02320REM END OF SELECT OPTION ROUTINE
02330REM
02340REM **************************************************************
02350 REM
02360PRINT"******************************************************"
02370PRINT " NORMAL DISTRIBUTION"
02380PRINT USING 2390,M0,S0
02390: MEAN=#####.## STANDARD DEVIATION =####.##
02400PRINT"**********************************************************"
02410RETURN
02420REM **************************************************************
02430REM
02440REM EXPECTED UTILITY
02450REM
02460 DIM M(9),U(9),P(3)
02470 RESTORE #3
02471 FOR I=1 TO 9
02472 INPUT #3,M(I)
02473 NEXT I
02474 FOR I=1 TO 9
02475 INPUT #3,U(I)
02476 NEXT I
02477 FOR I=1 TO 3
02478 INPUT #3,P(I)
02479 NEXT I
02480PRINT L$
02490M0=P(1)
02500S0=P(2)
02510U9=0
02520U0=0
02530K5=2
02540Y3=(M(1)-M0)/S0
02550IF Y3<4 THEN 2640
02560PRINT
02570PRINT "THE SMALLEST POINT FOR WHICH YOUR UTILITY FUNCTION IS DEFINED"
02580PRINT "IS MORE THAN 4 STANDARD DEVIATIONS GREATER THAN THE MEAN"
02590PRINT "OF THE DISTRIBUTION WITH RESPECT TO WHICH YOU ARE TAKING"
02600PRINT "THE EXPECTATION. IF YOU ASSSUME THAT POINTS SMALLER THAN"
02610PRINT "YOUR SMALLEST POINT HAVE UTILITY 0 THEN THE EXPECTED UTILITY"
02620PRINT "IS 0."
02630GOTO 3020
02640GOSUB 8000
02650K8=P
02660P0=P
02670Y3=(M(9)-M0)/S0
02680IF Y3>-4 THEN 2760
02690PRINT
02700PRINT "THE LARGEST POINT FOR WHICH YOUR UTILITY FUNCTION IS DEFINED"
02710PRINT "IS MORE THAN 4 STANDARD DEVIATION LESS THAN THE MEAN OF THE"
02720PRINT "EXPECTING DISTRIBUTION. IF YOU ASSUME THAT ALL POINTS LARGER"
02730PRINT "THAN YOUR LARGEST POINT HAVE UTILITY 1 THEN THE EXPECTED"
02740PRINT "UTILITY IS 1."
02750GOSUB 3020
02760GOSUB 8000
02770K8=K8+1-P
02780PRINT "NORMAL DISTRIBUTION"
02790PRINT
02800PRINT "MEAN =";M0;" STANDARD DEVIATION =";S0
02810PRINT
02820PRINT "THE EXPECTED UTILITY IS BEING COMPUTED."
02830PRINT
02840FOR I7=M(1) TO M(9) STEP (M(9)-M(1))/110
02850I=I7
02860IF M(1)=I7 THEN 2960
02870IF I>M(K5) THEN 3090
02880Y3=(I-M0)/S0
02890GOSUB 8000
02900U1=(I-M(K5-1))*((U(K5)-U(K5-1))/(M(K5)-M(K5-1)))
02910U1=U(K5-1)+U1
02920U2=(U1+U0)/2
02930U9=U9+U2*(P-P0)
02940P0=P
02950U0=U1
02960NEXT I7
02970IF K8 <= 0 THEN 3010
02980U9=U9/(1-K8)
02990PRINT
03000:THE EXPECTED UTILITY IS ##.##.
03010PRINT USING 3000,U9
03020PRINT
03030 DIM V(1)
03040V(1)=1
03050 SCRATCH #3
03051 PRINT #3,V(1)
03052 FOR I=1 TO 9
03053 PRINT #3,M(I)
03054 NEXT I
03055 FOR I=1 TO 9
03056 PRINT #3,U(I)
03057 NEXT I
03058 FOR I=1 TO 3
03059 PRINT #3,P(I)
03060 NEXT I
03061PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
03070GOSUB 9000
03080CHAIN "CMODP"
03090K5=K5+1
03100GOTO 2890
03110PRINT L$
03120PRINT "OPTION 5: GRAPH OF THE DENSITY FUNCTION OVER 99% HDR"
03130GOSUB 2350
03140P0=99.5
03141PRINT "THESE ARE THE PARAMETERS OF THE DISTRIBUTION TO BE GRAPHED."
03150GOSUB 1080
03160K0=M0-Y3*S0
03170K1=M0+Y3*S0
03171PRINT "WHEN YOU ARE READY FOR THE GRAPH TO BE DISPLAYED TYPE '1'";
03172GOSUB 9000
03173PRINT L$
03180GOSUB 9400
03190GOTO 2140
05345REM *********************************************************
05350REM NORMAL DENSITY FUNCTION
05355REM *********************************************************
05360F0=-.5*LOG(2*3.1416*S0*S0)
05365F0=F0+(-.5*(J2-M0) ** 2)/(S0*S0)
05370D2=F0
05375RETURN
07900REM ************************************************************
07910REM
07920REM APPENDED GOSUBS FOLLOW
07930REM
07940REM
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
09400 REM
09412 T$=">>>>>>>>>1>>>>>>>>>2>>>>>>>>>3>>>>>>>>>4>>>>>>>>>5>>>>>>"
09414 S$="\\\\\\\\\I\\\\\\\\\I\\\\\\\\\I\\\\\\\\\I\\\\\\\\\I"
09416 U$="/////////I/////////I/////////I/////////I/////////I"
09419REM**************************************************
09420REM INPUT K0,K1, AND MO
09421REM DENSITY CALL 5345
09422REM******************************************************
09423: NORMAL MEAN=#######.## ST.DEV.=########.##
09426GOTO 9520
09450:#####.## I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL CONTINUE=1
09458IF ABS(J2)>9999 THEN 9560
09459IF ABS(J2)<1 THEN 9560
09460IF J2>M0+.4*K2 THEN 9472
09461IF J2<M0-.4*K2 THEN 9466
09462 PRINT USING 9466,J2,MID$(T$,1,K7-(1)+1)
09464GOTO 9474
09466:#####.## I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
09468 PRINT USING 9466,J2,MID$(S$,1,K7-(1)+1)
09470GOTO 9474
09472 PRINT USING 9466,J2,MID$(U$,1,K7-(1)+1)
09474RETURN
09510REM ***************************************************************
09520K2=(K1-K0)/19
09522J2=M0
09523PRINT USING 9423,M0,S0
09524GOSUB 5345
09526D6=D2
09528IF K1-K2-K0<.01 THEN 9582
09530FOR J2=K0 TO K1-.9*K2 STEP K2
09532GOSUB 5345
09533K7=EXP(D2-D6+LOG(50))
09534 IF K7>=1 THEN 9536
09535 K7=1
09536GOSUB 9458
09538NEXT J2
09540J2=K1
09542GOSUB 5345
09543K7=EXP(D2-D6+LOG(50))
09544 IF K7>=1 THEN 9546
09545 K7=1
09546IF J2<.01 THEN 9575
09547IF J2>9999.99 THEN 9575
09548 PRINT USING 9450,K1,MID$(U$,1,K7-(1)+1)
09555GOSUB 9000
09556RETURN
09560IF J2>M0+.4*K2 THEN 9572
09561IF J2<M0-.4*K2 THEN 9566
09562 PRINT USING 9566,J2,MID$(T$,1,K7-(1)+1)
09564RETURN
09566:##.##^^^^ I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
09568 PRINT USING 9566,J2,MID$(S$,1,K7-(1)+1)
09570RETURN
09572 PRINT USING 9566,J2,MID$(U$,1,K7-(1)+1)
09574RETURN
09575 PRINT USING 9580,K1,MID$(U$,1,K7-(1)+1)
09577GOTO 9555
09580:##.##^^^^ I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL CONTINUE=1
09582PRINT "THE HIGHEST DENISTY REGION IS WITHIN TOO SMALL A RANGE TO BE"
09583PRINT "ACCURATELY DISPLAYED. THE UPPER AND LOWER BOUNDS ARE"
09584PRINT "WITHIN .00X AND .00Y OF EACH OTHER. THIS INTERVAL CAN BE"
09585PRINT "OBTAINED FROM THE HIGHEST DENISTY REGION MODUAL."
09586PRINT "TYPE 1 TO CONTINUE"
09587GOTO 9555
09999 END