10 REM DMCALC--A BASIC program to calculate predictions of Decision Models 
20 REM It should run with GWBASIC or other BASIC compilers 
30 CLS 
40 DEFDBL A,H,O,Q,R,T 
50 DEFINT I-N 
60 DEFSNG B-G,P,U-Z 
70 DIM X(10),P(10),SW(10),V(10),W(10),U(10),CP(10),CWT(10) 
80 PRINT " DMCALC: This program calculates EVs and CEs for several models." 
90 PRINT " by Michael H. Birnbaum--email: MBIRNBAUM@FULLERTON.EDU" 
100 PRINT "Copyright Michael H. Birnbaum, 1995,1996,1997,1998" 
110 PRINT "Free Software for Educational use. No warranty;";
115 PRINT" use at your own risk."
120 PRINT"":PRINT" Tversky & Kahneman (1992) Cumulative Prospect Model(CPT). "
130 PRINT " is calculated with the Lattimore, et al. (1992) weighting function"
140 PRINT:PRINT "It also calculates Certainty Equivs for EV, EU, SWU, and SWAU"
150 PRINT :PRINT "It also calculates CEs for the Configural weight, TAX model"
160 PRINT " See Birnbaum, M. H., & Chavez, A. (1997). Tests of theories of ";
165 PRINT "decision making:"
170 PRINT " Violations of branch independence and distribution independence."
180 PRINT " Organizational Behavior and Human Decision Processes, 71, 161-194."
190 PRINT :INPUT"Hit Return to Continue. Continue";K$
200 PRINT :PRINT "Note: this program handles up to 10 non-negative outcomes "
210 PRINT :PRINT "This version has built-in gambles to illustrate" 
220 PRINT " Birnbaum's (in press 1998?) chapter in the Festschrift";
225 PRINT" for Ward Edwards" 
230 PRINT " Shanteau, et al (Eds), Kluwer Academic Publishers" 
240 PRINT:PRINT "To change this program, edit gambles in the data statements" 
250 PRINT 
260 REM create file 
270 INPUT"Name of output file (e.g., test.txt)";NEMFILE$ 
280 IF NEMFILE$="" THEN NEMFILE$="test.txt" 
290 INPUT"title of output";TITLE$ 
300 REM For CPT try gamma = .61, beta = .88, and c = .72 
310 PRINT "Parameters for CPT" 
320 INPUT"exponent of utility = beta (try .88)";B 
325 IF B <= 0 THEN PRINT:PRINT"Warning!**** You must enter values":GOTO 320
330 INPUT"exp of prob weighting =gamma (try .61)";GAMMA
340 INPUT"c-of prob weighting (try .72)";C
350 IF B<= .0000001 THEN B= .88#
355 IF GAMMA<= .0001 THEN GAMMA=.61#:IF C<= .0001 THEN C=.72#
360 PRINT "Parameters for TAX Model"
370 INPUT"exponent of utility (try 1)";B1 
380 INPUT"exp of prob weighting (try .7)";G1 
390 INPUT"omega of Configural TAX Model(try -1)";OMEG 
400 IF B1<=0# THEN B1=1#: IF G1<=0# THEN G1=.7# 
410 IF OMEG>= 0# THEN PRINT :PRINT "Warning! Omega =";OMEG; "usually < 0" 
420 INPUT"Any Changes (Y/N)";A$: B$= LEFT$(A$,1):IF B$ ="y" OR B$="Y" GOTO 290
430 OPEN NEMFILE$ FOR OUTPUT AS #1 
440 PRINT #1, "Predictions of decision theories-- " 
450 PRINT #1," EV, EU, SWU, SWAU, CPT, and CWT TAX Models" 
460 PRINT #1,"Calculates predictions of CPT model with u(x) = x^beta and" 
470 PRINT #1," W(P) = (cP^g)/(cP + (1 - P)^g) where P = deCum prob, g = gamma" 
480 PRINT #1," g = "; GAMMA,: PRINT #1, "c=";C, 
490 PRINT #1," beta = "; B: PRINT #1, " " 
500 PRINT #1, "Configural, TAX Model Parameters":PRINT #1,"omega = ";OMEG 
510 PRINT #1, "Exponent of utility =";B1,:PRINT #1, "Exponent of S(p) =";G1 
520 PRINT #1, :PRINT #1, " TITLE = "; TITLE$: PRINT #1," " 
530 READ NOUTS:PRINT"no of outcomes";NOUTS 
540 IF NOUTS < 1 OR NOUTS >10 THEN PRINT"2-10 outcomes-try again":GOTO 530 
550 NOUTS = NOUTS 
560 STOT=0# 
570 VTOT=0# 
580 X(0) = -9999# 
590 FOR I = 1 TO NOUTS 
600 READ X(I): PRINT "outcome=";X(I) 
610 IF X(I) < X(I-1) THEN CLS:PRINT "enter lowest outcomes first":GOTO 530 
620 IF X(I)=9999 THEN CLOSE #1:END 
630 READ P(I): PRINT " prob of outcome =";P(I) 
640 IF P(I)<0# OR P(I) >1# THEN CLS:PRINT "prob outside range":GOTO 540 
650 STOT = STOT+P(I) 
660 NEXT 
670 IF(STOT-1!)^2 >.00001 THEN PRINT"***WARNING: TOTAL PROBABILITY="; 
675 IF (STOT-1)^2 >.00001 THEN PRINT INT(1000*STOT+.5)/1000:GOTO 530
680 STOT =0# 
690 CP(NOUTS+1)=0# 
700 FOR I = NOUTS TO 1 STEP -1 
710 CP(I) = STOT + P(I) 
720 STOT = STOT + P(I) 
730 IF CP(I) > 1# THEN CP(I) = 1# 
740 NEXT 
750 EV=0#:SWPRED=0#:SWTOT=0# 
760 EU =0#: CPT=0#: W(NOUTS+1)=0# 
770 BS=0# 
780 FOR I = NOUTS TO 1 STEP -1 
790 EV=EV+P(I)*X(I) 
800 EU = EU + P(I)*X(I)^B 
810 REM note that SWU and SWAU models use the following weights 
820 SW(I)=(C*P(I)^GAMMA)/(C*P(I)^GAMMA+(1#-P(I))^GAMMA) 
830 SWPRED=SWPRED+(SW(I))*X(I)^B 
840 SWTOT=SWTOT+SW(I) 
850 WTEMP=((C*(CP(I)^GAMMA)))/(C*(CP(I)^GAMMA)+(1#-CP(I))^GAMMA) 
860 W(I) =WTEMP-(C*CP(I+1)^GAMMA)/(C*CP(I+1)^GAMMA+(1#-CP(I+1))^GAMMA) 
870 CPT = CPT + W(I)*X(I)^B 
880 NEXT 
890 REM Note that predictions for EU, SWU, CPT, and BS are CEs 
900 REM Thus, they are in money, rather than in utility 
910 REM note that SWU (adding) is like original prospect theory 
920 SWUADD=SWPRED 
930 SWPRED=SWPRED/SWTOT 
940 CPTPRED = CPT^(1#/B) 
950 SWPRED=SWPRED^(1#/B) 
960 EUPRED =EU^(1#/B) 
970 PRINT "EV =";INT(1000*EV+.5)/1000 
980 PRINT "EU prediction (CE)=";INT(100*EUPRED+.5)/100 
990 PRINT"SWU adding version (in utility) = ";INT(1000*SWUADD+.5)/1000 
1000 PRINT "SWAU prediction (CE) =";INT(1000*SWPRED+.5)/1000 
1010 PRINT "CPT prediction (CE) ="; INT(1000*CPTPRED+.5)/1000 
1020 GOTO 1210 
1030 PRINT "CWT TAX model(CE) =";INT(1000*BSPRED+.5)/1000 
1040 PRINT :INPUT"Hit Return to continue. Continue";H$ 
1050 CLS 
1060 PRINT #1, " " 
1070 PRINT #1,"outcomes =", 
1080 FOR I = 1 TO NOUTS:PRINT #1, X(I),:NEXT 
1090 PRINT #1,"EV = ";INT(1000*EV+.5)/1000 
1100 PRINT #1,"probs =",:FOR I = 1 TO NOUTS:PRINT #1, P(I),:NEXT 
1110 PRINT #1,"EU CE = ";INT(1000*EUPRED+.5)/1000 
1120 PRINT #1, "deCum pr=", 
1130 FOR I = 1 TO NOUTS:PRINT #1,INT(1000*CP(I)+.5)/1000,:NEXT:PRINT #1,
1140 PRINT #1,"CPT wts=", 
1150 FOR I = 1 TO NOUTS:PRINT #1,INT(1000*W(I)+.5)/1000,:NEXT 
1160 PRINT #1, "CPT CE =";INT(1000*CPTPRED+.5)/1000 
1170 PRINT #1,"CWT wts=", 
1180 FOR I = 1 TO NOUTS:PRINT #1,INT(1000*CWT(I)+.5)/1000,:NEXT 
1190 PRINT #1,"CW TAX CE=";INT(1000*BSPRED+.5)/1000 
1200 GOTO 530 
1210 REM here calculate TAX model (Birnbaum & Stegner) Predictions 
1220 BS = 0#: SWTOT=0# 
1230 FOR I=1 TO NOUTS 
1240 REM IF x(i) <= 150 THEN u(i) = x(i) 
1250 U(I) = X(I)^B1 
1260 BS = BS + (U(I))*(P(I)^G1) 
1270 SWTOT=SWTOT+P(I)^G1 
1280 FOR J = 1 TO I-1 
1290 IF OMEG < 0 THEN WTRAN = P(I)^G1 
1300 IF OMEG >=0! THEN WTRAN = P(J)^G1 
1310 BS = BS + (OMEG/(NOUTS+1))*(U(I) - U(J))*WTRAN 
1320 NEXT 
1330 NEXT 
1340 BSPRED =BS/SWTOT 
1350 BSPRED=(BSPRED)^(1#/B1) 
1360 FOR I=1 TO NOUTS 
1370 CWT(I) = P(I)^G1 
1380 NEXT 
1390 TN=NOUTS 
1400 FOR I=1 TO NOUTS 
1410 FOR J=I+1 TO NOUTS 
1420 IF OMEG < 0 THEN CWT(I)=CWT(I)-(OMEG*P(J)^G1)*(1#/(TN +1#)) 
1430 IF OMEG < 0 THEN CWT(J)=CWT(J)+(OMEG*P(J)^G1)*(1#/(TN+1#)) 
1440 IF OMEG >= 0 THEN CWT(I)=CWT(I)-(OMEG*P(I)^G1)*(1#/(TN +1#)) 
1450 IF OMEG >= 0 THEN CWT(J)=CWT(J)+(OMEG*P(I)^G1)*(1#/(TN+1#))
1460 NEXT:NEXT 
1470 FOR I = 1 TO NOUTS 
1480 CWT(I) = CWT(I)/SWTOT 
1490 NEXT 
1495 GOTO 1030
1498 REM this ends the section on the TAX model
1500 REM ********************************************* 
1510 REM You can replace the following lines with other gambles. 
1520 REM For each gamble, first enter the number of outcomes. 
1530 REM Then list the outcomes and their probabilities. 
1540 REM The outcomes must be in order from lowest to highest 
1550 REM Separate everything with commas 
1560 REM ********************************************* 
1570 REM Here are gambles in Birnbaum's (in press, 1998?) chapter 
1580 REM In Shanteau, et al. (Eds.) Festschrift for Ward Edwards 
1590 REM ****** Allais Common Ratio Paradox 
1600 DATA 1,3000,1 
1610 DATA 2,0,.2,4000,.8 
1620 DATA 2,0,.75,3000,.25 
1630 DATA 2,0,.8,4000,.2 
1640 REM *********Allais Common Consequence Paradox 
1650 DATA 1,500000,1 
1660 DATA 3,0,.01,500000,.89,1000000,.1 
1670 DATA 2,0,.89,500000,.11 
1680 DATA 2,0,.9,1000000,.1 
1690 REM ****** Transparent stochastic dominance 
1700 DATA 2,100,.5,200,.5 
1710 DATA 2,100,.99,200,.01 
1720 DATA 2,110,.5,120,.5 
1730 DATA 3,101,.01,102,.01,103,.98 
1740 REM ******** Violations of Branch Independence 
1750 DATA 3,5,.333,40,.334,44,.333 
1760 DATA 3,5,.333,10,.334,98,.333 
1770 DATA 3,40,.333,44,.334,107,.333 
1780 DATA 3,10,.333,98,.334,107,.333 
1790 REM *********Violations of Cumulative Independence 
1800 DATA 3,3,.8,48,.1,52,.1 
1810 DATA 3,3,.8,10,.1,98,.1 
1820 DATA 2,10,.8,52,.2 
1830 DATA 2,10,.9,98,.1 
1840 DATA 3,40,.1,44,.1,110,.8 
1850 DATA 3,10,.1,98,.1,110,.8 
1860 DATA 2,40,.2,98,.8 
1870 DATA 2,10,.1,98,.9 
1880 REM ********Violations of Stochastic Dominance 
1890 DATA 3,12,.05,14,.05,96,.9 
1900 DATA 3,12,.1,90,.05,96,.85 
1910 REM ********* Event-Splitting Effects 
1920 DATA 2,0,.3,8,.7 
1930 DATA 2,0,.7,24,.3 
1940 DATA 3,0,.3,8,.4,8,.3 
1950 DATA 3,0,.3,0,.4,24,.3 
1960 REM ********** Violations of Distribution Independence 
1970 DATA 4,4,.59,45,.2,49,.2,110,.01 
1980 DATA 4,4,.59,11,.2,97,.2,110,.01 
1990 DATA 4,4,.01,45,.2,49,.2,110,.59 
2000 DATA 4,4,.01,11,.2,97,.2,110,.59 
2010 REM ***********To end the data put a 1-outcome gamble with 9999 
2020 REM outcome =9999 ends the program 
2030 DATA 1,9999,1 

3000 REM Return to Birnbaum's Home Page