Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmodk.bas
There are 2 other files named cmodk.bas in the archive. Click here to see a list.
00015REM***********************************************************
00020REM CMODK CMODK CMODK CMODK CMODK
00025REM***********************************************************
00030V7=0
00035REM
00040REM
00045REM NINE POINT LEAST SQUARE UTILITY
00050REM
00055REM***************************************************
00060FILES RFILE1,RFILE2,RFILE3
00080RESTORE#1
00081 INPUT# 1,I1,I2,I3
00085IF I1=99 THEN 95
00090CHAIN "CMODQ"
00095SCRATCH#1
00096 PRINT # 1,20,I2,I3
00100RESTORE#2
00105FOR I=1 TO 84
00111INPUT#2,Y(I)
00115NEXT I
00120FOR I=1 TO 9
00121INPUT#2,P(I)
00130NEXT I
00135FOR I=1 TO 9
00136INPUT#2,U(I)
00145NEXT I
00150E(1)=1
00155RESTORE#3
00160FOR I=1 TO 9
00161INPUT#3,M(I)
00170NEXT I
00175E(2)=14
00180E(3)=30
00185E(4)=47
00190E(5)=63
00195E(6)=76
00200E(7)=84
00205E(8)=9
00210E(9)=26
00215E(10)=44
00220R1=0
00225E(11)=61
00230E(12)=75
00235E(13)=22
00240E(14)=41
00245E(15)=59
00250E(16)=38
00255IF Y(1)=0 THEN 265
00260R1=1
00265DIM C(27)
00270DIM N(84)
00275DATA 0,1,2
00280DATA .5,1.5,2.5
00285DATA 1,2,3
00290DATA 1.5,2.5,3.5
00295DATA 2,3,4
00300DATA 0,1.5,3
00305DATA .5,2,3.5
00310DATA 1,2.5,4
00315DATA 0,2,4
00320DIM H(7,7),G(7,1),F(7,1)
00325DIM E(16)
00330FOR I=1 TO 27
00335READ C(I)
00340NEXT I
00345DIM X(84)
00350G9=0
00355F9=-1
00360PRINT L$
00365IF R1 <> 1 THEN 460
00370RESTORE#2
00375GOSUB 385
00380GOTO 450
00385FOR I=1 TO 84
00386INPUT#2,Y(I)
00395NEXT I
00400FOR I=1 TO 9
00401INPUT#2,P(I)
00410NEXT I
00415 FOR I=1 TO 9
00416INPUT#2,U(I)
00425NEXT I
00430FOR I=1 TO 9
00435INPUT#2,M(I)
00440NEXT I
00445RETURN
00450RESTORE#3
00451 INPUT# 3,G1,G2,G3
00455IF R1=1 THEN 480
00460DIM M(9)
00465G1=0
00470G2=0
00475G3=0
00480G9=0
00485DIM Q(9),R(9,9),V(9,1),L(9,1),S(9,9)
00490DIM A(7),B(7,7),W(9),D(9)
00495W(1)=0
00500W(9)=1
00505D(1)=0
00510D(9)=0
00515I9=0
00520DIM U(9),P(9)
00525DIM K(9)
00530DIM Y(84)
00535E9=.005
00540E8=.005
00545PRINT L$
00550N0=7
00555IF R1=1 THEN 575
00560FOR I=1 TO 84
00565Y(I)=-1
00570NEXT I
00575N1=N0+1
00580N2=N0+2
00585N3=N0-1
00590IF R1=1 THEN 760
00595PRINT "PLEASE SPECIFY YOUR INDIFFERENCE P FOR THESE GAMBLES."
00600PRINT
00605PRINT "*** GAMBLES ON OUTCOMES ADJACENT TO THE FOR SURE OUTCOME ***"
00610PRINT " FOR GAMBLE P THAT MAKES"
00615REM
00620PRINT" SURE WITH PROB P WITH PROB 1-P YOU INDIFFERENT"
00625FOR I=1 TO 7
00630J=I+1
00635K=I+2
00640S9=0
00645FOR I0=0 TO J-2
00650S9=S9+I0*(N2-1-I0)
00655NEXT I0
00660S0=S9+(I-1)*(N2-J)+K-J
00665PRINT USING 670,M(I+1),M(I+2),M(I)
00670:####.## #####.## #####.##
00672PRINT" ";
00675GOSUB 3865
00680P(I+1)=O1
00685IF P(I+1)<.05 THEN 700
00690IF P(I+1)>.95 THEN 700
00695GOTO 710
00700PRINT "PROBABILITIES MUST BE IN THE INTERVAL .05 THROUGH .95."
00705GOTO 665
00710Y(S0)=P(I+1)
00715NEXT I
00720P(9)=1
00725P(1)=0
00730PRINT
00735GOSUB 2950
00740GOTO 760
00745U9=U0
00750GOSUB 2460
00755GOSUB 2525
00760PRINT L$
00765GOSUB 2460
00770PRINT "IF YOU WANT A LIST OF THE GAMBLES TYPE '1' ELSE '0'.";
00775GOSUB 3865
00780IF O1=1 THEN 760
00785MAT X=Y
00790GOSUB 2130
00795I9=1
00800FOR I=2 TO 5
00805IF U(I)-U(I-1)>.005 THEN 815
00810U(I)=U(I-1)+.005
00815NEXT I
00820FOR I=8 TO 5 STEP -1
00825IF U(I+1)-U(I)>.005 THEN 835
00830U(I)=U(I+1)-.005
00835NEXT I
00840SCRATCH#2
00845GOSUB 855
00850GOTO 920
00855FOR I=1 TO 84
00861 PRINT # 2,Y(I)
00865NEXT I
00870FOR I=1 TO 9
00875 PRINT #2, P(I)
00880NEXT I
00885FOR I=1 TO 9
00890 PRINT #2, U(I)
00895NEXT I
00900FOR I=1 TO 9
00905 PRINT #2, M(I)
00910NEXT I
00915RETURN
00920SCRATCH#3
00921 PRINT # 3,G1,G2,G3
00925GOSUB 3625
00930PRINT "IF YOU WANT TO CHANGE ANY GAMBLES TYPE '1' ELSE '0'.";
00935GOSUB 3865
00940PRINT L$
00945IF O1=1 THEN 760
00950PRINT "A LEAST SQUARES (LSQ) FIT OF THE SPECIFIED POINTS WILL NOW"
00955PRINT "BE ATTEMPTED USING AN ITERATIVE PROCESS THAT TERMINATES WHEN"
00960PRINT "THE FUNCTIONAL VALUE BEING MINIMIZED STABLIZES."
00965GOTO 975
00970F9=F0
00975FOR J=2 TO N1
00980I=J-1
00985K=J+1
00990IF U(I) >= U(J) THEN 1005
00995IF U(K) <= U(J) THEN 1005
01000GOTO 1015
01005PRINT "THE UTILITY AT POINT";M(J);"IS NOT MONOTONIC"
01010G9=1
01015NEXT J
01020IF G9 <> 1 THEN 1040
01025PRINT
01030G9=0
01035GOTO 3770
01040FOR S1=2 TO N1
01045S5=0
01050S0=0
01055FOR J=2 TO N1
01060J0=J-1
01065J1=J+1
01070FOR I=1 TO J0
01075FOR K=J1 TO N2
01080S0=S0+1
01085IF Y(S0)<0 THEN 1150
01090S2=0
01095IF I <> S1 THEN 1105
01100S2=1
01105S3=0
01110IF J <> S1 THEN 1120
01115S3=1
01120S4=0
01125IF K <> S1 THEN 1135
01130S4=1
01135S6=LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J)))
01140S7=1/(U(J)-U(I))*S2-(1/(U(K)-U(J))+1/(U(J)-U(I)))*S3
01145S5=S5+S6*(S7+1/(U(K)-U(J))*S4)
01150NEXT K
01155NEXT I
01160NEXT J
01165A(S1-1)=S5
01170NEXT S1
01175REM--NOW HAVE AS
01180GOSUB 2740
01185GOSUB 3590
01190REM--F0 IS FUNCTION VALUE
01195PRINT "ITERATION ";I9;
01200PRINT "FUNCTION VALUE IS";F0
01205MAT B=ZER
01210FOR S1=2 TO N1
01215FOR T1=2 TO N1
01220S2=S1-1
01225T2=T1-1
01230S0=0
01235FOR J=2 TO N1
01240J0=J-1
01245J1=J+1
01250FOR I=1 TO J0
01255FOR K=J1 TO N2
01260S0=S0+1
01265IF Y(S0)<0 THEN 1435
01270IF S1 >= T1 THEN 1330
01275IF J <> S1 THEN 1290
01280IF K <> T1 THEN 1290
01285B(S2,T2)=B(S2,T2)-1/(U(T1)-U(S1))*(1/(U(T1)-U(S1))+1/(U(S1)-U(I)))
01290IF I <> S1 THEN 1310
01295IF K=T1 THEN 1305
01300GOTO 1310
01305B(S2,T2)=B(S2,T2)+1/(U(J)-U(S1))/(U(T1)-U(J))
01310IF I <> S1 THEN 1435
01315IF J <> T1 THEN 1435
01320B(S2,T2)=B(S2,T2)-1/(U(T1)-U(S1))*(1/(U(K)-U(T1))+1/(U(T1)-U(S1)))
01325GOTO 1435
01330IF S1=T1 THEN 1390
01335IF J <> T1 THEN 1350
01340IF K <> S1 THEN 1350
01345B(S2,T2)=B(S2,T2)-1/(U(S1)-U(T1))*(1/(U(S1)-U(T1))+1/(U(T1)-U(I)))
01350IF I <> T1 THEN 1360
01355IF K=S1 THEN 1365
01360GOTO 1370
01365B(S2,T2)=B(S2,T2)+1/(U(J)-U(T1))/(U(S1)-U(J))
01370IF I <> T1 THEN 1435
01375IF J <> S1 THEN 1435
01380B(S2,T2)=B(S2,T2)-1/(U(S1)-U(T1))*(1/(U(K)-U(S1))+1/(U(S1)-U(T1)))
01385GOTO 1435
01390IF I=S1 THEN 1400
01395GOTO 1405
01400B(S2,T2)=B(S2,T2)+1/(U(J)-U(S1))/(U(J)-U(S1))
01405IF J=S1 THEN 1415
01410GOTO 1420
01415 B(S2,T2)=B(S2,T2)+(1/(U(K)-U(S1))+1/(U(S1)-U(I)))^2
01420IF K=S1 THEN 1430
01425GOTO 1435
01430B(S2,T2)=B(S2,T2)+1/(U(S1)-U(J))/(U(S1)-U(J))
01435NEXT K
01440NEXT I
01445NEXT J
01450NEXT T1
01455NEXT S1
01460I9=I9+1
01465N=7
01470GOSUB 2885
01475GOSUB 2415
01480IF ABS(F0-F9)>E9 THEN 970
01485FOR I1=2 TO N1
01490IF ABS(D(I1))>E8 THEN 970
01495NEXT I1
01500PRINT L$
01505FOR I=1 TO 84
01510N(I)=-1
01515NEXT I
01520V7=0
01525PRINT " UTILITIES FOR GAMBLES INDIFFERENCE P"
01530GOTO 1540
01535PRINT "---------------------- ---------------- ------------"
01540PRINT "INITIAL LSQ SURE P 1-P SPECIFIED FITTED"
01545FOR I=1 TO 7
01550J=I+1
01555K=I+2
01560S9=0
01565FOR I0=0 TO J-2
01570S9=S9+I0*(N2-1-I0)
01575NEXT I0
01580S0=S9+(I-1)*(N2-J)+K-J
01585IF V7=1 THEN 1605
01590Y1=(U(J)-U(I))/(U(K)-U(I))
01595X7=(LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J))))^2
01600N(S0)=Y1
01605IF V7=0 THEN 1655
01610IF I=1 THEN 1635
01620 V$=" "
01625GOTO 1645
01635V$="ADJACENT GAMBLES"
01640:'CCCCCCCCCCCCCCCC ##. ###.## #####.## #####.## ##.##
01645PRINT USING 1640,V$,I,M(J),M(K),M(I),Y(S0)
01650GOTO 1705
01655REM
01680REM
01685GOTO 1695
01690REM
01695PRINT USING 1700,K(J),U(J),M(J),M(K),M(I),X(S0),Y1
01700:##.## ##.## ###.## ######.## #####.## ##.## ##.##
01705NEXT I
01710IF V7=0 THEN 1730
01725GOTO 1735
01730REM
01735K0=1
01740K6=8
01745K1=15
01750GOSUB 1875
01755IF V7=0 THEN 1775
01770GOTO 1780
01775REM IF G2<>1 THEN 3020
01780K0=16
01785K6=13
01790K1=24
01795GOSUB 1875
01800IF V7=0 THEN 1820
01815GOTO 1825
01820REM IF G3<>1 THEN 3810
01825K0=25
01830K6=16
01835K1=27
01840GOSUB 1875
01845IF V7=1 THEN 2510
01850GOTO 2235
01855INPUT I1
01860IF I1 <> 1 THEN 2290
01865MAT Y=N
01870GOTO 760
01875FOR I1=K0 TO K1 STEP 3
01880I=INT(C(I1)/.5+1.5)
01885J=INT(C(I1+1)/.5+1.5)
01890K=INT(C(I1+2)/.5+1.5)
01895S9=0
01900FOR I0=0 TO J-2
01905S9=S9+I0*(N2-1-I0)
01910NEXT I0
01915S0=S9+(I-1)*(N2-J)+K-J
01920IF V7=1 THEN 1955
01925Y1=(U(J)-U(I))/(U(K)-U(I))
01930N(S0)=Y1
01935IF Y(S0)<0 THEN 2070
01940X7=(LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J))))^2
01945IF V7=0 THEN 2045
01950PRINT K6,S0,Y(S0)
01955 IF K6=8THEN 1970
01960IFK6=13THEN1975
01965IFK6=16THEN 1980
01966V$=" "
01967GOTO1995
01970 V$="2-APART GAMBLES "
01972 GOTO 1995
01975 V$="3-APART GAMBLES "
01976GOTO1995
01980 V$="4-APART GAMBLES "
01995REM
02000IF Y(S0)=-1 THEN 2035
02005IF Y(S0)=-8888 THEN 2025
02010:'CCCCCCCCCCCCCCCC ##. ###.## #####.## #####.## ##.##
02015PRINT USING 2010,V$,K6,M(J),M(K),M(I),Y(S0)
02020GOTO 2115
02022:'CCCCCCCCCCCCCCCC ##. ###.## #####.## #####.## DEL
02025PRINT USING 2022,V$,K6,M(J),M(K),M(I)
02030GOTO 2115
02032:'CCCCCCCCCCCCCCCC ##. ###.## #####.## #####.## UNS
02035PRINT USING 2032,V$,K6,M(J),M(K),M(I)
02040GOTO 2115
02045: ####.## ######.## #####.## ##.## ##.##
02055REM
02060PRINT USING 2045,M(J),M(K),M(I),Y(S0),Y1
02065GOTO 2115
02070:##. ###.## #####.## #####.##
02075REM
02080IF Y(S0) <> -8888 THEN 2100
02082: ####.## ######.## #####.## DEL ##.##
02090PRINT USING 2082,M(J),M(K),M(I),Y1
02095GOTO 2115
02100IF Y(S0) <> -1 THEN 2115
02105: ####.## ######.## #####.## UNS ##.##
02110PRINT USING 2105,M(J),M(K),M(I),Y1
02115 K6=K6+1
02116NEXT I1
02120RETURN
02130REM--*****routine to calculate utilities from probabilities
02135FOR I=1 TO N0
02140Q(I)=P(I+1)
02145NEXT I
02150MAT R=IDN
02155FOR I=1 TO N3
02160R(I,I+1)=-Q(I)
02165R(8-I,7-I)=-(1-Q(8-I))
02170NEXT I
02175MAT L=ZER
02180L(7,1)=Q(7)
02185MAT S=INV(R)
02190MAT V=S*L
02195FOR I=1 TO N0
02200U(I+1)=V(I,1)
02205NEXT I
02210U(1)=0
02215U(N2)=1
02220MAT K=U
02225RETURN
02230REM--*****END OF ROUTINE*****
02235GOSUB 3455
02240PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
02245PRINT " 1. ACCEPT THE LEAST SQUARES (LSQ) UTILITIES."
02250PRINT " 2. MODIFY P VALUES USING THE FITTED SET AS WORKING SET."
02255PRINT " 3. MODIFY P VALUES USING SPECIFIED SET AS WORKING SET."
02260GOSUB 3865
02265IF O1 <> 2 THEN 2315
02270MAT Y=N
02275P(2)=Y(1)
02280P(3)=Y(14)
02285P(4)=Y(30)
02290P(5)=Y(47)
02295P(6)=Y(63)
02300P(7)=Y(76)
02305P(8)=Y(84)
02310GOTO 760
02315IF O1=1 THEN 2330
02320PRINT L$
02325GOTO 760
02330MAT P=M
02335PRINT "IF YOU WANT TO TRY A NORMAL OGIVE FIT TYPE '1', ELSE '0'.";
02340GOSUB 3865
02345SCRATCH#3
02346 PRINT # 3,0
02350IF O1 <> 1 THEN 2370
02355SCRATCH #2
02356 FOR I=1 TO 84
02357PRINT#2,X(I)
02358NEXT I
02360 GOSUB 870
02365CHAIN "CMODL"
02370PRINT "IF YOU WANT THE EXPECTED UTILITY FOR LSQ FIT TYPE '1' ELSE '0'.";
02375GOSUB 3865
02380IF O1=0 THEN 2410
02385SCRATCH #2
02390FOR I=1 TO 9
02396 PRINT # 2,M(I)
02400NEXT I
02402FOR I=1 TO 9
02403PRINT#2,U(I)
02404NEXT I
02405CHAIN "CMODP"
02410CHAIN "RSTRT"
02415REM--*****ROUTINE TO HANDLE NEW AND OLD VALUES OF U'S*****
02420FOR I=2 TO N1
02425W(I)=U(I)
02430D(I)=A(I-1)
02435U(I)=W(I)-A(I-1)
02440NEXT I
02445E0=1
02450RETURN
02455REM--***** END OF ROUTINE*****
02460REM--*****ROUTINE THAT SUMMARIZES GAMBLES SPECIFIED.*****
02465V7=1
02470:
02480PRINT" ";
02485PRINT " FOR GAMBLE INDIFFERENCE P"
02495PRINT" ";
02500PRINT " NO. SURE P 1-P SPECIFIED"
02505GOTO 1545
02510GOTO 2530
02515:###.## #####.## #####.## #####.## #####.###
02520REM--*****END OF ROUTINE*****
02525REM--*****ROUTNE FOR INPUTTING GAMBLES*****
02530PRINT
02535PRINT "TO CHANGE OR ADD A GAMBLE TYPE THE NUMBER (NO.) OF THE GAMBLE"
02540PRINT "AND THE P VALUE YOU WANT. TO DELETE A GAMBLE TYPE '-1'. IF"
02545PRINT "YOU WANT TO LEAVE ALL GAMBLES AS THEY ARE TYPE '0,0'."
02550GOSUB 3895
02555IF O2=0 THEN 2730
02560IF O1 >= 1 THEN 2575
02565PRINT "REENTER. INPUT NUMBER OF THE GAMBLE FIRST."
02570GOTO 2550
02575IF O1>16 THEN 2565
02580IF O2 <> -1 THEN 2610
02585IF O1<8 THEN 2600
02590Y(E(O1))=-8888
02595GOTO 2720
02600PRINT "REENTER. ADJACENT GAMBLES CANNOT BE DELETED."
02605GOTO 2550
02610IF O2 >= .05 THEN 2630
02615PRINT
02620PRINT "REENTER. P MUST BE AT LEAST .05 BUT NOT MORE THAN .95."
02625GOTO 2550
02630IF O2>.95 THEN 2615
02635Y(E(O1))=O2
02640IF O1>7 THEN 2650
02645P(O1+1)=O2
02650GOTO 2720
02655GOTO 2720
02660IF J-I=K-J THEN 2675
02665PRINT "ONLY SYMETRIC GAMBLES ARE ACCEPTED. PLEASE RESPECIFY."
02670GOTO 2720
02675S9=0
02680FOR I0=0 TO J-2
02685S9=S9+I0*(N2-1-I0)
02690NEXT I0
02695S0=S9+(I-1)*(N2-J)+K-J
02700Y(S0)=M3
02705G3=0
02710IF Y(38)=-8888 THEN 2720
02715G3=1
02720PRINT "TYPE NEXT CHANGE OR '0,0'.";
02725GOTO 2550
02730RETURN
02735REM--*****END OF ROUTINE*****
02740REM--*****ROUTINE FOR CALCULATING FUNCTION VALUE*****
02745F0=0
02750F2=0
02755F3=0
02760F4=0
02765F5=0
02770S0=0
02775D3=0
02780D4=0
02785X7=0
02790FOR J=2 TO N1
02795J0=J-1
02800J1=J+1
02805FOR I=1 TO J0
02810FOR K=J1 TO N2
02815S0=S0+1
02820IF Y(S0)<0 THEN 2845
02825F1=(LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J))))^2
02830F0=F0+F1
02835GOSUB 3480
02840X7=X7+1
02845NEXT K
02850NEXT I
02855NEXT J
02860F6=F0/X7
02865IF X7 <= 7 THEN 2875
02870F0=F0/(X7-7)
02875RETURN
02880REM--*****END OF ROUTINE*****
02885REM--***** routine to solve linear equations*****
02890MAT H=INV(B)
02895FOR I=1 TO 7
02900F(I,1)=A(I)
02905NEXT I
02910MAT G=H*F
02915FOR I=1 TO 7
02920A(I)=G(I,1)
02925NEXT I
02930E0=1
02935RETURN
02940REM--*****END OF ROUTINE*****
02945REM--*****ROUTINE TO SPECIFY GAMBLES*****
02950PRINT "IF YOU WANT TO SPECIFY THE SYMMETRIC GAMBLES ON OUTCOMES"
02955PRINT "2 POINTS FROM THE FOR SURE OUTCOME TYPE '1', ELSE '0'.";
02960GOSUB 3865
02965G1=O1
02970IF G1 <> 1 THEN 3005
02975PRINT
02980PRINT "*** GAMBLES ON OUTCOMES 2 POINTS FROM THE FOR SURE OUTCOME ***"
02985K0=1
02990K6=8
02995K1=15
03000GOSUB 3135
03005PRINT
03010PRINT "IF YOU WANT TO SPECIFY THE SYMMETRIC GAMBLES ON OUTCOMES"
03015PRINT "3 POINTS FROM THE FOR SURE OUTCOME TYPE '1', ELSE '0'.";
03020GOSUB 3865
03025G2=O1
03030IF G2 <> 1 THEN 3065
03035PRINT
03040PRINT "*** GAMBLES ON OUTCOMES 3 POINTS FROM THE FOR SURE OUTCOME ***"
03045K0=16
03050K6=13
03055K1=24
03060GOSUB 3135
03065PRINT
03070PRINT "IF YOU WANT TO SPECIFY THE SYMMETRIC GAMBLES ON OUTCOMES"
03075PRINT "4 POINTS FROM THE FOR SURE OUTCOME TYPE '1', ELSE '0'.";
03080GOSUB 3865
03085G3=O1
03090IF G3 <> 1 THEN 3125
03095PRINT
03100PRINT "*** GAMBLES ON OUTCOMES 4 POINTS FROM THE FOR SURE OUTCOME ***"
03105K0=25
03110K6=16
03115K1=27
03120GOSUB 3135
03125RETURN
03130REM--*****END OF ROUTINE*****
03135REM--*****ROUTINE FOR ENTERING REMAINING GAMBLES*****
03140FOR I1=K0 TO K1 STEP 3
03145I=INT(C(I1)/.5+1.5)
03150J=INT(C(I1+1)/.5+1.5)
03155K=INT(C(I1+2)/.5+1.5)
03160S9=0
03165FOR I0=0 TO J-2
03170S9=S9+I0*(N2-1-I0)
03175NEXT I0
03180PRINT USING 670,M(J),M(K),M(I)
03185S0=S9+(I-1)*(N2-J)+K-J
03186PRINT" ";
03190GOSUB3865
03192I2=O1
03195IF I2<.05 THEN 3210
03200IF I2>.95 THEN 3210
03205GOTO 3220
03210PRINT "PROBABILITIES MUST BE IN THE INTERVAL .05 TO .95."
03215GOTO 3180
03220Y(S0)=I2
03225K6=K6+1
03230NEXT I1
03235RETURN
03240REM--******END OF ROUTINE******
03245REM--***** PRINT ROUTINES *****
03250PRINT USING 2515,I,Y(K9)
03255RETURN
03260PRINT USING 2515,I,Y(K9),Y(K8)
03265RETURN
03270PRINT USING 2515,I,Y(K9),Y(K8),Y(K7)
03275RETURN
03280PRINT USING 2515,I,Y(K9),Y(K8),Y(K7),Y(K6)
03285RETURN
03290REM--***** END OF ROUTINE*****
03295I=M(2)
03300K9=1
03305GOSUB 3245
03310I=M(3)
03315K9=14
03320K8=9
03325GOSUB 3260
03330I=M(4)
03335K9=30
03340K8=26
03345K7=22
03350GOSUB 3270
03355I=M(5)
03360K9=47
03365K8=44
03370K7=41
03375K6=38
03380GOSUB 3280
03385I=M(6)
03390K9=63
03395K8=61
03400K7=59
03405GOSUB 3270
03410I=M(7)
03415K9=76
03420K8=75
03425GOSUB 3260
03430I=M(8)
03435K9=84
03440GOSUB 3245
03445RETURN
03450REM--*****END OF ROUTINE*****
03455REM--*****ROUTINE TO PRINT FUNCTION VALUES*****
03460REM PRINT "FUNCTIONAL VALUE = ";F0;
03465GOTO 3470
03470RETURN
03475REM--*****END OF ROUTINE*****
03480REM--*****ROUTINE TO CALCULATE AVERAGE DISCR.*****
03485IF I <> J-1 THEN 3505
03490IF K <> J+1 THEN 3505
03495F2=F2+F1
03500GOTO 3585
03505IF G1 <> 1 THEN 3535
03510IF I <> J-2 THEN 3535
03515IF K <> J+2 THEN 3535
03520F3=F3+F1
03525D3=D3+1
03530GOTO 3585
03535IF G2 <> 1 THEN 3565
03540IF I <> J-3 THEN 3565
03545IF K <> J+3 THEN 3565
03550F4=F4+F1
03555D4=D4+1
03560GOTO 3585
03565IF G3 <> 1 THEN 3585
03570IF I <> J-4 THEN 3585
03575IF K <> J+4 THEN 3585
03580F5=F5+F1
03585RETURN
03590F2=F2/7
03595IF D3=0 THEN 3605
03600F3=F3/D3
03605IF D4=0 THEN 3615
03610F4=F4/D4
03615RETURN
03620REM--*****END OF ROUTINE*****
03625REM--*****ROUTINE TO PRINT INITIAL UTILITIES*****
03630PRINT L$
03635PRINT "HERE ARE YOUR UTILITIES FOR THE SOLUTION BASED ON ONLY THE"
03640PRINT "ADJACENT GAMBLES. THESE WILL BE REFERRED TO AS THE INITIAL"
03645PRINT "UTILITIES."
03650PRINT
03655S3=0
03660PRINT " POINT UTILITIES"
03665FOR I=1 TO N2
03680IF I=1 THEN 3695
03685IF U(I)-U(I-1)>.03 THEN 3695
03690S3=1
03695PRINT USING 3760,M(I),U(I)
03700NEXT I
03705PRINT
03710REM INSERT IF S3=1 THEN 6830
03715GOTO 3765
03720PRINT "SOME OF THE POINTS HAVE APPROXIMATELY THE SAME UTILITY. IT "
03725PRINT "IS BEST TO WORK WITH A SET OF POINTS HAVING NO TWO POINTS "
03730PRINT "WITH APPROXIMATELY THE SAME UTILITY."
03735PRINT "IF YOU WANT TO SPECIFY A DIFFERENT SET OF POINTS TYPE '1'."
03740PRINT "IF YOU DO NOT TYPE '0'."
03745GOSUB 3865
03750IF O1=0 THEN 3765
03755CHAIN "CMODK"
03760: ####.## ##.##
03765RETURN
03770REM--*****END OF ROUTINE*****
03775PRINT "A LEAST SQUARE FIT CAN NOT BE OBTAINED FROM YOUR SET"
03780PRINT "OF GAMBLES. CHECK YOUR GAMBLES TO SEE IF THEY ACTUALLY"
03785PRINT "REFLECT WHAT YOU BELIEVE. YOU MAY WANT TO CHANGE SOME"
03790PRINT "GAMBLES AND SEE IF THIS REMOVES THE NON-MONOTONICITY."
03795PRINT "NON-MONOTONICITY OCCURS BECAUSE THERE IS LITTLE CHANGE IN"
03800PRINT "THE UTILITY FROM ONE POINT TO ANOTHER. YOU MAY WANT TO "
03805PRINT "SPECIFY A NEW SET OF POINTS."
03810PRINT "IF YOU WANT TO CHANGE YOUR GAMBLES TYPE '1'."
03815PRINT "IF YOU WANT TO CHANGE THE POINTS TYPE '2'."
03820PRINT "IF YOU DON'T WANT TO DO EITHER OF THE ABOVE TYPE '0'.";
03825GOSUB 3865
03830IF O1=1 THEN 760
03835IF O1=2 THEN 3845
03840CHAIN "RSTRT"
03845CHAIN "CMODK"
03850REM****************************************************************
03855REM APPPENDED GOSUBS FOLLOW
03860REM
03865REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
03870INPUT O1
03875IF O1=-9999 THEN 3885
03880RETURN
03885CHAIN "RSTRT"
03890REM*************END ROUTINE
03895REM--SUBR. THAT DETERMINES IF RESTART REQUESTED. 2 INPUTS
03900INPUT O1,O2
03905IF O1=-9999 THEN 3920
03910IF O2=-9999 THEN 3920
03915RETURN
03920CHAIN "RSTRT"
03925REM*************END ROUTINE
09999END