100' NAME--BACT2L 110' 120' DESCRIPTION--A BAYESIAN ANALYSIS OF A 2 LEVEL CONTINGENCY TABLE 130' 140' SOURCE--DEAN MYRON TRIBUS,THAYER SCHOOL OF ENGINEERING, 150' DARTMOUTH COLLEGE, HANOVER,N.H. 03755 160' 170' INSTRUCTIONS--THE DATA OF THE TABLE ARE PRESUMED TO BE ARRANGED 180' IN THE FOLLOWING FORM: 190' 200' ::::: A1 : A2 : : AR 210' ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 220' :B1:: N(1) : N(2) : ETC : N(R) ::B(1) 230' :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 240' :B2:: N(R+1) : N(R+2) : ETC : N(2*R) ::B(2) 250' ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 260' . . . . . . . . . . . . . . . . . . . . . 270' 280' :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 290' :BS::N((S-1)*R+1):N((S-1)*R+2): ETC : N(R*S) ::B(S) 300' :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 310' A(1) A(2) A(R) N 320' 330' THE TABLE IS OF DIMENSION R*S. R,S,P1,C1 AND C2 ARE INSERTED IN 340' LINE 1830 AS DATA STATEMENTS 350' 360' R = THE NUMBER OF ATTRIBUTES FOR CHARACTERISTIC A. 370' S = THE NUMBER OF ATTRIBUTES FOR CHARACTERISTIC B. 380' P1= THE PRIOR PROBABILITY THAT A AND B ARE DEPENDENT. 390' PUT P1=0.5 IF NO DATA IS AVAILABLE(THIS WILL GIVE ABOUT THE 400' SAME RESULTS AS A CHI-SQUARE TEST). 410' IF CHARACTERISTIC A WAS CONTROLLED DURING THE TEST OR IF THE 420' PROBABILITY OF OCCURRENCE OF A WAS KNOWN WITHOUT THE DATA IN THE 430' TABLE, PUT C1=1. OTHERWISE PUT C1=0. 440' IF CHARACTERISTIC B WAS CONTROLLED DURING THE TEST OR IF THE 450' PROBABILITY OF OCCURRENCE OF B WAS KNOWN WITHOUT THE 460' DATA IN THE TABLE,PUT C2=1. OTHERWISE PUT C2=0. 470' 480' :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 490' NOTE::::::::::: DO NOT PUT BOTH C1 AND C2=1 ::::::::::::::::::::::::: 500' :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 510' 520' ENTER DATA IN LINE 1840 AS N(Y) FOR Y=R*S. 530' 540' 550' * * * * * * MAIN PROGRAM * * * * * * * 560' 570 READ R,S,P1,C1,C2 580 DIM N(100),A(10),B(10),F(3),G(3),H(3) 590 FOR Y=1 TO R*S 600 READ N(Y) 610 LET N=N+N(Y) 620 NEXT Y 630 REM************THIS LOOP FINDS A(I)************* 640 FOR I=1 TO R 650 LET A(I)=0 660 FOR Y=I TO (S-1)*R+I STEP R 670 LET A(I)=A(I)+N(Y) 680 NEXT Y 690 NEXT I 700 REM*********************************************** 710 REM*************THIS LOOP FINDS B(J)*************** 720 FOR J=1 TO S 730 LET B(J)=0 740 FOR Y=1+(J-1)*R TO J*R 750 LET B(J)=B(J)+N(Y) 760 NEXT Y 770 NEXT J 780 REM ************************************************* 790 REM***********THIS LOOP FINDS F(1)****************** 800 LET F(1)=0 810 FOR I=1 TO R 820 LET Z=A(I) 830 GO SUB 1700 840 REM ************************************************************** 850 REM **** SUB 1250 FINDS LOG OF Z FACTORIAL AND CALLS IT F ******* 860 REM ************************************************************** 870 LET F(1)=F(1)+F 880 NEXT I 890 REM******************************************************** 900 REM ********THIS LOOP FINDS F(2)**************************** 910 LET F(2)=0 920 FOR J=1 TO S 930 LET Z=B(J) 940 GO SUB 1700 950 LET F(2)=F(2)+F 960 NEXT J 970 REM************************************************************ 980 LET Z=N 990 GO SUB 1700 1000 LET F(0)=F 1010 REM**************THIS LOOP FINDS F(3)*********************** 1020LET F(3)=0 1030 FOR I=1 TO R 1040 FOR J=1 TO S 1050 LET Y=(J-1)*R+I 1060 LET Z=N(Y) 1070 GO SUB 1700 1080 LET F(3)=F(3)+F 1090 NEXT J 1100 NEXT I 1110 REM********************************************************** 1120 REM******NEXT LOOPS WILL BE SKIPPED IF C1+C2=0************** 1130 FOR I=1 TO R*C1 1140 LET Z=S-1 1150 GO SUB 1700 1160 LET H(1)=H(1)+F 1170 LET Z=A(I)+S-1 1180 GO SUB 1700 1190 LET H(1)=H(1)-F 1200 NEXT I 1210 FOR J=1 TO S*C2 1220 LET Z=R-1 1230 GO SUB 1700 1240 LET H(2)=H(2)+F 1250 LET Z=B(J)+R-1 1260 GO SUB 1700 1270 GO SUB 1700 1280 LET H(2)=H(2)-F 1290 NEXT J 1300 REM**************************************************************** 1310 REM*******FOLLOWING SECTION FINDS G(1),G(2),G(3)******************* 1320 LET Z=R-1 1330 GO SUB 1700 1340 LET G(1)=F 1350 LET Z=N+R-1 1360 GO SUB 1700 1370 LET G(1)=G(1)-F 1380 LET Z=S-1 1390 GO SUB 1700 1400 LET G(2)=F 1410 LET Z=N+S-1 1420 GO SUB 1700 1430 LET G(2)=G(2)-F 1440 LET Z=R*S-1 1450 GO SUB 1700 1460 LET G(3)=F 1470 LET Z=N+R*S-1 1480 GO SUB 1700 1490 LET G(3)=G(3)-F 1500REM************************************************************* 1510 LET E1=LOG(P1/(1-P1))+F(3)+G(3)-F(1)-G(1)-F(2)-G(2) 1520 LET E1=E1-(C1+C2)*G(3)+C1*(F(1)+G(1)+H(1))+C2*(F(2)+H(2)+G(2)) 1530 LET P=1/(1+EXP(-E1)) 1540 PRINT "P(DEPENDENCE)="P 1550 PRINT 1560 PRINT "N="N;"N(Y)="; 1570 FOR Y=1 TO R*S 1580 PRINT N(Y); 1590 NEXT Y 1600 PRINT 1610 IF C1=0 THEN 1640 1620 PRINT "P(A/X) KNOWN" 1630 GO TO 1690 1640 IF C2=0 THEN 1670 1650 PRINT "P(B/X) KNOWN" 1660 GO TO 1690 1670 PRINT "NO CONTROLS" 1680 GO TO 1690 1690 GO TO 1850 1700 REM ************************************************************** 1710 REM ** THIS SUBROUTINE COMPUTES LOG OF Z FACTORIAL, CALLS IT F ** 1720 REM **************************************************************** 1730 LET F=0 1740 IF Z=0 THEN 1820 1750 IF Z>50 THEN 1800 1760 FOR F9=1 TO Z 1770 LET F=F+LOG(F9) 1780 NEXT F9 1790 GO TO 1820 1800 LET F=(Z+(1/2))*LOG(Z)-Z+LOG(SQR(6.283185)) 1810 REM ********END OF SUBROUTINE *********************************** 1820 RETURN 1830 1840 1850 END