10 X$=SYS(CHR$(7)):R$=LEFT(X$,7):L$=RIGHT(X$,8)
50  V7=0
110  DIM #1,A1(111),A2(111),A3(111)
120  OPEN R$ AS FILE 1
160 IF A1(0)=99 THEN 180
170 CHAIN"CMODQ"
180 A1(0)=20
410DIM N(84),G(7,1),F(7,1),X(84),U(9),P(9),K(9),Y(84)
560  G9=0
570  F9=-1
580  PRINT L$
600 FOR I=1 TO 84:Y(I)=A2(I-1):NEXT I
605FOR I=1 TO 9:P(I)=A2(I+83):U(I)=A2(I+92):M(I)=A2(I+101):NEXT I
610 G1=A3(53):G2=A3(54):G3=A3(55)
620 FOR I=1 TO 9:M(I)=A3(I-1):NEXT I
624 FOR I=1 TO 16:E(I)=A3(I+8):NEXT I
625 FOR I=1 TO 27:C(I)=A3(25+I):NEXT I
680DIM Q(9),R(9,9),V(9,1),L(9,1)
690DIM A(7),B(7,7),W(9),D(9),E(16),M(9),C(27)
700  W(1)=0
710  W(9)=1
720  D(1)=0
730  D(9)=0
740  I9=0
780 E9=.005
790  E8=.005
800  PRINT L$
810  N0=7
860  N1=N0+1
870  N2=N0+2
880  N3=N0-1
1190  GOTO 1230
1200  U9=U0
1210  GOSUB 4380
1220  GOSUB 4510
1230  PRINT L$
1240  GOSUB 4380
1250  PRINT "IF YOU WANT A LIST OF THE GAMBLES TYPE '1' ELSE '0'.";
1260  GOSUB 9000
1270  IF O1=1 THEN 1230
1280  MAT X=Y
1290  GOSUB 3760
1300  I9=1
1310  FOR I=2 TO 5
1320  IF U(I)-U(I-1)>.005 THEN 1340
1330  U(I)=U(I-1)+.005
1340  NEXT I
1350  FOR I=8 TO 5 STEP -1
1360  IF U(I+1)-U(I)>.005 THEN 1380
1370  U(I)=U(I+1)-.005
1380  NEXT I
1390 FOR I=1 TO 84:A2(I-1)=Y(I):NEXT I
1395 FOR I=1 TO 9:A2(83+I)=P(I):A2(I+92)=U(I):A2(I+101)=M(I):NEXT I
1400 A3(0)=G1:A3(1)=G2:A3(2)=G3
1410  GOSUB 6660
1420  PRINT "IF YOU WANT TO CHANGE ANY GAMBLES TYPE '1' ELSE '0'.";
1430  GOSUB 9000
1440  PRINT L$
1450  IF O1=1 THEN 1230
1460  PRINT "A LEAST SQUARES (LSQ) FIT OF THE SPECIFIED POINTS WILL NOW"
1470PRINT"BE ATTEMPTED USING AN ITERATIVE PROCEDURE."
1490  GOTO 1510
1500  F9=F0
1510  FOR J=2 TO N1
1520  I=J-1
1530  K=J+1
1540  IF U(I) >= U(J) THEN 1570
1550  IF U(K) <= U(J) THEN 1570
1560  GOTO 1590
1570  PRINT "THE UTILITY AT POINT";M(J);"IS NOT MONOTONIC"
1580  G9=1
1590  NEXT J
1600  IF G9 <> 1 THEN 1640
1610  PRINT
1620  G9=0
1630  GOTO 6950
1640  FOR S1=2 TO N1
1650  S5=0
1660  S0=0
1670  FOR J=2 TO N1
1680  J0=J-1
1690  J1=J+1
1700  FOR I=1 TO J0
1710  FOR K=J1 TO N2
1720  S0=S0+1
1730  IF Y(S0)<0 THEN 1860
1740  S2=0
1750  IF I <> S1 THEN 1770
1760  S2=1
1770  S3=0
1780  IF J <> S1 THEN 1800
1790  S3=1
1800  S4=0
1810  IF K <> S1 THEN 1830
1820  S4=1
1830  S6=LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J)))
1840  S7=1/(U(J)-U(I))*S2-(1/(U(K)-U(J))+1/(U(J)-U(I)))*S3
1850  S5=S5+S6*(S7+1/(U(K)-U(J))*S4)
1860  NEXT K
1870  NEXT I
1880  NEXT J
1890  A(S1-1)=S5
1900  NEXT S1
1910  REM--NOW HAVE AS
1920 GOSUB 4950
1940  REM--F0 IS FUNCTION VALUE
1950  PRINT "ITERATION ";I9;
1960  PRINT "FUNCTION VALUE IS";F0
1970  MAT B=ZER
1980  FOR S1=2 TO N1
1990  FOR T1=2 TO N1
2000  S2=S1-1
2010  T2=T1-1
2020  S0=0
2030  FOR J=2 TO N1
2040  J0=J-1
2050  J1=J+1
2060  FOR I=1 TO J0
2070  FOR K=J1 TO N2
2080  S0=S0+1
2090  IF Y(S0)<0 THEN 2370
2100  IF S1 >= T1 THEN 2190
2110  IF J <> S1 THEN 2130
2112  IF K <> T1 THEN 2130
2120  B(S2,T2)=B(S2,T2)-1/(U(T1)-U(S1))*(1/(U(T1)-U(S1))+1/(U(S1)-U(I)))
2130  IF I <> S1 THEN 2160
2132  IF K=T1 THEN 2150
2140  GOTO 2160
2150  B(S2,T2)=B(S2,T2)+1/(U(J)-U(S1))/(U(T1)-U(J))
2160  IF I <> S1 THEN 2370
2162  IF J <> T1 THEN 2370
2170  B(S2,T2)=B(S2,T2)-1/(U(T1)-U(S1))*(1/(U(K)-U(T1))+1/(U(T1)-U(S1)))
2180  GOTO 2370
2190  IF S1=T1 THEN 2280
2200  IF J <> T1 THEN 2220
2202  IF K <> S1 THEN 2220
2210  B(S2,T2)=B(S2,T2)-1/(U(S1)-U(T1))*(1/(U(S1)-U(T1))+1/(U(T1)-U(I)))
2220  IF I <> T1 THEN 2230
2222  IF K=S1 THEN 2240
2230  GOTO 2250
2240  B(S2,T2)=B(S2,T2)+1/(U(J)-U(T1))/(U(S1)-U(J))
2250  IF I <> T1 THEN 2370
2252  IF J <> S1 THEN 2370
2260  B(S2,T2)=B(S2,T2)-1/(U(S1)-U(T1))*(1/(U(K)-U(S1))+1/(U(S1)-U(T1)))
2270  GOTO 2370
2280  IF I=S1 THEN 2300
2290  GOTO 2310
2300  B(S2,T2)=B(S2,T2)+1/(U(J)-U(S1))/(U(J)-U(S1))
2310  IF J=S1 THEN 2330
2320  GOTO 2340
2330  B(S2,T2)=B(S2,T2)+(1/(U(K)-U(S1))+1/(U(S1)-U(I)))^2
2340  IF K=S1 THEN 2360
2350  GOTO 2370
2360  B(S2,T2)=B(S2,T2)+1/(U(S1)-U(J))/(U(S1)-U(J))
2370  NEXT K
2380  NEXT I
2390  NEXT J
2400  NEXT T1
2410  NEXT S1
2420  I9=I9+1
2430  N=7
2440  GOSUB 5230
2450  GOSUB 4290
2460  IF ABS(F0-F9)>E9 THEN 1500
2470  FOR I1=2 TO N1
2480  IF ABS(D(I1))>E8 THEN 1500
2490  NEXT I1
2500  PRINT L$
2510  FOR I=1 TO 84
2520  N(I)=-1
2530  NEXT I
2540  V7=0
2550  PRINT " UTILITIES         FOR         GAMBLES      INDIFFERENCE P"
2560  GOTO 2580
2570PRINT
2580  PRINT "INITIAL  LSQ      SURE        P       1-P  SPECIFIED FITTED"
2590  FOR I=1 TO 7
2600  J=I+1
2610  K=I+2
2620  S9=0
2630  FOR I0=0 TO J-2
2640  S9=S9+I0*(N2-1-I0)
2650  NEXT I0
2660  S0=S9+(I-1)*(N2-J)+K-J
2670  IF V7=1 THEN 2710
2680  Y1=(U(J)-U(I))/(U(K)-U(I))
2690  X7=(LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J))))^2
2700  N(S0)=Y1
2710  IF V7=0 THEN 2810
2720  IF I=1 THEN 2770
2740PRINT"                 ";
2750  GOTO 2790
2770PRINT"ADJACENT GAMBLES ";
2790 A$="##. ####.## ####.## ######.##     .##"
2791  PRINT  USING  A$ ,I,M(J),M(K),M(I),Y(S0)
2800  GOTO 2910
2810  REM
2830  IF K(J) >= .995 THEN 2880
2840  IF U(J) >= .995 THEN 2880
2860A$=" .##     .##    "
2861PRINT USING A$,K(J),U(J);
2870  GOTO 2890
2880A$="#.##    #.##    "
2881PRINT USING A$,K(J),U(J);
2890A$="####.## ######.## #####.##    .##     .##   "
2891  PRINT  USING  A$ ,M(J),M(K),M(I),X(S0),Y1
2910  NEXT I
2920  IF V7=0 THEN 2960
2940PRINT"2-APART GAMBLES  ";
2960K0=1:K6=8:K1=15
3000  GOSUB 3250
3010  IF V7=0 THEN 3050
3030PRINT"3-APART GAMBLES  ";
3040  GOTO 3060
3050  REM IF G2<>1 THEN 3020
3060  K0=16
3070  K6=13
3080  K1=24
3090  GOSUB 3250
3100  IF V7=0 THEN 3140
3120PRINT"4-APART GAMBLES  ";
3130  GOTO 3150
3140  REM IF G3<>1 THEN 3810
3150  K0=25
3160  K6=16
3170  K1=27
3180  GOSUB 3250
3190  IF V7=1 THEN 4480
3200  GOTO 3970
3210  INPUT I1
3220  IF I1 <> 1 THEN 4080
3230  MAT Y=N
3240  GOTO 1230
3250  FOR I1=K0 TO K1 STEP 3
3260  I=INT(C(I1)/.5+1.5)
3270  J=INT(C(I1+1)/.5+1.5)
3280  K=INT(C(I1+2)/.5+1.5)
3290  S9=0
3300  FOR I0=0 TO J-2
3310  S9=S9+I0*(N2-1-I0)
3320  NEXT I0
3330  S0=S9+(I-1)*(N2-J)+K-J
3340  IF V7=1 THEN 3410
3350  Y1=(U(J)-U(I))/(U(K)-U(I))
3360  N(S0)=Y1
3370  IF Y(S0)<0 THEN 3640
3380  X7=(LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J))))^2
3390  IF V7=0 THEN 3590
3400 REM
3410  IF K6=8 THEN 3470
3420  IF K6=13 THEN 3470
3430  IF K6=16 THEN 3470
3450PRINT"                 ";
3470A$="##. ####.## ####.## ######.##  "
3471PRINTUSING A$,K6,M(J),M(K),M(I);
3490  K6=K6+1
3500  IF Y(S0)=-1 THEN 3570
3510  IF Y(S0)=-8888 THEN 3550
3530A$="   .##"
3531  PRINT  USING  A$ ,Y(S0)
3540  GOTO 3730
3550  PRINT "    DEL"
3560  GOTO 3730
3570  PRINT "    UNS"
3580  GOTO 3730
3590REM
3610PRINT"                ";
3620A$="####.## ######.## #####.##    .##     .##   "
3621  PRINT  USING  A$ ,M(J),M(K),M(I),Y(S0),Y1
3630  GOTO 3730
3640PRINT"                ";
3650A$="####.## ######.## #####.##    "
3651PRINT USING A$,M(J),M(K),M(I);
3660  IF Y(S0) <> -8888 THEN 3700
3680A$="DEL     .##"
3681  PRINT  USING  A$ ,Y1
3690  GOTO 3730
3700  IF Y(S0) <> -1 THEN 3730
3720A$="UNS     .##"
3721  PRINT  USING  A$ ,Y1
3730  NEXT I1
3740  RETURN
3760  REM--*****routine to calculate utilities from probabilities
3770  FOR I=1 TO N0
3780  Q(I)=P(I+1)
3790  NEXT I
3800  MAT R=IDN
3810  FOR I=1 TO N3
3820  R(I,I+1)=-Q(I)
3830  R(8-I,7-I)=-(1-Q(8-I))
3840  NEXT I
3850  MAT L=ZER
3860  L(7,1)=Q(7)
3870 MAT R=INV(R)
3880 MAT V=R*L
3890  FOR I=1 TO N0
3900  U(I+1)=V(I,1)
3910  NEXT I
3920  U(1)=0
3930  U(N2)=1
3940  MAT K=U
3950  RETURN
3960  REM--*****END OF ROUTINE*****
3970REM
3980  PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
3990  PRINT "  1. ACCEPT THE LEAST SQUARES (LSQ) UTILITIES."
4000  PRINT "  2. MODIFY P VALUES USING THE FITTED SET AS WORKING SET."
4010  PRINT "  3. MODIFY P VALUES USING SPECIFIED SET AS WORKING SET."
4020  GOSUB 9000
4030  IF O1 <> 2 THEN 4130
4040  MAT Y=N
4050  P(2)=Y(1)
4060  P(3)=Y(14)
4070  P(4)=Y(30)
4080  P(5)=Y(47)
4090  P(6)=Y(63)
4100  P(7)=Y(76)
4110  P(8)=Y(84)
4120  GOTO 1230
4130  IF O1=1 THEN 4160
4140  PRINT L$
4150  GOTO 1230
4160  MAT P=M
4170  PRINT "IF YOU WANT TO TRY A NORMAL OGIVE FIT TYPE '1', ELSE '0'.";
4180  GOSUB 9000
4190REM
4200  IF O1 <> 1 THEN 4230
4210 FOR I=1 TO 84:A2(I-1)=X(I):NEXT I
4215 FOR I=1 TO 9:A2(I+83)=P(I):A2(I+92)=U(I):A2(I+101)=M(I):NEXTI
4220  CLOSE 1: CHAIN "CMODL"
4230  PRINT "IF YOU WANT THE EXPECTED UTILITY FOR LSQ FIT TYPE '1' ELSE '0'.";
4240  GOSUB 9000
4250  IF O1=0 THEN 4280
4260FOR I=1 TO 9:A2(I-1)=M(I):A2(I+8)=U(I):NEXT I
4270  CLOSE 1: CHAIN "CMODP"
4280  CLOSE 1: CHAIN "RSTRT"
4290  REM--*****ROUTINE TO HANDLE NEW AND OLD VALUES OF U'S*****
4300  FOR I=2 TO N1
4310  W(I)=U(I)
4320  D(I)=A(I-1)
4330  U(I)=W(I)-A(I-1)
4340  NEXT I
4350  E0=1
4360  RETURN
4370  REM--***** END OF ROUTINE*****
4380  REM--*****ROUTINE THAT SUMMARIZES GAMBLES SPECIFIED.*****
4390  V7=1
4420PRINT"                   ";
4430  PRINT "     FOR       GAMBLE     INDIFFERENCE  P"
4450PRINT"                ";
4460  PRINT " NO.   SURE      P       1-P    SPECIFIED"
4470  GOTO 2590
4480  GOTO 4520
4500  REM--*****END OF ROUTINE*****
4510  REM--*****ROUTNE FOR INPUTTING GAMBLES*****
4520  PRINT
4530  PRINT "TO CHANGE OR ADD A GAMBLE TYPE THE NUMBER (NO.) OF THE GAMBLE"
4540  PRINT "AND THE P VALUE YOU WANT.   TO DELETE A GAMBLE TYPE  '-1'. IF"
4550  PRINT "YOU WANT TO LEAVE ALL GAMBLES AS THEY ARE TYPE '0,0'."
4560  GOSUB 9050
4570  IF O2=0 THEN 4920
4580  IF O1 >= 1 THEN 4610
4590  PRINT "REENTER.  INPUT NUMBER OF THE GAMBLE FIRST."
4600  GOTO 4560
4610  IF O1>16 THEN 4590
4620  IF O2 <> -1 THEN 4680
4630  IF O1<8 THEN 4660
4640  Y(E(O1))=-8888
4650  GOTO 4900
4660  PRINT "REENTER.  ADJACENT GAMBLES CANNOT BE DELETED."
4670  GOTO 4560
4680  IF O2 >= .05 THEN 4720
4690  PRINT
4700  PRINT "REENTER.  P MUST BE AT LEAST .05 BUT NOT MORE THAN .95."
4710  GOTO 4560
4720  IF O2>.95 THEN 4690
4730  Y(E(O1))=O2
4740  IF O1>7 THEN 4760
4750  P(O1+1)=O2
4760  GOTO 4900
4770  GOTO 4900
4780  IF J-I=K-J THEN 4810
4790  PRINT "ONLY SYMETRIC GAMBLES ARE ACCEPTED.  PLEASE RESPECIFY."
4800  GOTO 4900
4810  S9=0
4820  FOR I0=0 TO J-2
4830  S9=S9+I0*(N2-1-I0)
4840  NEXT I0
4850  S0=S9+(I-1)*(N2-J)+K-J
4860  Y(S0)=M3
4870  G3=0
4880  IF Y(38)=-8888 THEN 4900
4890  G3=1
4900  PRINT "TYPE NEXT CHANGE OR '0,0'.";
4910  GOTO 4560
4920  RETURN
4950 F0,F2,F3,F4,F5,S0,D3,D4,X7=0
4960  F2=0
4970  F3=0
4980  F4=0
4990  F5=0
5000  S0=0
5010  D3=0
5020  D4=0
5030  X7=0
5040  FOR J=2 TO N1
5050  J0=J-1
5060  J1=J+1
5070  FOR I=1 TO J0
5080  FOR K=J1 TO N2
5090  S0=S0+1
5100  IF Y(S0)<0 THEN 5150
5110  F1=(LOG(Y(S0)/(1-Y(S0)))-LOG((U(J)-U(I))/(U(K)-U(J))))^2
5120  F0=F0+F1
5140  X7=X7+1
5150  NEXT K
5160  NEXT I
5170  NEXT J
5180  F6=F0/X7
5190  IF X7 <= 7 THEN 5210
5200  F0=F0/(X7-7)
5210  RETURN
5230  REM--***** routine to solve linear equations*****
5240 MAT B=INV(B)
5250  FOR I=1 TO 7
5260  F(I,1)=A(I)
5270  NEXT I
5280 MAT G=B*F
5290  FOR I=1 TO 7
5300  A(I)=G(I,1)
5310  NEXT I
5320  E0=1
5940 RETURN
5951  PRINT  USING  A$ ,I,Y(K9)
5960  RETURN
5970PRINT USING A$,I,Y(K9),Y(K8)
5980  RETURN
5990PRINT USING A$,I,Y(K9),Y(K8),Y(K7)
6000  RETURN
6010PRINT USING A$,I,Y(K9),Y(K8),Y(K7),Y(K6)
6020  RETURN
6040  I=M(2)
6045A$="###.##     #####.##         #####.##         #####.##         #####.##"
6050  K9=1
6060  GOSUB 5940
6070  I=M(3)
6080  K9=14
6090  K8=9
6100  GOSUB 5970
6110  I=M(4)
6120  K9=30
6130  K8=26
6140  K7=22
6150  GOSUB 5990
6160  I=M(5)
6170  K9=47
6180  K8=44
6190  K7=41
6200  K6=38
6210  GOSUB 6010
6220  I=M(6)
6230  K9=63
6240  K8=61
6250  K7=59
6260  GOSUB 5990
6270  I=M(7)
6280  K9=76
6290  K8=75
6300  GOSUB 5970
6310  I=M(8)
6320  K9=84
6330  GOSUB 5940
6340  RETURN
6660  REM--*****ROUTINE TO PRINT INITIAL UTILITIES*****
6670  PRINT L$
6680  PRINT "HERE ARE YOUR UTILITIES FOR THE SOLUTION BASED ON ONLY THE"
6690  PRINT "ADJACENT GAMBLES.  THESE WILL BE REFERRED TO AS THE INITIAL"
6700  PRINT "UTILITIES."
6710  PRINT
6720  S3=0
6730  PRINT "           POINT    UTILITIES"
6740  FOR I=1 TO N2
6760PRINT"         ";
6770  IF I=1 THEN 6800
6780  IF U(I)-U(I-1)>.03 THEN 6800
6790  S3=1
6800A$="####.##       #.##"
6801  PRINT  USING  A$ ,M(I),U(I)
6810  NEXT I
6820  PRINT
6940  RETURN
6960  PRINT "A LEAST SQUARE FIT CAN NOT BE OBTAINED FROM YOUR SET"
6970PRINT"OF GAMBLES. CHECK YOUR GAMBLES TO SEE IF THEY ACTUALLY"
6975PRINT"REFLECT WHAT YOU BELIEVE.  YOU MAY WANT TO CHANGE SOME."
6977PRINT"GAMBLES AND SEE IF THIS REMOVES THE NON-MONOTONICITY."
6978PRINT"NON-MONOTONICITY OCCURS BECAUSE THERE IS LITTLE CHANGE IN"
6979PRINT"THE UTILITY FROM ONE POINT TO ANOTHER.  YOU MAY WANT TO"
6980PRINT"SPECIFY A NEW SET OF POINTS."
6981PRINT"IF YOU WANT TO CHANGE YOUR GAMBLES TYPE '1'."
6982PRINT"IF YOU WANT TO CHANGE THE POINTS TYPE '2'."
6983PRINT"IF YOU DON'T WANT TO DO EITHER OF THE ABOVE TYPE '0'."
6990  GOSUB 9000
7000  IF O1=1 THEN 1230
7005IF O1=2 THEN 7015
7010  CLOSE 1: CHAIN "RSTRT"
7015CHAIN"CMODK"
9000  REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
9005  INPUT O1
9015 IF O1=-9999 THEN 9080
9020  RETURN
9050  REM--SUBR. THAT DETERMINES IF RESTART REQUESTED. 2 INPUTS
9055  INPUT O1,O2
9065  IF O1=-9999 THEN 9080
9070  IF O2=-9999 THEN 9080
9075  RETURN
9080  CLOSE 1: CHAIN "RSTRT"
9999  END