10X$=SYS(CHR$(7)):R$=LEFT(X$,7):L$=RIGHT(X$,8) 12 REM ******************************************************* 13 REM CMODA CMODA CMODA CMODA CMODA CMODA 15 REM ******************************************************* 20 REM 30 REM MARGINAL PROPORTIONS EQUAL N FOR GROUPS 40 REM 50 REM****************************************************** 60 DIM #1,A1(111),A2(111),A3(111) 70 OPEN R$ AS FILE 1 110A1(0)=10 120N0=A2(0) 130 DIM F(51),G(51),H(51),S(51),A(3) 140 PRINT L$ 150 PRINT " M-GROUP PROPORTIONS POSTERIOR DISTRIBUTIONS" 160 PRINT 170 PRINT "THIS MODULE COMPUTES THE MARGINAL POSTERIOR DISTRIBUTIONS" 180 PRINT "ON THE PROPORTIONS IN M DIFFERENT GROUPS. THERE CAN BE AS" 190 PRINT "MANY AS 50 GROUPS IN YOUR ANALYSIS." 200 PRINT 210 PRINT "ENTER THE NUMBER OF GROUPS IN YOUR ANALYSIS."; 220 GOSUB 9000 230 M0=INT(O1) 240 IF M0<2THEN 280 250 IF M0>50 THEN 280 260 PRINT 270 GOTO 310 280 PRINT"REENTER. MINIMUM IS 2. MAXIMUM IS 50." 300 GOTO 210 310 PRINT "ENTER THE NUMBER OF OBSERVATIONS PER GROUP (50 OR LESS)"; 320 GOSUB 9000 330 N3=INT(O1) 340 IF N3<2 THEN 370 350 IF N3>50 THEN 370 360 GOTO 390 370PRINT"REENTER. MINIMUM IS 2. MAXIMUM IS 50." 380 GOTO 320 390 IF N0 <> 0 THEN 490 400 PRINT 410 PRINT "INPUT THE HYPOTHETICAL SAMPLE SIZE FROM YOUR PRIOR" 420 PRINT "DISTRIBUTION."; 430 GOSUB 9000 440 N0=O1 450 IF N0 >= 3 THEN 490 460 PRINT "REENTER. M MUST BE AT LEAST 3." 470 PRINT 480 GOTO 410 490 IF N0 >= 6 THEN 510 500 N0=6 510 G8=1/(4*(N0+1)) 520 PRINT L$ 530 N0=6 540 G1=G8*(N0-2) 550 I5=1 560 N1=N3+1 570 PRINT "NOW ENTER YOUR SAMPLE DATA AS A FREQUENCY DISTRIBUTION OF THE" 580 PRINT "NUMBER OF GROUPS HAVING X SUCCESSES FOR EACH VALUE OF X FROM" 590 PRINT "0 TO N (NUMBER OF OBSERVATIONS IN EACH GROUP)." 592 PRINT "----------------------------------------------------------------" 600 PRINT "NUMBER OF SUCCESSES FREQUENCY (NUMBER OF GROUPS)" 610 S=0 620 FOR O=0 TO N3 640A$=" ## " 641PRINT USING A$,O; 650 GOSUB 9000 660 IF ABS(O1-INT(O1))>.000001 THEN 770 670 IF O1<0 THEN 790 680 F(O+1)=O1 690 S=S+F(O+1) 700 NEXT O 710 IF S=M0 THEN 810 730A$="REENTER. YOU ENTERED DATA FOR ### GROUPS. HOWEVER YOU" 731 PRINT USING A$,S 750A$="SAID THERE WERE ### GROUPS IN YOUR ANALYSIS." 751 PRINT USING A$,M0 753 PRINT 755 PRINT "WHEN YOU ARE READY TO REENTER THE DATA TYPE '1'."; 758 GOSUB 9000 760 PRINTL$ 762 GOTO 570 770 PRINT "REENTER. NUMBER OF GROUPS MUST BE A WHOLE NUMBER." 780 GOTO 640 790 PRINT "REENTER. NUMBER OF GROUPS MUST BE 0 OR GREATER." 800 GOTO 630 810 M1=M0-1 820 P4=1/(4*N3+2) 830 P3=P4/M0 840 C3=-G1/2 850 E1=-(N0+2)/2 860 E2=-M1/2+1 870 FOR O=1 TO 3 880 A(O)=0 890 NEXT O 900 G0=0 910 G2=0 920 IF I5 <> 0 THEN 1140 930 FOR O=1 TO O1 940 V0=SQR(F(O)/N1) 950 GOSUB 3480 960 G(O)=V4 970 V0=SQR((F(O)+1)/N1) 980 GOSUB 3480 990 G(O)=(G(O)+V4)/2 1000 NEXT O 1010 G2=0 1020 FOR O=1 TO O1 1030 G2=G2+G(O) 1040 NEXT O 1050 G2=G2/M0 1060 FOR O=1 TO O1 1070 S(O)=(G(O)-G2)*(G(O)-G2) 1080 NEXT O 1090 G0=0 1100 FOR O=1 TO O1 1110 G0=G0+S(O) 1120 NEXT O 1130 GOTO 1280 1140 FOR O=1 TO N1 1150 I1=O-1 1160 IF F(O)<.9 THEN 1250 1170 V0=SQR(I1/N1) 1180 GOSUB 3480 1190 G(O)=V4 1200 V0=SQR(O/N1) 1210 GOSUB 3480 1220 G(O)=(G(O)+V4)/2 1230 G2=G2+G(O)*F(O) 1240 G0=G0+G(O)*G(O)*F(O) 1250 NEXT O 1260 G2=G2/M0 1270 G0=G0-M0*(G2*G2) 1280 C0=-G0/2 1290 REM 1300 G3=G0/M0 1310 GOSUB 4230 1320 A0=-1 1330 B0=(G1+(N0+M0-1)*P4)/G0 1340 C1=-G1/G0 1350 A9=1 1360 X0=.5 1370 X7=.9 1380 X0=X7/.7 1390 X7=X0 1400 IF A9=50 THEN 1540 1410 A9=1+A9 1420 D0=1 1430 FOR O=1 TO 50 1440 IF ABS(D0)<10^(-10) THEN 1580 1450 Y0=X0*X0*X0+A0*X0*X0+B0*X0+C1 1460 IF O=1 THEN 1490 1470 IF Y71 THEN 1380 1590 R0=X0 1600 FOR I0=1 TO 3 1610 E3=E2-I0 1620 E4=E1+I0-1 1630 J0=E4 1640 J1=C3 1650 J2=E3 1660 J3=C0 1670 J4=P4 1680 J5=5 1690 GOSUB 3590 1700 A(I0)=J8 1710 NEXT I0 1720 R1=A(2)/A(1) 1730 S2=A(3)/A(1)-R1*R1 1740 S1=SQR(S2) 1750 T0=(1+(M0-1)*R1)/((4*N3+2)*M0) 1760 R2=1-R1 1770 A9=0 1780 FOR O=1 TO N1 1790 IF F(O)<1 THEN 1840 1800 H(O)=R1*G(O)+R2*G2 1810 S(O)=T0+(G(O)-G2)*(G(O)-G2)*S2 1820 S(O)=SQR(S(O)) 1830 A9=0 1840 NEXT O 1850 GOSUB 1870 1860 GOTO 1940 1870 PRINT L$ 1880 PRINT " JOINT AND MARGINAL POINT ESTIMATES" 1890 PRINT 1910A$=" X FREQUENCY P PI(JOINT) PI(MARG.)" 1911PRINT A$ 1912A$="--------------------------------------------------------------" 1913PRINT A$ 1930 RETURN 1940 R3=1-R0 1950 C2=1/(2*N3) 1960 A9=0 1970 FOR O=1 TO N1 1980 IF F(O)<.9 THEN 2160 1990 IF I5=1 THEN 2020 2000 P5=F(O)/N3 2010 GOTO 2030 2020 P5=(O-1)/N3 2030 G5=G(O)*R0+G2*R3 2040 P0=(1+C2)*SIN(G5)*SIN(G5)-.5*C2 2050 P1=(1+C2)*SIN(H(O))*SIN(H(O))-.5*C2 2060 GOSUB 4150 2070 REM 2090 IF F(O)=0 THEN 2160 2100A$=" ### ### ##.## ##.## ##.## 2101 PRINT USING A$ ,O-1,F(O),P5,P0,P1 2110 IF A9<14 THEN 2160 2120 PRINT " WHEN YOU ARE READY TO CONTINUE TYPE '1'."; 2130 GOSUB 9000 2140 GOSUB 1870 2150 A9=0 2160 NEXT O 2170A$="----------------------------------------------------------------" 2171PRINT A$ 2180 PRINT " WHEN YOU ARE READY TO CONTINUE TYPE '1'."; 2190 GOSUB 9000 2200 PRINT L$ 2210 V(4)=.675 2220 V(5)=1.28 2230 V(1)=-1.28 2240 V(2)=-.675 2250 V(3)=0 2260 A9=0 2270 GOSUB 2290 2280 GOTO 2350 2290 PRINT L$ 2300 PRINT "HERE ARE SOME OF THE PERCENTILES OF THE POSTERIOR MARGINAL" 2310 PRINT "DISTRIBUTIONS. THE PERCENTILES PERTAIN TO ANY GROUP WITH X" 2315 PRINT "SUCCESSES." 2317 PRINT 2320 PRINT " X FREQUENCY 10TH 25TH 50TH 75TH 90TH" 2330 PRINT "-------------------------------------------------------------" 2340 RETURN 2350 FOR O=1 TO N1 2360 IF F(O)<1 THEN 2540 2380A$="## ## " 2381PRINT USING A$,O-1,F(O); 2390 FOR K5=1 TO 5 2400 P7=V(K5)*S(O)+H(O) 2410 P7=SIN(P7) 2430 IF P7<.99 THEN 2450 2440 P7=.99 2450A$=" .##" 2451PRINT USING A$,P7*P7; 2460 NEXT K5 2470 PRINT 2480 IF A9<14 THEN 2530 2490 PRINT "-------------------------------------------------------------" 2492 PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'."; 2500 GOSUB 9000 2510 A9=0 2520 GOSUB 2290 2530 A9=A9+1 2540 NEXT O 2545 PRINT "-------------------------------------------------------------" 2550 PRINT "IF YOU WANT THE PROBABILITIES THAT THE PROPORTIONS EXCEED" 2560 PRINT "CERTAIN VALUES WHICH YOU SPECIFY TYPE '1' ELSE '0'."; 2580 GOSUB 9000 2590 IF O1=0 THEN 3280 2600 IF O1 <> 1 THEN 3260 2610 PRINT L$ 2620 PRINT "YOU CAN SPECIFY FROM 1 THROUGH 5 VALUES. HOW MANY DO YOU" 2630 PRINT "WANT TO SPECIFY?"; 2640 GOSUB 9000 2650 IF O1=0 THEN 3280 2660 IF O1 <= 5 THEN 2710 2670 PRINT "REENTER. INPUT MUST BE 0 OR NUMBER FROM 1 THROUGH 5." 2680 GOTO 2640 2690 PRINT "REENTER. VALUE MUST BE BETWEEN 0 AND 1." 2700 GOTO 2760 2710 K6=O1 2720 PRINT 2730 FOR K5=1 TO K6 2750A$="VALUE ## " 2751PRINT USING A$,K5; 2760 GOSUB 9000 2770 IF O1 <= 0 THEN 2690 2780 IF O1 >= 1 THEN 2690 2790 V(K5)=O1 2800 NEXT K5 2810 A9=0 2820 GOSUB 2840 2830 GOTO 2940 2840 PRINT L$ 2850 PRINT "HERE IS THE PROBABILITY THAT THE POPULATION PROPORTION" 2852 PRINT "EXCEEDS P(0). THE PROBABILITY PERTAINS TO ANY GROUP" 2853 PRINT "WITH X SUCCESSES." 2854 PRINT "-------------------------------------------------------------" 2870A$=" X " 2871PRINT A$; 2880 FOR K5=1 TO K6 2900A$=" P(0)=#.##" 2901PRINT USING A$,V(K5); 2910 NEXT K5 2920 PRINT 2930 RETURN 2940 FOR K7=1 TO N1 2950 IF F(K7)<1 THEN 3180 2970A$="##" 2971PRINT USING A$,K7-1; 2980 FOR K5=1 TO K6 2990 V0=SQR(V(K5)) 3000 GOSUB 3480 3010 G6=V4 3020 Z0=(G6-H(K7))/S(K7) 3030 W0=Z0 3040 GOSUB 4040 3050 U0=1-W4 3070 IF U0<.99 THEN 3090 3080 U0=.99 3090A$=" #.##" 3091PRINT USING A$,U0; 3100 NEXT K5 3110 PRINT 3120 A9=A9+1 3130 IF A9<14 THEN 3180 3140 PRINT "-------------------------------------------------------------" 3142 PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'."; 3150 GOSUB 9000 3160 GOSUB 2840 3170 A9=0 3180 NEXT K7 3190 PRINT "-------------------------------------------------------------" 3200 PRINT "IF YOU WANT TO SPECIFY MORE VALUES TYPE '1' ELSE '0'."; 3230 GOSUB 9000 3240 IF O1=0 THEN 3280 3250 IF O1=1 THEN 2610 3260 PRINT "REENTER. INPUT MUST BE 0 OR 1." 3270 GOTO 3230 3280 PRINT "THIS COMPLETES THE POSTERIOR ANALYSIS." 3290 PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'."; 3300 GOSUB 9000 3310 CLOSE 1: CHAIN "RSTRT" 3320 GOSUB 9050 3330 M2=O1 3340 P2=O2 3350 Q6=0 3360 Q7=Q1*LOG(Q0)+Q2/Q0 3370 Q8=Q3*LOG(Q0+Q5)+Q4/(Q0+Q5) 3380 IF Q7<-85 THEN 3400 3390 GOTO 3410 3400 Q6=Q6+1 3410 IF Q8<-85 THEN 3430 3420 GOTO 3440 3430 Q6=Q6+1 3440 Q9=0 3450 IF Q6 <> 0 THEN 3470 3460 Q9=EXP(Q7)*EXP(Q8) 3470 RETURN 3480 V1=ATN(1)*4 3490 IF ABS(V0)<1.E-10 THEN 3520 3500 V2=ATN(SQR(1-V0*V0)/V0)+.5*V1*(1-SGN(V0)) 3510 GOTO 3530 3520 V2=V1/2-V0 3530 IF ABS(V0)K2 THEN 3780 3980 L1=(K9-J8)/K9 3990 J8=K9 4000 J6=J7 4010 J7=2*J7 4020 IF L1>K2 THEN 3620 4030 RETURN 4040 W1=ABS(W0) 4050 IF W1>=6THEN 4130 4060 W2=.398942*EXP(-W1*W1/2) 4070 W3=1/(1+.231642*W1) 4080 W4=((((1.33027*W3-1.82126)*W3+1.78148)*W3-.356564)*W3+.319381) 4090 W4=1-W4*W3*W2 4100 IF W0>0 THEN 4120 4110 W4=1-W4 4120 IF ABS(W1)<6 THEN 4140 4130 W4=.5+SGN(W1)*.5 4140 RETURN 4150 IF A9=17 THEN 4180 4160 A9=A9+1 4170 GOTO 4220 4180 PRINT "TYPE A 1 WHEN YOU WISH TO CONTINUE." 4190 INPUT A2 4200 A9=0 4210 PRINT L$ 4220 RETURN 4230 REM SOLVES CUBIC EQUATION FOR PHI-GAMMA 4240 A1=M0+N0+1 4250 A2=(M0+N0+N0+3)*P4-G0-G1 4260 A3=(N0+2)*P4*P4-2*G1*P4 4270 A4=-G1*P4*P4 4280 A5=(3*A3/A1-A2*A2/A1/A1)/3 4290 B5=(2*(A2/A1)^3-9*A2*A3/A1/A1+27*A4/A1)/27 4300 B1=.25*B5*B5+A5*A5*A5/27 4310 IF B1>0 THEN 4350 4320 PRINT "THE EQUATION FOR PHI-GAMMA HAS 3 REAL ROOTS" 4330 PRINT B1 4340 RETURN 4350 B2=-.5*B5+SQR(B1) 4360 B3=-.5*B5-SQR(B1) 4370 B4=SGN(B2)*ABS(B2)^(1/3)+SGN(B3)*ABS(B3)^(1/3) 4380 PRINT "THE COMPUTER WILL NOW CALCULATE THE POSTERIOR MARGINAL" 4390 PRINT "DISTRIBUTION OF EACH POPULATION PROPORTION. THIS MAY" 4400 PRINT "TAKE BETWEEN 30 SECONDS AND SEVERAL MINUTES DEPENDING" 4410 PRINT "ON THE NUMBER OF GROUPS." 4420 RETURN 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 9050 REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN 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" 9090 REM*************END ROUTINE 9999 END