home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / CHISQR.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  3.5 KB  |  62 lines
  1. 1  '                        CHI-SQUARE TEST
  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. 15  DIM XC(1,1),SR(1),SC(1):P$="######"
  6. 22  DATA "CHI-SQUARE TEST",32,17
  7. 30  LOCATE 5,5:PRINT "Do you want to evaluate a:":PRINT
  8. 35  PRINT TAB(29);"1.)  Table of data.":PRINT
  9. 40  PRINT TAB(29);"2.)  Known chi-square value.":PRINT
  10. 45  PRINT TAB(29);"3.)  Chi-square test for trend."
  11. 50  LOCATE 15,34:PRINT "Enter choice:":AR=15:AC=48:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 50
  12. 55  CLS:ON ASUB GOTO 110,100,60
  13. 60  AF=0:PRINT TAB(30);DTTL;" FOR TREND":PRINT TAB(30);STRING$(25,205):N1=0:N2=0:E1=0:E2=0:E3=0
  14. 65  LOCATE 6,6:INPUT "Enter NAME of factor you wish to test for dose response:  ",DC
  15. 70  PRINT TAB(25);"How many levels does ";DC;" have?":AR=7:AC=53+LEN(DC):GOSUB 4800:CL=VAL(IP$):PRINT
  16. 75  AR=CSRLIN:LOCATE 25,5:PRINT "Exposure levels should be ranks or midpoints of exposure categories.";:LOCATE AR+1,1
  17. 80  PRINT DC;" EXPOSURE LEVEL";TAB(35);"CASES";TAB(50);"CONTROLS":PRINT STRING$(60,196)
  18. 85  FOR Z=1 TO CL:AR=CSRLIN:INPUT;"     ",XE:AC=36:GOSUB 285:BA=I:AC=53:GOSUB 285:BB=I:PRINT
  19. 90  M=BA+BB:N1=N1+BA:N2=N2+BB:E1=E1+BA*XE:E2=E2+M*XE:E3=E3+M*XE*XE:NEXT Z
  20. 95  N=N1+N2:X=E1-(N1*E2/N):X=X*X*(N*N*(N-1))/(N1*N2*(N*E3-E2*E2)):V1=1:GOTO 160
  21. 100  GOSUB 280:AF=0:LOCATE 6,28:PRINT "Enter chi-square value:":AR=6:AC=53:GOSUB 4800:X=VAL(IP$)
  22. 105  LOCATE 8,26:PRINT "Enter degrees of freedom:":AR=8:GOSUB 4800:V1=VAL(IP$):PRINT:GOTO 165
  23. 110  GOSUB 280:AF=1:LOCATE 4,10:PRINT "How many ROWS?":AR=4:AC=25:GOSUB 4800:NR=VAL(IP$):PRINT TAB(48);"How many COLUMNS?":AC=66:GOSUB 4800:NC=VAL(IP$)
  24. 115  ERASE XC,SR,SC:DIM XC(NR,NC),SR(NR),SC(NC):PRINT:PRINT
  25. 120  TB=INT(75/(NC+1))+(NC<5)*20/NC:F=((NR*NC)=4)*(-0.5):V1=(NR-1)*(NC-1)
  26. 125  SN=0:CQ=0:X=0:PRINT "Enter your table values:";TAB(TB*(NC+1));"TOTAL":PRINT
  27. 130  FOR AX=1 TO NR:AR=CSRLIN:FOR AY=1 TO NC
  28. 135  AC=AY*TB:GOSUB 285:XC(AX,AY)=I:SR(AX)=SR(AX)+I:NEXT
  29. 140  LOCATE AR,TB*AY-3:PRINT USING P$;SR(AX):SN=SN+SR(AX):PRINT:NEXT
  30. 145  PRINT "TOTAL";:AR=CSRLIN:FOR AY=1 TO NC:FOR AX=1 TO NR:SC(AY)=SC(AY)+XC(AX,AY):NEXT:LOCATE AR,TB*AY-4:PRINT USING P$;SC(AY);:NEXT:LOCATE AR,TB*AY-3:PRINT USING P$;SN
  31. 150  FOR AX=1 TO NR:FOR AY=1 TO NC:E=SR(AX)*SC(AY)/SN:IF E<5 THEN CQ=1
  32. 155  XZ=ABS(XC(AX,AY)-E)-F:XZ=XZ*XZ/E:X=X+XZ:NEXT:NEXT
  33. 160  PRINT:PRINT TAB(16);"CHI-SQUARE = ";X;TAB(57);"df =";V1
  34. 165  IF X<31 OR V1>2 THEN J=V1/2-1:R=1 ELSE P=0:GOTO 195
  35. 170  FOR B=1 TO INT(V1/2-0.5):R=R*J:J=J-1:NEXT
  36. 175  IF V1 MOD 2<>0 THEN R=R*1.77245
  37. 180  S=1:I=1:K=((X/2)^(V1/2))*2/(EXP(X/2)*R*V1):VC=V1+2
  38. 185  I=I*X/VC:S=S+I:VC=VC+2:IF I>0 THEN 185
  39. 190  P=1-K*S
  40. 195  PLAY "MS O3 L64 G O2 GE L9 E":PRINT:PRINT TAB(15);
  41. 200  COLOR CLR2,CLR1:PRINT TAB(32);"p = ";:IF P<9.99E-07 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
  42. 205  PRINT TAB(66):COLOR CLR1,CLR2
  43. 210  IF AF=0 THEN 235 ELSE IF V1>1 THEN 230 ELSE PRINT:PRINT:PRINT TAB(28);"ODDS RATIO = ";
  44. 215  XD=XC(1,2)*XC(2,1):IF XD=0 THEN PRINT "not calculable";:GOTO 230 ELSE XO=XC(1,1)*XC(2,2)/XD:PRINT XO:IF XO=0 THEN 230
  45. 220  M1=SR(1):M2=SR(2):N1=SC(1):N2=SC(2):YA=XC(1,1)
  46. 225  PRINT TAB(14);"95% Confidence limits:  ";:F=-1:GOSUB 245:PRINT "  and  ";:F=1:GOSUB 245
  47. 230  IF CQ=1 THEN PRINT:PRINT:PRINT "The Chi-square test may not be applicable in this case---":PRINT TAB(24);"because the expected count in one or more cells is < 5."
  48. 235  LOCATE 25,1:PRINT TAB(79):LOCATE 25,15:INPUT;"Do you want to calculate another Chi-square test?  ",A$:IF A$="y" OR A$="Y" THEN 20
  49. 240  GOTO 3000
  50. 245  N=0:Y1=YA
  51. 250  Y=1/Y1+1/(M1-Y1)+1/(N1-Y1)+1/(N2-M1+Y1):IF Y<0 THEN 270
  52. 255  Y2=YA+F*0.5+F*1.96*(1/Y1+1/(M1-Y1)+1/(N1-Y1)+1/(N2-M1+Y1))^-0.5:N=N+1
  53. 260  IF ABS(Y1-Y2)>9.999E-06 AND N<500 THEN Y1=Y2:GOTO 250
  54. 265  IF N<500 THEN PRINT Y2*(N2-M1+Y2)/((M1-Y2)*(N1-Y2));:RETURN
  55. 270  XP=1.96/SQR(X):X1=EXP((1-XP)*LOG(XO)):X2=EXP((1+XP)*LOG(XO)):IF F=SGN(X1-X2) THEN PRINT X1; ELSE PRINT X2;
  56. 275  RETURN
  57. 280  PRINT TAB(34);DTTL:PRINT TAB(34);STRING$(15,205):PRINT:RETURN
  58. 285  GOSUB 4800:I=VAL(IP$):IF INT(I)=I THEN RETURN ELSE BEEP:LOCATE 25,20:PRINT "Please enter integers only.";:LOCATE AR,AC:PRINT "    ";:GOTO 285
  59. 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:"
  60. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  61. 5010  ON ERROR GOTO 0:END
  62.