10 X$=SYS(CHR$(7)):R$=LEFT(X$,7):L$=RIGHT(X$,8)
12  REM ****************************************************************
13  REM  CMOD9    CMOD9     CMOD9     CMOD9      CMOD9      CMOD9
15  REM ****************************************************************
16  REM
17  REM     M-GROUP PROPORTIONS   POSTERIOR JOINT MODAL ESTIMATES
18  REM
19  REM *****************************************************************
20  DIM #1,A1(111),A2(111),A3(111)
30  OPEN R$ AS FILE 1
70A1(0)=9
80T=A2(1)
90  PRINT L$
100  DIM X(50),N(50),G(50),B(50),U(50),V(50),W(50),O(50),Q(50)
110  DIM E(50),F(50)
120  D=50
130  PRINT "          POSTERIOR JOINT MODAL ESTIMATES"
140  PRINT
150  PRINT "THIS MODULE COMPUTES THE POSTERIOR JOINT MODAL ESTIMATES OF"
160  PRINT "THE PROPORTIONS IN THE M GROUPS."
170  PRINT
180  PRINT "INPUT THE NUMBER OF GROUPS IN YOUR ANALYSIS (50 OR LESS).";
190  GOSUB 9000
192 M=INT(O1)
193 IF M<=D THEN 205
198 PRINT "REENTER.  MAXIMUM IS 50."
200 GOTO 190
205 IF M>=2THEN 220
210 PRINT "REENTER.  MINIMUM IS 2."
215 GOTO 190
220  M0=(M-1)/M
230  PRINT
240  PRINT "INPUT THE SAMPLE DATA BY GROUP.  INPUT THE NUMBER OF SUCCESSES"
250  PRINT "FOLLOWED BY A COMMA AND THEN THE NUMBER OF OBSERVATIONS ON THE"
260  PRINT "GROUP."
270  PRINT "--------------------------------------------------------------"
280  PRINT "             X ,N"
290  FOR I0=1 TO M
300REM
310A$="GROUP ##  "
311PRINTUSINGA$,I0;
320  GOSUB 9050
322 IF O1<>INT(O1)THEN 362
324 IF O2<>INT(O2)THEN 362
326 IF O1<0 THEN 382
328 IF O2<1THEN 386
330  X(I0)=O1
340  N(I0)=O2
350  IF X(I0)>N(I0) THEN 370
360  GOTO 390
362 PRINT "REENTER.  BOTH MUST BE INTEGER VALUES."
364 GOTO 311
370  PRINT "REENTER.  X CAN NOT BE GREATER THAN N."
380  GOTO 300
382 PRINT "REENTER.  NUMBER OF SUCCESSES MUST BE AT LEAST 0."
385GOTO 311
386 PRINT "REENTER.  NUMBER OF OBSERVATIONS MUST BE AT LEAST 1."
388 GOTO 311
390  NEXT I0
400  N0=8
410  GOTO 460
420  PRINT "INPUT NU WHERE NU IS THE NUMBER OF HYPOTHETICAL"
430  PRINT "OBSERVATIONS ON PHI GAMMA.  NORMALLY NU=8."
440  GOSUB 9000
450  N0=O1
460  IF T=0 THEN 480
470  GOTO 520
480  PRINT
490  PRINT "INPUT THE VALUE OF M DETERMINED IN THE FITTING OF A PRIOR.";
500  GOSUB 9000
510  T=O1
512 IF T>=3 THEN 520
514 PRINT"REENTER.  MUST BE AT LEAST 3."
516 GOTO 500
520  L0=(N0-2)/(4*(T+1))
530  G7=0
540  FOR I0=1 TO M
550  C5=SQR((X(I0)+.375)/(N(I0)+.75))
560  GOSUB 1640
570  G(I0)=C6
580  G7=G7+C6
590  NEXT I0
600  G7=G7/M
610  A3=0
620  S0=0
630  FOR I0=1 TO M
640  B(I0)=1/(4*N(I0)+2)
650  A3=A3+B(I0)
660  U(I0)=(G(I0)-G7)*(G(I0)-G7)
670  S0=S0+U(I0)
680  NEXT I0
690  P2=S0/(M-1)-A3/M
700  IF P2 <= 0 THEN 740
710  FOR I0=1 TO M
720  V(I0)=(P2*G(I0)+G7*B(I0))/(P2+B(I0))
730  NEXT I0
740  FOR I0=1 TO M
750  W(I0)=G(I0)
760  NEXT I0
770  G8=G7
780  D5=M+N0-1
790  Z=0
800  T9=(L0+S0)/D5
810  Z=Z+1
820  FOR I0=1 TO M
830  O(I0)=(G(I0)*T9+G8*B(I0))/(T9+B(I0))
840  NEXT I0
850  G8=0
860  FOR I0=1 TO M
870  G8=G8+O(I0)
880  NEXT I0
890  G8=G8/M
900  S0=0
910  FOR I0=1 TO M
920  U(I0)=(O(I0)-G8)*(O(I0)-G8)
930  S0=S0+U(I0)
940  NEXT I0
950  FOR I0=1 TO M
960  IF ABS(O(I0)-W(I0))>.000001 THEN 990
970  NEXT I0
980  GOTO 1040
990  IF Z>50 THEN 1450
1000  FOR I0=1 TO M
1010  W(I0)=O(I0)
1020  NEXT I0
1030  GOTO 800
1040  Z1=0
1050  FOR I0=1 TO M
1060  Z1=Z1+U(I0)
1070  NEXT I0
1080  Z2=L0+Z1
1090  Z3=Z2*Z2
1100  P0=(O(1)-G8)*B(1)/(G(1)-O(1))
1110  Z7=0
1120  Z6=0
1130  FOR I0=1 TO M
1140  Q(I0)=X(I0)/N(I0)
1150  E(I0)=SIN(O(I0))*SIN(O(I0))
1160  Z6=Z6+Q(I0)
1170  Z7=Z7+E(I0)
1180  NEXT I0
1190  Z6=Z6/M
1200  Z7=Z7/M
1210  A9=0
1220  GOSUB 1240
1230  GOTO 1280
1240  PRINT L$
1250  PRINT "           POSTERIOR JOINT MODAL ESTIMATE"
1260  PRINT
1270  PRINT "GROUP         X           N         X/N        ESTIMATE*"
1272  PRINT "--------------------------------------------------------"
1280  FOR I0=1 TO M
1300A$="#####    ########    #########     #.##          #.##"
1301  PRINT  USING  A$ ,I0,X(I0),N(I0),Q(I0),E(I0)
1320IFA9<9THEN1350
1322 PRINT
1323  PRINT "   TRANSFORMED PROPORTIONS (NOTE: THESE DO NOT CORRESPOND"
1324  PRINT "   TO THE JOINT MODE OF THE UNTRANSFORMED PROPORTIONS.)."
1325PRINT
1326  PRINT "WHEN YOU WANT TO CONTINUE TYPE '1'.";
1327  GOSUB 9000
1330  A9=0
1340  GOSUB 1240
1342GOTO 1360
1350  A9=A9+1
1360  NEXT I0
1380A$="*********************************************************"
1381PRINTA$
1390  PRINT "THIS COMPLETES THE ANALYSIS.  WHEN YOU ARE READY TO "
1400  PRINT "CONTINUE TYPE '1'."
1410  GOSUB 9000
1420  CLOSE 1: CHAIN "RSTRT"
1430  GOSUB 9000
1440  CLOSE 1: CHAIN "RSTRT"
1450  PRINT "DID NOT CONVERGE IN 50 ITERATIONS."
1460  CLOSE 1: CHAIN "CERROR"
1470  PRINT "INPUT NUMBER OF OBSERVATIONS PER GROUP."
1480  GOSUB 9000
1490  FOR I0=1 TO M
1500  N(I0)=O1
1510  NEXT I0
1520  PRINT "NOW INPUT NUMBER OF SUCCESSES X FOR EACH GROUP."
1530  FOR I0=1 TO M
1540  PRINT "X(";I0;")"
1550  GOSUB 9000
1560  X(I0)=O1
1570  IF X(I0)>N(I0) THEN 1590
1580  GOTO 1620
1590  PRINT "NUMBER OF SUCCESSES MUST BE LESS THAN OR EQUAL TO NUMBER OF"
1600  PRINT "OBSERVATIONS.  PLEASE RESPECIFY."
1610  GOTO 1540
1620  NEXT I0
1630  GOTO 400
1640  REM ROUTINE FOR ARCSIN, INPUT C5, OUTPUT C6
1650  IF ABS(C5) >= 1.E-10 THEN 1680
1660  C7=1.5708-C5
1670  GOTO 1690
1680  C7=ATN(SQR(1-C5*C5)/C5)+1.5708*(1-SGN(C5))
1690  C6=SGN(C5)*ABS(C5)
1700  IF ABS(C5)>ABS(1.5708-C7) THEN 1720
1710  C6=ABS(1.5708-C7)
1720  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
9059  REM--IF INPRT1 HAS BEEN USED ALSO 9060 MUST BE DELETED************
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