1 '                FISHER'S EXACT TEST (one-tailed)
2 '               Written by Tracy L. Gustafson, M.D.
3 '              Round Rock, Texas. Version 3.0, 1984
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "FISHER'S EXACT TEST",27,21
30 P=0:PRINT:PRINT " Enter data in 2 by 2 table:"
35 LOCATE 9,22:PRINT "????????????????????????????????"
40 FOR Z=1 TO 3:PRINT TAB(22);"?";TAB(38);"?";TAB(54);"?":NEXT
45 PRINT TAB(22);"????????????????????????????????"
50 FOR Z=1 TO 3:PRINT TAB(22);"?";TAB(38);"?";TAB(54);"?":NEXT
55 PRINT TAB(22);"?????????????????????????????????"
60 LOCATE 11,25:PRINT "A=  ":AR=11:AC=29:GOSUB 160:BA=I
65 LOCATE 11,42:PRINT "B=  ":AC=46:GOSUB 160:BB=I:PRINT
70 LOCATE 15,25:PRINT "C=  ":AR=15:AC=29:GOSUB 160:BC=I
75 LOCATE 15,42:PRINT "D=  ":AC=46:GOSUB 160:BD=I
80 LOCATE 19,27:COLOR 23:PRINT "CALCULATING PROBABILITY";
85 M=BA:IF BBBC/BD THEN IF BC>BB THEN SWAP BA,BB:SWAP BC,BD ELSE SWAP BA,BC:SWAP BB,BD
105 PT=9.999999E-31:N=1
110 FOR Z=(BB+1) TO (BA+BB):PT=PT*Z/N:N=N+1:NEXT:N=BB+BD+1
115 FOR Z=(BC+1) TO (BA+BC):PT=PT*Z/N:N=N+1:NEXT:PT=PT*1E+30
120 FOR Z=(BD+1) TO (BC+BD):PT=PT*Z/N:N=N+1:NEXT:P=P+PT
125 IF BA>0 AND PT>0 THEN BA=BA-1:BB=BB+1:BC=BC+1:BD=BD-1:GOTO 105
130 PLAY "MB L32 N20N24N27 L16 N32 L3 N20"
135 COLOR CLR2,CLR1:LOCATE 19,15:PRINT TAB(30);"p = ";:IF P<1E-08 THEN PRINT "< 10 (-8)"; ELSE PRINT P;
140 PRINT TAB(63):COLOR CLR1,CLR2:LOCATE 25,8
145 INPUT;"Do you want to perform another Fisher's exact test? (Y or N)   ",A$
150 IF A$="y" OR A$="Y" THEN CLS:GOTO 20
155 LOCATE 23,1:END
160 LOCATE AR,AC:INPUT;"",I:IF INT(I)<>I THEN BEEP:LOCATE 25,25:PRINT "Please enter INTEGERS only.";:LOCATE AR,AC:PRINT "      ":GOTO 160
165 RETURN
5000 BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END