Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50110/bact2l.sta
There are 2 other files named bact2l.sta in the archive. Click here to see a list.
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