home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / FISHERS.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  1.6 KB  |  37 lines
  1. 1  '                FISHER'S EXACT TEST (one-tailed)
  2. 2  '               Copyright Tracy L. Gustafson, M.D.
  3. 3  '              Round Rock, Texas. Version 3.2, 1985
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 22  DATA "FISHER'S EXACT TEST",30,21
  6. 30  P=0:PRINT:PRINT " Enter data in 2 by 2 table:"
  7. 35  LOCATE 9,25:PRINT "VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  8. 40  FOR Z=1 TO 3:PRINT TAB(25);"CALL";TAB(41);"CALL";TAB(57);"CALL":NEXT
  9. 45  PRINT TAB(25);"BLOADSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>"
  10. 50  FOR Z=1 TO 3:PRINT TAB(25);"CALL";TAB(41);"CALL";TAB(57);"CALL":NEXT
  11. 55  PRINT TAB(25);"CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'"
  12. 60  LOCATE 11,28:PRINT "A=":AR=11:AC=32:GOSUB 160:BA=I
  13. 65  LOCATE 11,45:PRINT "B=":AC=49:GOSUB 160:BB=I:PRINT
  14. 70  LOCATE 15,28:PRINT "C=":AR=15:AC=32:GOSUB 160:BC=I
  15. 75  LOCATE 15,45:PRINT "D=":AC=49:GOSUB 160:BD=I
  16. 80  LOCATE 19,31:COLOR 23:PRINT "CALCULATING PROBABILITY";
  17. 85  M=BA:IF BB<M THEN M=BB:SWAP BA,BB:SWAP BC,BD
  18. 90  IF BD<M THEN M=BD:SWAP BA,BD:SWAP BB,BC:GOTO 85
  19. 95  IF BC<M THEN M=BC:SWAP BA,BC:SWAP BB,BD
  20. 100  IF BA/BB>BC/BD THEN IF BC>BB THEN SWAP BA,BB:SWAP BC,BD ELSE SWAP BA,BC:SWAP BB,BD
  21. 105  PT=0:N=1
  22. 110  FOR Z=(BB+1) TO (BA+BB):PT=PT*Z/N:N=N+1:NEXT:N=BB+BD+1
  23. 115  FOR Z=(BC+1) TO (BA+BC):PT=PT*Z/N:N=N+1:NEXT:PT=PT*1E+30
  24. 120  FOR Z=(BD+1) TO (BC+BD):PT=PT*Z/N:N=N+1:NEXT:P=P+PT
  25. 125  IF BA>0 AND PT>0 THEN BA=BA-1:BB=BB+1:BC=BC+1:BD=BD-1:GOTO 105
  26. 130  PLAY "MS O3 L64 G O2 GE L9 E"
  27. 135  COLOR CLR2,CLR1:LOCATE 19,15:PRINT TAB(33);"p = ";:IF P<9E-09 THEN PRINT "< 10 (-8)"; ELSE PRINT P;
  28. 140  PRINT TAB(66):COLOR CLR1,CLR2:LOCATE 25,10
  29. 145  INPUT;"Do you want to perform another Fisher's exact test? (Y or N)   ",A$
  30. 150  IF A$="y" OR A$="Y" THEN CLS:GOTO 20
  31. 155  GOTO 3000
  32. 160  GOSUB 4800:I=VAL(IP$):IF INT(I)<>I THEN BEEP:LOCATE 25,25:PRINT "Please enter INTEGERS only.";:GOTO 160
  33. 165  RETURN
  34. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 2,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  35. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  36. 5010  ON ERROR GOTO 0:END
  37.