10 X$=SYS(CHR$(7)):R$=LEFT(X$,7):L$=RIGHT(X$,8) 20 REM ********************************************************** 30 REM CMODB CMODB CMODB CMODB CMODB CMODB CMODB 40 REM ************************************************************* 50 REM 60 REM THIS MODULE IS PRIMARILY DESIGNED FOR GETTING PERCENTILES, HDRS 70 REM AND OTHER INTERVALS FOR BETA DISTRIBUTIONS. IN ADDITION IT IS 80 REM USED TO CALCULATE EXPECTED PIECEWISE UTILITIES. 90 REM_ 100 REM MODULE IS ACCESSED BY: COMPONENTS 1, 8, AND 15 110 REM 120 REM ANALYSIS OF BETA DISTRIBUTION 130 REM 140 REM********************************************************* 150 DIM #1,A1(111),A2(111),A3(111) 160 OPEN R$ AS FILE 1 170 GOSUB 5160 200 I3=A1(2) 210 REM 220 REM IF I3 = 8 THEN COMING FROM EXPECTED UTILITY COMPONENT 230 REM 240 IF I3=8 THEN 2870 250 A1(0)=11 260 A=A3(0):B=A3(1) 270 S6=0 280 L9=0 290 REM 300 REM IF A=0 THEN PARAMETERS WERE NOT PASSED 310 REM 320 IF A=0 THEN 340 330 L9=1 340 PRINT L$ 350 X=0 360 REM 370 REM 380 PRINT " EVALUATION OF A BETA DISTRIBUTION" 390 PRINT 400 PRINT "THIS MODULE ALLOWS YOU TO EXAMINE THE CHARACTERISTICS OF A" 410 PRINT "BETA DISTRIBUTION." 420 GOTO 620 430 PRINT 440 PRINT 450 PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT." 460 PRINT " 1. PERCENTILES" 470 PRINT " 2. HIGHEST DENSITY REGIONS" 480 PRINT " 3. PROBABILITY PI IS LESS THAN SOME VALUE" 490 PRINT " 4. PROBABILITY PI IS BETWEEN TWO VALUES" 500 PRINT " 5. EXIT MODULE" 510 GOSUB 9000 520 IF O1=5 THEN 2760 530 I=O1 540 GOTO 880 550 PRINT 560 PRINT "REENTER. INPUT MUST BE 1,2,3,4 OR 5." 570 GOTO 440 580 REM 590 REM L9=1 IF THE PARAMETERS HAVE BEEN PASSED FROM OTHER MODULE 600 REM S6=1 IF THE PARAMETERS ARE NOT TO BE CHANGED 610 REM 620 IF L9=1 THEN 430 630 IF S6=1 THEN 440 640 S6=1 650 PRINT 660 REM ***************************************************************** 670 REM 680 REM INPUT PARAMETERS OF BETA DISTRIBUTION 690 REM 700 PRINT "INPUT FIRST PARAMETER (A) OF THE BETA DISTRIBUTION."; 710 GOSUB 9000 720 A=O1 730 IF A<1.1 THEN 800 740 PRINT 750 PRINT "INPUT SECOND (B) PARAMETER."; 760 GOSUB 9000 770 B=O1 780 IF B<1.1 THEN 800 790 GOTO 440 800 PRINT "REENTER. PARAMETERS MUST BE AT LEAST 1.1." 810 PRINT 820 GOTO 700 830 REM 840 REM END OF INPUT ROUTINE 850 REM ******************************************************* 860 REM ROUTINE TO DETERMINE OPTION WANTED 870 REM 880 GOSUB 5220 890 IF I=3 THEN 2070 900 IF I=4 THEN 2380 910 IF I=2 THEN 1310 920 IF I=1 THEN 1630 930 GOTO 550 940 REM 950 REM END OF OPTION SELECTION ROUTINE 960 REM ******************************************************* 970 PRINT L$ 980 REM ******************************************************* 990 REM OPTION SELECTION AFTER EXITING ROUTINE 1000 REM 1010 REM IF THE MODULE WAS ENTERED TO EVALUATE A POSTERIOR BETA 1020 REM (L9=1) THEN THERE IS NO OPTION TO EVALUATE ANOTHER BETA. 1030 REM 1040 PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT." 1050 PRINT " 1. FURTHER EVALUATE THIS DISTRIBUTION" 1060 IF L9=1 THEN 1160 1070 PRINT " 2. EVALUATE ANOTHER BETA DISTRIBUTION" 1080 PRINT " 3. EXIT MODULE" 1090 PRINT " "; 1100 GOSUB 9000 1110 IF O1=1 THEN 1230 1120 IF O1=3 THEN 1220 1130 IF O1=2 THEN 1250 1140 PRINT "REENTER. INPUT MUST BE 1,2 OR 3." 1150 GOTO 1100 1160 PRINT " 2. EXIT MODULE" 1170 GOSUB 9000 1180 IF O1=1 THEN 1230 1190 IF O1=2 THEN 1220 1200 PRINT "REENTER. INPUT MUST BE 1 OR 2." 1210 GOTO 1170 1220 CLOSE 1: CHAIN "RSTRT" 1230 S6=1 1240 GOTO 1260 1250 S6=0 1260 PRINT L$ 1270 GOTO 620 1280 REM 1290 REM END OF ROUTINE 1300 REM *************************************************** 1310 PRINT L$ 1320 PRINT " OPTION 2: HIGHEST DENSITY REGIONS" 1330 PRINT 1340 PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT." 1350 PRINT "INPUT P% AS NUMBER FROM 5 THROUGH 99." 1360 GOSUB 1390 1370 GOTO 1440 1390PRINT"---------------------------------------------------------" 1400A$="BETA DISTRIBUTION A=#####.## B=#####.##" 1401 PRINT USING A$ ,A,B 1420PRINT"---------------------------------------------------------" 1430 RETURN 1440 PRINT 1450 PRINT "INPUT P%"; 1460 GOSUB 9000 1470 IF O1=0 THEN 970 1480 J5=O1/100 1490 IF J5<.05 THEN 1550 1500 IF J5>.99 THEN 1550 1510 GOSUB 7000 1520A$=" ##.#% HDR = ( .## - #.##)" 1521 PRINT USING A$ ,J5*100,J1,J2 1540 GOTO 1450 1550 PRINT 1560 PRINT "REENTER. INPUT MUST BE '0' OR ACCEPTABLE P%." 1570 PRINT 1580 GOTO 1450 1590 REM 1600 REM END OF HDR ROUTINE 1610 REM 1620 REM ************************************************************** 1630 PRINT L$ 1640 PRINT 1650 PRINT " OPTION 1: PERCENTILES" 1660 PRINT 1670 PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT." 1680 PRINT "INPUT PERCENTILES AS NUMBERS FROM .5 THROUGH 99.5." 1690 GOSUB 1390 1700 PRINT 1710 PRINT "INPUT PERCENTILE"; 1720 GOSUB 9000 1730 P1=O1 1740 IF P1=0 THEN 970 1750 IF P1<.5 THEN 1780 1760 IF P1 <= 99.5 THEN 1810 1770 PRINT 1780 PRINT "REENTER. INPUT MUST BE 0 OR ACCEPTABLE VALUE." 1790 PRINT 1800 GOTO 1710 1810 E1=0 1820 E2=1 1830 A7=0 1840 A8=.999999 1850 A6=P1/100 1860 S9=(A6-A7)/(A8-A7) 1865 IF S9<.85 THEN 1870 1866 S9=.85 1867 GOTO 1880 1870 IF S9>.15 THEN 1880 1875 S9=.15 1880 J2=E1+S9*(E2-E1) 1890 J1=0 1900 GOSUB 5000 1905 IF ABS(E1-E2)<.0001 THEN 1990 1910 IF ABS(P-A6)<.0009 THEN 1990 1920 IF P>A6 THEN 1960 1930 E1=J2 1940 A7=P 1950 GOTO 1860 1960 E2=J2 1970 A8=P 1980 GOTO 1860 1990A$=" ##.#% = #.##" 1991 PRINT USING A$ ,P1,J2 2010 E2=1 2020 GOTO 1710 2030 REM 2040 REM END OF PERCENTILE ROUTINE 2050 REM 2060 REM *************************************************** 2070 PRINT L$ 2080 PRINT " OPTION 3: PROBABILITY PI IS LESS THAN X" 2090 PRINT 2100 PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR VALUE OF X." 2110 PRINT "INPUT X AS A NUMBER BETWEEN 0 AND 1." 2120 GOSUB 1390 2130 PRINT 2140 PRINT "INPUT X"; 2150 GOSUB 9000 2160 IF O1=0 THEN 970 2170 X=O1 2180 IF X <= 0 THEN 2210 2190 IF X >= 1 THEN 2210 2200 GOTO 2250 2210 PRINT 2220 PRINT "REENTER. INPUT MUST BE 0 OR SOME NUMBER BETWEEN 0 AND 1." 2230 PRINT 2240 GOTO 2140 2250 J1=0 2260 J2=X 2270 GOSUB 5000 2280 IF I3=8 THEN 3160 2290A$=" PROB( PI < .### ) = #.##" 2291 PRINT USING A$ ,X,P 2310A$=" PROB( PI > .### ) = #.##" 2311 PRINT USING A$ ,X,1-P 2330 GOTO 2130 2340 REM 2350 REM END OF PROBABILITY LESS THAN ROUTINE 2360 REM 2370 REM ********************************************************** 2380 PRINT L$ 2390 PRINT " OPTION 4: PROBABILITY PI IS BETWEEN TWO VALUES" 2400 PRINT 2410 PRINT "TO EXIT ROUTINE TYPE '0''S WHEN ASKED FOR INPUT." 2420 GOSUB 1390 2430 PRINT 2440 PRINT "INPUT SMALLER VALUE"; 2450 GOSUB 9000 2460 X3=O1 2470 IF X3=0 THEN 2530 2480 IF X3<0 THEN 2510 2490 IF X3 >= 1 THEN 2510 2500 GOTO 2530 2510 PRINT "VALUE MUST BE POSITIVE AND LESS THAN 1." 2520 GOTO 2440 2530 PRINT "INPUT LARGER VALUE"; 2540 GOSUB 9000 2550 IF X3 <> 0 THEN 2560 2555 IF O1=0 THEN 970 2560 X4=O1 2570 IF X4 <= 0 THEN 2600 2580 IF X4 >= 1 THEN 2600 2590 GOTO 2640 2600 PRINT 2610 PRINT "VALUE MUST BE GREATER THAN 0 AND LESS THAN 1." 2620 PRINT 2630 GOTO 2530 2640 IF X3 >= X4 THEN 2770 2650 J1=X3 2660 J2=X4 2670 GOSUB 5000 2680 P4=P 2690A$=" PROB( .### < PI < #.### ) = #.##" 2691 PRINT USING A$ ,X3,X4,P 2710 GOTO 2440 2720 REM 2730 REM END OF BETWEEN TWO VALUES ROUTINE 2740 REM 2750 REM *********************************************************** 2760 CLOSE 1: CHAIN "RSTRT" 2770 PRINT 2780 PRINT "ENTER SMALLER VALUE FIRST. REENTER." 2790 PRINT 2800 GOTO 2440 2810 REM **************************************************************** 2820 REM 2830 REM ROUTINE TO CALCULATE EXPECTED UTILITY 2840 REM ENTER VIA THE EXPECTED UTILITIES COMPONENT (8) 2850 REM 2860 REM 2870 DIM M(9),U(9),P(3) 2880 FOR I=1 TO 9:M(I)=A3(I-1):U(I)=A3(I+8):NEXT I 2885 FOR I=1 TO 3:P(I)=A3(I+17):NEXT I 2888 PRINT L$ 2890 A=P(1) 2900 B=P(2) 2910 GOSUB 5220 2920 K8=0 2930 P0=0 2940 K5=2 2950 IF M(1)=0 THEN 3010 2960 J1=0 2970 J2=M(1) 2980 GOSUB 5000 2990 K8=P 3000 P0=P 3010 U9=0 3020 IF M(9)=1 THEN 3070 3030 J1=0 3040 J2=M(9) 3050 GOSUB 5000 3060 K8=K8+1-P 3070 PRINT "BETA DISTRIBUTION" 3071 PRINT 3074 PRINT "PARAMTER A=";A;" PARAMETER B=";B 3075 PRINT 3080 PRINT "THE EXPECTED UTILITY IS BEING COMPUTED." 3082 PRINT 3090 FOR I7=M(1) TO M(9) STEP (M(9)-M(1))/110 3100 I=I7 3110 IF I=0 THEN 3200 3120 IF I>.9999 THEN 3210 3130 IF I>M(K5) THEN 3290 3140 X=I 3150 GOTO 2250 3160 U9=U9+(P-P0)*U(K5-1) 3170 P1=P0 3180 U9=U9+(P-P1)*(I-M(K5-1))*((U(K5)-U(K5-1))/(M(K5)-M(K5-1))) 3190 P0=P 3200 NEXT I7 3210 U9=U9/(1-K8) 3220 PRINT 3240A$="THE EXPECTED UTILITY IS ##.## ." 3241 PRINT USING A$ ,U9 3242 DIM V(1) 3244 V(1)=1 3245A3(0)=V(1):FOR I=1 TO 9:A3(I)=M(I):A3(I+9)=U(I):NEXT I 3246FOR I=1 TO 3:A3(I+18)=P(I):NEXT I 3250 PRINT 3260 PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'."; 3270 GOSUB 9000 3280 CLOSE 1: CHAIN "CMODP" 3290 K5=K5+1 3300 GOTO 3150 3310 REM 3320 REM 3330 REM END OF THE EXPECTED UTILITY ROUTINE 3340 REM *************************************************************** 3350 REM 3360 REM APPENDED GOSUBS FOLLOW 3370 REM 5000 REM *************************************************** 5005 REM BETA CDF ROUTINE 5010 REM INPUT A B J2 5015 REM OUTPUT P 5020 REM GOSUB'S TO BE CALLED PRIOR 5160 AND 5220 5025 DIM W(16),O(16) 5030 GOSUB 5340 5035 IF A+B>85 THEN 5280 5040 P=0 5045 C6=0 5050 IF A>1 THEN 5080 5055 C6=A 5060 C7=B 5065 A=C7 5070 B=C6 5075 J2=1-J2 5080 D0=(J2-J1)*.5 5085 D1=(J1+J2)*.5 5090 FOR I1=1 TO 16 5095 D9=D0*O(I1)+D1 5100 IF D9=0 THEN 5115 5105 IF D9=1 THEN 5115 5107 D9=LOG(D9)*(A-1)+LOG(1-D9)*(B-1) 5108 IF D9<-80 THEN 5115 5110 P=P+W(I1)*EXP(D9) 5115 NEXT I1 5120 P=P*F0 5125 P=P*D0 5130 IF C6=0 THEN 5155 5135 A=C6 5140 B=C7 5145 P=1-P 5150 J2=1-J2 5155 RETURN 5160 FOR I1=1 TO 16 5165 READ W(I1),O(I1) 5170 NEXT I1 5175 DATA 2.71525E-02,-.989401 5180 DATA 6.22535E-02,-.944575,9.51585E-02,-.865631 5185 DATA .124629,-.755404,.149596,-.617876 5190 DATA .169156,-.458017,.182603,-.281604,.189451,-9.50125E-02 5195 DATA .189451,9.50125E-02,.182603,.281604,.169156,.458017 5200 DATA .149596,.617876,.124629,.755404 5205 DATA 9.51585E-02,.865631,6.22535E-02,.944575,2.71525E-02 5210 DATA .989401 5215 RETURN 5220 G9=A+B 5225 GOSUB 5850 5230 F0=G0 5235 G9=A 5240 GOSUB 5850 5245 F0=F0-G0 5250 G9=B 5255 GOSUB 5850 5260 F0=F0-G0 5265 IF A+B>85 THEN 5275 5270 F0=EXP(F0) 5275 RETURN 5280 W1=(B*J2)^(1/3) 5285 W2=(A*(1-J2))^(1/3) 5290 GOSUB 5325 5295 I1=P 5300 W1=(B*J1)^(1/3) 5305 W2=(A*(1-J1))^(1/3) 5310 GOSUB 5325 5315 P=I1-P 5320 RETURN 5325 Y3=3*(W1*(1-1/9/B)-W2*(1-1/9/A))/SQR(W1*W1/B+W2*W2/A) 5330 GOSUB 8000 5335 RETURN 5340 REM 2/16/76 CHANGED TO ALL LOG 5345 D2=F0+(A-1)*LOG(J2)+(B-1)*LOG(1-J2) 5350 IF D2<-80 THEN 5370 5355 IF D2>85 THEN 5380 5360 D2=EXP(D2) 5365 RETURN 5370 D2=1.E-37 5375 RETURN 5380 D2=1.E+37 5385 RETURN 5390 REM 5395 REM END OF BETA CDF ROUTINE 5400 REM ******************************************************* 5850 REM **************************************************** 5852 REM LOG GAMMA ROUTINE 5853 REM INPUT G9 5854 REM OUTPUT G0 5860 G5=G9 5863 IF G9 <= 1.E+30 THEN 5872 5866 G0=1.E+38 5869 RETURN 5872 IF G9>1.E-09 THEN 5881 5875 G0=0 5878 RETURN 5881 IF G9<1.E+10 THEN 5890 5884 G0=G9*(LOG(G9)-1) 5887 RETURN 5890 G6=1 5893 IF 18.001 THEN 7042 7040 GOTO 7108 7042 IF P0>J5 THEN 7052 7044 J7=J8 7046 J8=J8*2 7048 P9=P0 7050 GOTO 7028 7052 J9=J7 7054 J0=J8 7056 J8=(J5-P9)/(P0-P9) 7058 IF J8>.15 THEN 7064 7060 J8=.15 7062 GOTO 7068 7064 IF J8<.85 THEN 7068 7066 J8=.85 7068 J8=J8*(J0-J9)+J9 7070 GOSUB 7096 7072 IF J8<-99 THEN 7080 7074 GOSUB 5000 7076 J3=P 7077 IF ABS(J1-J2)<.0001 THEN 7108 7078 IF ABS(J3-J5)>.001 THEN 7082 7080 GOTO 7108 7082 IF J3>J5 THEN 7090 7084 J9=J8 7086 P9=J3 7088 GOTO 7056 7090 J0=J8 7092 P0=J3 7094 GOTO 7056 7096 J1=(J8^J-1)/(J8^(J+1)-1) 7098 J2=J8*J1 7100 IF J2<1 THEN 7106 7102 J8=J8*.95 7104 GOTO 7100 7106 RETURN 7108 IF U0=0 THEN 7122 7110 J7=A 7112 A=B 7114 B=J7 7116 J7=J2 7118 J2=1-J1 7120 J1=1-J7 7122 RETURN 7124 REM END OF BETA HDR ROUTINE 7126 REM************************************************* 8000 REM ********************************************************** 8001 REM ROUTINE CALCULATES THE CDF FOR NORMAL DISTRIBUTION 8002 REM INPUT Y3 8003 REM OUTPUT P 8004 REM 8005 Y4=ABS(Y3) 8010 X1=X 8015 X=Y3 8020 T=1/(1+.231642*Y4) 8021 IF X*X/2<80 THEN 8025 8022 D=0 8023 GOTO 8030 8025 D=.398942*EXP(-X*X/2) 8030 C1=1.33027 8035 C2=1.82126 8040 C3=1.78148 8045 C4=.356564 8050 C5=.319382 8055 P=1-D*T*((((C1*T-C2)*T+C3)*T-C4)*T+C5) 8060 IF X >= 0 THEN 8070 8065 P=1-P 8070 X=X1 8075 RETURN 8076 REM 8077 REM END OF NORMAL CDF ROUTINE 8078 REM ********************************************************** 9000 REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 9005 INPUT O1 9015 IF O1=-9999 THEN 9025 9020 RETURN 9025 CLOSE 1: CHAIN "RSTRT" 9035 REM*************END ROUTINE 9999 END