home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / BINOMIAL.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  4.8 KB  |  84 lines
  1. 1   '               BINOMIAL DISTRIBUTION (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. 5  DEF SEG=64:A=PEEK(23):IF NOT(A AND 32) THEN POKE 23,(A OR 32)
  6. 6  DEF SEG:CLEAR,,1024:OPTION BASE 1:DEFINT A-C,N,T,Z:DEFSTR D
  7. 7  OPEN "EPISETUP.DAT" FOR INPUT AS #1
  8. 8  INPUT #1,CLR1,CLR2,CLR3,SCRN,PRNT,TYP$,PMAK:CLOSE #1
  9. 9  SCREEN 0,SCRN,0:WIDTH 80:COLOR CLR1,CLR2,CLR3:KEY OFF:IT$=SPACE$(30)
  10. 10  FOR Z=1 TO 10:KEY Z,"":NEXT:AR=13-SCRN*6:LOCATE ,,1,1,13:LOCATE ,,1,AR,AR
  11. 20  CLS:RESTORE 22:READ DTTL,TTB,TTL:PRINT TAB(TTB);"KEY";STRING$(TTL,205);"CLOSE":PRINT TAB(TTB);"OPEN ";DTTL;" OPEN":PRINT TAB(TTB);"SCREEN";STRING$(TTL,205);"LOAD":PRINT
  12. 22  DATA "BINOMIAL PROBABILITY DISTRIBUTION",22,35
  13. 30  PRINT TAB(8);"The binomial distribution provides a one-tailed exact test":PRINT "applicable when a dichotomous variable has an equal probability of occurring":PRINT TAB(27);"in each of N trials."
  14. 35  LOCATE 9,27:PRINT "Enter the number of trials:"
  15. 40  AR=9:AC=56:GOSUB 4800:XN=VAL(IP$):IF INT(XN)=XN THEN NT=XN ELSE GOSUB 165:GOTO 40
  16. 45  LOCATE 11,11:PRINT "Enter probability of success on each trial:"
  17. 50  AR=11:GOSUB 4800:PS=VAL(IP$):IF ABS(PS-0.5)>0.5 THEN LOCATE 25,18:PRINT "Probability should be fraction between 0 and 1";:GOSUB 170:GOTO 50
  18. 55  LOCATE 13,15:PRINT "Enter the number of successes observed:"
  19. 60  AR=13:GOSUB 4800:XN=VAL(IP$):IF INT(XN)=XN THEN NO=XN ELSE AR=13:GOSUB 165:GOTO 60
  20. 65  COLOR 23:LOCATE 17,29:PRINT "CALCULATING PROBABILITY"
  21. 70  IF NO>INT(PS*NT) THEN AF=1:PS=1-PS:CO=NT-NO ELSE AF=0:CO=NO
  22. 75  QS=1-PS:F=1:LQ=LOG(QS):LP=LOG(PS):P=EXP(NT*LQ)
  23. 80  FOR T=1 TO CO:FZ=NT-T:S=T*LP+FZ*LQ
  24. 85  IF F>1E+35 OR S<-80 THEN F=LOG(F):GOTO 95
  25. 90  F=F*(FZ+1)/T:P=P+F*EXP(S):NEXT T:GOTO 110
  26. 95  FOR Z=T TO CO:FZ=(NT-Z):S=Z*LP+FZ*LQ:F=F+LOG((FZ+1)/Z)
  27. 100  IF F+S>-86 THEN P=P+EXP(F+S)
  28. 105  NEXT Z
  29. 110  PLAY "MS O3 L64 G O2 GE L9 E"
  30. 115  LOCATE 17,1:COLOR CLR2,CLR1:PRINT TAB(8);"The probability of observing ";NO;" or ";:IF AF=1 THEN PRINT "more"; ELSE PRINT "fewer";
  31. 120  PRINT " cases ";:GOSUB 155:PRINT TAB(80):COLOR CLR1,CLR2
  32. 125  IF PS=0.5 THEN P=P*2:PRINT TAB(20);"Two-tailed probability ";:GOSUB 155
  33. 130  IF NT*PS<10 OR NT*QS<10 OR P>0.05 THEN 145 ELSE P$=".#####"
  34. 135  PRINT:PRINT:PRINT TAB(15);"The observed proportion of successes is  ";:PRINT USING P$;NO/NT
  35. 140  PRINT TAB(8);"Confidence limits can be calculated as:  ";:PRINT USING P$;NO/NT;:PRINT " +/- Z * ";:PRINT USING P$;SQR(PS*QS/NT)
  36. 145  LOCATE 25,12:INPUT;"Do you want to perform another binomial calculation?    ",A$:IF A$="y" OR A$="Y" THEN 20
  37. 150  GOTO 3000
  38. 155  IF P<9.99E-07 THEN PRINT "< 10 (-6)"; ELSE IF P>0.95 THEN PRINT "> .95"; ELSE PRINT "= ";P;
  39. 160  RETURN
  40. 165  LOCATE 25,24:PRINT "Please enter integers only.";
  41. 170  BEEP:LOCATE AR,AC:PRINT "     ":RETURN
  42. 3000  CLS:LOCATE 7,1:PRINT "SELECT an EPISTAT program number below:":PRINT
  43. 3005  RESTORE 3035:ON ERROR GOTO 5000
  44. 3010  FOR Z=1 TO 10:LOCATE Z+10,10:READ D:PRINT Z;D:NEXT
  45. 3015  FOR Z=11 TO 20:LOCATE Z,30:READ D:PRINT Z;D:NEXT
  46. 3020  FOR Z=21 TO 25:LOCATE Z-10,50:READ D:PRINT Z;D:NEXT
  47. 3025  LOCATE 25,16:PRINT "Enter choice (Press RETURN to exit):";:AR=25:AC=54:GOSUB 4800:AD=VAL(IP$)
  48. 3030  IF AD>0 AND AD<26 THEN RESTORE 3030:FOR Z=1 TO AD:READ D:NEXT:RUN D
  49. 3035  DATA "EPISTAT","DATA-ONE","ANOVA","BAYES","BINOMIAL","CHISQR","CORRELAT","FILETRAN","FISHERS","FORTRANS","HISTOGRM","LNREGRES","MHCHISQR","MHCHIMLT"
  50. 3040  DATA "MCNEMAR","NORMAL","POISSON","RANDOMIZ","RANKTEST","RATEADJ","SAMPLSIZ","SCATRGRM","SELECT","T-TEST","XTAB"
  51. 3045  LOCATE 23,1:SYSTEM
  52. 4000  PRINT TAB(10);:INPUT "Enter the name of the DATAFILE you wish to analyze:  ",FILE$
  53. 4020  ON ERROR GOTO 5020:OPEN FILE$ FOR INPUT AS #1:INPUT #1,A,C
  54. 4040  FOR T=1 TO A:INPUT #1,T(T):NEXT
  55. 4050  FOR T=1 TO A:FOR Z=1 TO C:INPUT #1,D(T,Z):NEXT:NEXT
  56. 4060  FOR T=1 TO A:FOR Z=1 TO T(T):INPUT #1,CS(T,Z):NEXT:NEXT
  57. 4070  FOR T=1 TO A:INPUT #1,N$(T),X(T),X2(T),MD(T),SD(T):NEXT:CLOSE #1:RETURN
  58. 4100  LOCATE AR,53:PRINT TAB(63):LOCATE AR,15:INPUT "Enter the name of your new DATAFILE:  ",FILE$
  59. 4110  ON ERROR GOTO 5040:OPEN FILE$ FOR OUTPUT AS #1
  60. 4120  WRITE #1,A,C:FOR T=1 TO A:WRITE #1,T(T):NEXT
  61. 4130  FOR T=1 TO A:FOR Z=1 TO C:WRITE #1,D(T,Z):NEXT:NEXT
  62. 4140  FOR T=1 TO A:FOR Z=1 TO T(T):WRITE #1,CS(T,Z):NEXT:NEXT
  63. 4150  FOR T=1 TO A:WRITE #1,N$(T),X(T),X2(T),MD(T),SD(T):NEXT:CLOSE #1:RETURN
  64. 4200  GOSUB 4800:NS=VAL(IP$):IF NS>0 AND NS<=A THEN PRINT " `";N$(NS);"'":RETURN ELSE BEEP:LOCATE 25,22:PRINT FILE$;" has only";A;"samples.";:GOTO 4200
  65. 4800  LOCATE AR,AC:PRINT SPACE$(8);:LOCATE AR,AC,1,5,7:CL=0
  66. 4805  I$=INKEY$:IF I$="" THEN 4805
  67. 4810  IF I$>CHR$(31) AND CL<8 THEN CL=CL+1:MID$(IT$,CL,1)=I$:PRINT I$;:GOTO 4805
  68. 4815  IF I$=CHR$(13) THEN IP$=MID$(IT$,1,CL):RETURN
  69. 4820  IF I$=CHR$(8) THEN IF CL>0 THEN CL=CL-1:PRINT CHR$(29);" ";CHR$(29);:GOTO 4805
  70. 4825  BEEP:GOTO 4805
  71. 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:"
  72. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  73. 5010  ON ERROR GOTO 0:END
  74. 5020  BEEP:PRINT:DR$="":IF ERR=71 THEN 5035 ELSE IF ERR<>52 AND ERR<>53 THEN 5010 ELSE PRINT TAB(13); "I cannot find a file by that name on ";
  75. 5025  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE PRINT "default ";
  76. 5030  PRINT "drive ";DR$:PRINT "Your files are:":FILES DR$+"*.*":RESUME 4000
  77. 5035  PRINT TAB(16);"That disk is not ready.  Check drive and try again.";:RESUME 4000
  78. 5040  BEEP:LOCATE 25,10:IF ERR=61 OR ERR=67 THEN PRINT TAB(17);"That disk is full.  Change disks and try again.";:RESUME 4100
  79. 5045  IF ERR=64 OR ERR=52 THEN PRINT TAB(16);"That is not a valid FILE NAME.  Please change name.";:RESUME 4100
  80. 5050  IF ERR=70 THEN PRINT "That disk is write-protected.  Put your data on a different disk.";:RESUME 4100
  81. 5055  IF ERR=71 THEN PRINT TAB(16);"That disk is not ready.  Check drive and try again.";:RESUME 4100 ELSE 5010
  82. 5070  BEEP:AR=CSRLIN:IF ERR<>27 AND ERR<>25 THEN 5010 ELSE LOCATE 24,15:PRINT "The printer is not ready.  Check before proceeding.";:LOCATE 25,25:PRINT "Press any key to continue:";
  83. 5075  A$=INKEY$:IF A$="" THEN 5075 ELSE FOR ZZ=24 TO 25:LOCATE ZZ,10:PRINT TAB(80):NEXT:LOCATE AR,1:RESUME
  84.