home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / SAMPLSIZ.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  6.2 KB  |  94 lines
  1. 1  '                   CALCULATING SAMPLE SIZES
  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 "CALCULATING SAMPLE SIZES",26,26
  13. 30  AF=0:PRINT:PRINT TAB(22);"1.)  For a population survey":PRINT
  14. 35  PRINT TAB(22);"2.)  For a paired case-control study":PRINT
  15. 40  PRINT TAB(22);"3.)  For an unpaired case-control study":PRINT:PRINT
  16. 45  LOCATE 12,28:PRINT "Enter choice:":AR=12:AC=42:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 45
  17. 50  D1="the true population rate ":D2="and your sample rate ":D3="  How certain must you be ":D4="POPULATION"
  18. 55  CLS:ON ASUB GOTO 65,110,115
  19. 60  PRINT "Enter your best estimate of the ";D4;" RATE of the study characteristic:":PRINT TAB(27);"(err towards 50%)";TAB(54);"Percent = ";:AR=CSRLIN:AC=65:GOSUB 4800:P=VAL(IP$):RETURN
  20. 65  PRINT TAB(24);"SAMPLE SIZE FOR ";D4;" SURVEY":PRINT TAB(24);STRING$(33,205):PRINT
  21. 70  LOCATE 4,5:PRINT "How LARGE is the population from which you want to select your sample?":PRINT TAB(26);"(you may approximate)":AR=5:AC=63:GOSUB 4800:PS=VAL(IP$):LOCATE 7,1:GOSUB 60
  22. 75  LOCATE 10,7:PRINT "What is the MAXIMUM difference between ";D1:PRINT TAB(7);D2;"that you can tolerate?";TAB(54);"Percent =":AR=11:GOSUB 4800:XD=VAL(IP$)
  23. 80  LOCATE 13,1:PRINT D3;"that the difference between ";D1:PRINT TAB(25);D2;"is <";XD;"% ?"
  24. 85  PRINT TAB(22);"1) 90%   2) 95%   3) 99%   4) 99.9%":AR=15:GOSUB 4800:C=VAL(IP$)
  25. 90  IF C=1 THEN XZA=1.645 ELSE IF C=2 THEN XZA=1.96 ELSE IF C=3 THEN XZA=2.575 ELSE IF C=4 THEN XZA=3.29 ELSE BEEP:GOTO 80
  26. 95  P=P/100:XD=XD/100:SN=XZA*XZA*P*(1-P)/(XD*XD):SN=SN/(1+SN/PS)
  27. 100  GOSUB 220:PRINT:PRINT:COLOR CLR2,CLR1:PRINT TAB(23);
  28. 105  PRINT "The SAMPLE SIZE required is ";INT(SN+0.5);:GOTO 205
  29. 110  AF=0:PRINT TAB(20);"SAMPLE SIZE FOR PAIRED CASE-CONTROL STUDY":PRINT TAB(20);STRING$(41,205):GOSUB 60:GOTO 120
  30. 115  AF=1:PRINT TAB(19);"SAMPLE SIZE FOR UNPAIRED CASE-CONTROL STUDY":PRINT TAB(19);STRING$(43,205):D4="CONTROL GROUP":GOSUB 60
  31. 120  LOCATE 6,10:PRINT "Do you expect the TEST GROUP rate to be HIGHER or LOWER":PRINT TAB(20);:INPUT "than the control group rate? (H or L)        ",A$
  32. 125  IF A$<>"h" AND A$<>"H" AND A$<>"l" AND A$<>"L" THEN BEEP:GOTO 120
  33. 130  LOCATE 9,4:PRINT "What is the SMALLEST DIFFERENCE between the test group and controls":PRINT TAB(12);"that you want to be able to detect?";TAB(54);"Percent =":AR=10:AC=65:GOSUB 4800:XD=VAL(IP$)
  34. 135  IF A$="h" OR A$="H" THEN PT=P+XD ELSE PT=P-XD
  35. 140  LOCATE 12,1:PRINT D3;"that you detect a difference as small as";XD;"% ?":PRINT TAB(30);"(if it exists) ?":PRINT TAB(17);
  36. 145  PRINT "1) 70%   2) 80%   3) 90%   4) 95%   5) 99%":AR=14:GOSUB 4800:C=VAL(IP$)
  37. 150  IF C=1 THEN XZB=0.525 ELSE IF C=2 THEN XZB=0.842 ELSE IF C=3 THEN XZB=1.282 ELSE IF C=4 THEN XZB=1.645 ELSE IF C=5 THEN XZB=2.327 ELSE BEEP:GOTO 140
  38. 155  LOCATE 16,3:PRINT D3;"that any difference between your samples":PRINT TAB(14);
  39. 160  PRINT "that you may detect is not simply due to chance?":PRINT TAB(20);
  40. 165  PRINT "1) 90%   2) 95%   3) 99%   4) 99.9%":AR=18:GOSUB 4800:C=VAL(IP$)
  41. 170  IF C=1 THEN XZA=1.645 ELSE IF C=2 THEN XZA=1.96 ELSE IF C=3 THEN XZA=2.575  ELSE IF C=4 THEN XZA=3.29 ELSE BEEP:GOTO 155
  42. 175  LOCATE 20,14:PRINT "Enter the number of CONTROLS per CASE desired:":AR=20:GOSUB 4800:CC=VAL(IP$):P=P/100:XD=XD/100:PT=PT/100
  43. 180  IF AF=0 THEN SN=(XZA*SQR(P*(1-P))+XZB*SQR(PT*(1-PT)))/XD:GOTO 190
  44. 185  PC=P:P=(P+PT)/2:SN=(XZA*SQR(2*P*(1-P))+XZB*SQR(PT*(1-PT)+PC*(1-PC)))/XD
  45. 190  SN=SN*SN*(CC+1)/(2*CC):PRINT
  46. 195  GOSUB 220:COLOR CLR2,CLR1:DQ="The number of ":LOCATE 22,1:PRINT TAB(19);:IF AF=0 AND CC=1 THEN PRINT DQ;"PAIRS required is: ";INT(SN+0.5);:GOTO 205
  47. 200  PRINT DQ;"CASES required is: ";INT(SN+0.5);TAB(80):PRINT TAB(18);DQ;"CONTROLS required is: ";INT(SN+0.5)*CC;
  48. 205  PRINT TAB(80):COLOR CLR1,CLR2:LOCATE 25,17
  49. 210  INPUT;"Do you want to calculate another SAMPLE SIZE?   ",A$:IF A$="y" OR A$="Y" THEN 20
  50. 215  GOTO 3000
  51. 220  PLAY "MS O3 L64 G O2 GE L9 E":RETURN
  52. 3000  CLS:LOCATE 7,1:PRINT "SELECT an EPISTAT program number below:":PRINT
  53. 3005  RESTORE 3035:ON ERROR GOTO 5000
  54. 3010  FOR Z=1 TO 10:LOCATE Z+10,10:READ D:PRINT Z;D:NEXT
  55. 3015  FOR Z=11 TO 20:LOCATE Z,30:READ D:PRINT Z;D:NEXT
  56. 3020  FOR Z=21 TO 25:LOCATE Z-10,50:READ D:PRINT Z;D:NEXT
  57. 3025  LOCATE 25,16:PRINT "Enter choice (Press RETURN to exit):";:AR=25:AC=54:GOSUB 4800:AD=VAL(IP$)
  58. 3030  IF AD>0 AND AD<26 THEN RESTORE 3030:FOR Z=1 TO AD:READ D:NEXT:RUN D
  59. 3035  DATA "EPISTAT","DATA-ONE","ANOVA","BAYES","BINOMIAL","CHISQR","CORRELAT","FILETRAN","FISHERS","FORTRANS","HISTOGRM","LNREGRES","MHCHISQR","MHCHIMLT"
  60. 3040  DATA "MCNEMAR","NORMAL","POISSON","RANDOMIZ","RANKTEST","RATEADJ","SAMPLSIZ","SCATRGRM","SELECT","T-TEST","XTAB"
  61. 3045  LOCATE 23,1:SYSTEM
  62. 4000  PRINT TAB(10);:INPUT "Enter the name of the DATAFILE you wish to analyze:  ",FILE$
  63. 4020  ON ERROR GOTO 5020:OPEN FILE$ FOR INPUT AS #1:INPUT #1,A,C
  64. 4040  FOR T=1 TO A:INPUT #1,T(T):NEXT
  65. 4050  FOR T=1 TO A:FOR Z=1 TO C:INPUT #1,D(T,Z):NEXT:NEXT
  66. 4060  FOR T=1 TO A:FOR Z=1 TO T(T):INPUT #1,CS(T,Z):NEXT:NEXT
  67. 4070  FOR T=1 TO A:INPUT #1,N$(T),X(T),X2(T),MD(T),SD(T):NEXT:CLOSE #1:RETURN
  68. 4100  LOCATE AR,53:PRINT TAB(63):LOCATE AR,15:INPUT "Enter the name of your new DATAFILE:  ",FILE$
  69. 4110  ON ERROR GOTO 5040:OPEN FILE$ FOR OUTPUT AS #1
  70. 4120  WRITE #1,A,C:FOR T=1 TO A:WRITE #1,T(T):NEXT
  71. 4130  FOR T=1 TO A:FOR Z=1 TO C:WRITE #1,D(T,Z):NEXT:NEXT
  72. 4140  FOR T=1 TO A:FOR Z=1 TO T(T):WRITE #1,CS(T,Z):NEXT:NEXT
  73. 4150  FOR T=1 TO A:WRITE #1,N$(T),X(T),X2(T),MD(T),SD(T):NEXT:CLOSE #1:RETURN
  74. 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
  75. 4800  LOCATE AR,AC:PRINT SPACE$(8);:LOCATE AR,AC,1,5,7:CL=0
  76. 4805  I$=INKEY$:IF I$="" THEN 4805
  77. 4810  IF I$>CHR$(31) AND CL<8 THEN CL=CL+1:MID$(IT$,CL,1)=I$:PRINT I$;:GOTO 4805
  78. 4815  IF I$=CHR$(13) THEN IP$=MID$(IT$,1,CL):RETURN
  79. 4820  IF I$=CHR$(8) THEN IF CL>0 THEN CL=CL-1:PRINT CHR$(29);" ";CHR$(29);:GOTO 4805
  80. 4825  BEEP:GOTO 4805
  81. 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:"
  82. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  83. 5010  ON ERROR GOTO 0:SYSTEM
  84. 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 ";
  85. 5025  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE PRINT "default ";
  86. 5030  PRINT "drive ";DR$:PRINT "Your files are:":FILES DR$+"*.*":RESUME 4000
  87. 5035  PRINT TAB(16);"That disk is not ready.  Check drive and try again.";:RESUME 4000
  88. 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
  89. 5045  IF ERR=64 OR ERR=52 THEN PRINT TAB(16);"That is not a valid FILE NAME.  Please change name.";:RESUME 4100
  90. 5050  IF ERR=70 THEN PRINT "That disk is write-protected.  Put your data on a different disk.";:RESUME 4100
  91. 5055  IF ERR=71 THEN PRINT TAB(16);"That disk is not ready.  Check drive and try again.";:RESUME 4100 ELSE 5010
  92. 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:";
  93. 5075  A$=INKEY$:IF A$="" THEN 5075 ELSE FOR ZZ=24 TO 25:LOCATE ZZ,10:PRINT TAB(80):NEXT:LOCATE AR,1:RESUME
  94.