Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0113/cmodr.bas
There are 2 other files named cmodr.bas in the archive. Click here to see a list.
00020REM *************************************************************
00030REM
00040REM          FITTING NORMAL OGIVE FUNCTION
00050REM
00060REM*****************************************************************
00070FILES RFILE1,RFILE2,RFILE3
00110RESTORE#1
00111  INPUT#  1,I1,I2,I3
00112 SCRATCH #1
00113 PRINT#1,27,I2,I3
00120SCRATCH#3
00121  PRINT #  3,0,0,0,0,0,0,0
00130X=0
00140PRINT L$
00150PRINT "         FITTING A NORMAL OGIVE UTILITY FUNCTION"
00160PRINT
00170PRINT "THIS MODULE WILL HELP YOU IN FINDING A NORMAL OGIVE FUNCTION"
00180PRINT "TO REPRESENT  YOUR UTILITIES.  YOU ARE ASKED TO SPECIFY  THE"
00190PRINT "SMALLEST AND LARGEST POINTS TO BE ASSIGNED UTILITIES.  YOU"
00200PRINT "ARE ALSO ASKED TO SPECIFY THE POINTS TO BE ASSIGNED UTILITY"
00210PRINT ".50 AND UTILITY .75.  THESE POINTS ARE THE MEDIAN AND 75TH"
00220PRINT "PERCENTILE OF THE NORMAL OGIVE FUNCTION."
00230PRINT
00240PRINT "ONCE YOU HAVE PROVIDED THIS INFORMATION THE MODULE WILL COMPUTE"
00250PRINT "AND PRINT THE UTILITIES FOR THE ENDPOINTS AND  7  INTERMEDIATE"
00260PRINT "AND EQUALLY SPACED POINTS ON THIS INTERVAL.  THERE WILL BE TWO"
00270PRINT "SETS OF UTILITIES - NORMAL OGIVE AND CORRECTED NORMAL.  NORMAL"
00280PRINT "OGIVE UTILITIES WILL BE THOSE IMPLIED BY THE NORMAL OGIVE YOU"
00290PRINT "SPECIFIED.  THE CORRECTED NORMAL UTILITIES WILL BE OBTAINED BY"
00300PRINT "LINEARLY TRANSFORMING THE NORMAL OGIVE UTILITIES SO THAT  THE"
00310PRINT "SMALLEST POINT HAS UTILITY 0 AND THE LARGEST UTILITY 1."
00320PRINT
00330PRINT
00340PRINT "INPUT THE SMALLEST POINT.";
00350GOSUB 9000
00360S1=O1
00370PRINT "INPUT THE LARGEST POINT.";
00380GOSUB 9000
00390IF S1<O1 THEN 420
00400PRINT "REENTER.  INPUT SMALLEST FIRST."
00410GOTO 330
00420L1=O1
00430PRINT
00440PRINT "INPUT THE MEDIAN (MEAN) OF THE NORMAL OGIVE YOU WANT."
00450PRINT "THIS CORRESPONDS TO THE POINT TO BE ASSIGNED UTILITY .50.";
00460GOSUB 9000
00470IF O1>S1 THEN 500
00480PRINT "REENTER.  MEAN MUST BE BETWEEN SMALLEST AND LARGEST."
00490GOTO 460
00500IF O1 >= L1 THEN 480
00510M0=O1
00520PRINT
00530PRINT "INPUT THE 75TH PERCENTILE OF THE NORMAL OGIVE.  THIS"
00540PRINT "CORRESPOND TO THE POINT TO BE ASSIGNED UTILITY .75.";
00550GOSUB 9000
00560IF O1 >= L1 THEN 580
00570IF O1>M0 THEN 610
00580PRINT "REENTER.  75TH MUST BE GREATER THAN MEAN AND LESS THAN"
00590PRINT "LARGEST."
00600GOTO 550
00610S0=(O1-M0)/.6754
00620Y3=(S1-M0)/S0
00630GOSUB 8000
00640F1=P
00650Y3=(L1-M0)/S0
00660GOSUB 8000
00670F0=P-F1
00680PRINT L$
00690PRINT "                               UTILITIES"
00700PRINT "     POINT        NORMAL OGIVE           CORRECTED NORMAL"
00710FOR I=S1 TO L1 STEP (L1-S1)/8
00720Y3=(I-M0)/S0
00730GOSUB 8000
00740:#######.##          ##.###                  ##.###
00750PRINT  USING 740,I,P,(P-F1)/F0
00760NEXT I
00770GOSUB 800
00780GOTO 910
00790PRINT L$
00800PRINT
00810:NORMAL OGIVE: MEAN =#######.## ST.DEV.=######.##
00820PRINT  USING 810,M0,S0
00830RETURN
00840PRINT L$
00850PRINT "HERE ARE THE PERCENTILES OF THE PREVIOUS NORMAL OGIVE."
00860PRINT
00870:  25TH=#######.##  50TH=#######.##  75TH=#######.##
00880PRINT  USING 870,M0-.6754*S0,M0,M0+.6754*S0
00890PRINT
00900RETURN
00910PRINT
00920PRINT "IF YOU WANT THE UTILITY FOR SOME OTHER POINT TYPE THE POINT."
00930PRINT "IF YOU DO NOT TYPE '-7777'."
00940GOSUB 9000
00950IF O1=-7777 THEN 1090
00960IF O1>S1 THEN 990
00970PRINT "REENTER.  POINT MUST BE BETWEEN SMALLEST AND LARGEST."
00980GOTO 940
00990IF O1 >= L1 THEN 970
01000Y3=(O1-M0)/S0
01010GOSUB 8000
01020PRINT
01030:NORMAL OGIVE =##.##       CORRECTED NORMAL =##.##
01040PRINT  USING 1030,P,(P-F1)/F0
01050PRINT
01060PRINT "NEXT POINT OR '-7777'.";
01070GOSUB 9000
01080GOTO 950
01090PRINT L$
01100PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
01110PRINT "    1. ACCEPT THIS NORMAL OGIVE FIT."
01120PRINT "    2. TRY A DIFFERENT NORMAL OGIVE AND CHANGE THE ENDPOINTS."
01130PRINT "    3. TRY A DIFFERENT NORMAL OGIVE WITH THE SAME ENDPOINTS."
01140PRINT "    4. EXIT MODULE"
01150GOSUB 9000
01160IF O1=2 THEN 1220
01170IF O1=3 THEN 1280
01180IF O1=4 THEN 1300
01190IF O1 <> 1 THEN 1260
01200REM
01210GOTO 1300
01220GOSUB 840
01230GOTO 320
01240CHAIN "RSTRT"
01250IF O1=1 THEN 1300
01260PRINT "REENTER.  INPUT MUST BE NUMBER OF OPTION ."
01270GOTO 1150
01280GOSUB 840
01290GOTO 430
01300PRINT
01310PRINT "IF YOU WANT TO FIND THE EXPECTED UTILITY WITH RESPECT TO"
01320PRINT "SOME NORMAL DISTRIBUTION TYPE '1', ELSE '0'.";
01330GOSUB 9000
01340IF O1=0 THEN 1200
01350IF O1=1 THEN 1380
01360PRINT "REENTER.  INPUT MUST BE 0 OR 1."
01370GOTO 1330
01380SCRATCH#3
01381  PRINT #  3,M0,S0
01390CHAIN "CMODS"
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
09999END