home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / MHCHISQR.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  1.9 KB  |  38 lines
  1. 1  '                 MANTEL-HAENSZEL 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. 22  DATA "MANTEL-HAENSZEL CHI-SQUARE TEST",24,33
  6. 30  PRINT TAB(20);:INPUT "Enter NAME of the factor you wish to TEST: ",DT
  7. 35  PRINT TAB(5);:INPUT "Enter NAME of the related factor you wish to CONTROL FOR: ",DC
  8. 40  PRINT TAB(5);DT;" must be a dichotomous variable,":PRINT TAB(35);"but ";DC;" may have > 2 categories."
  9. 45  LOCATE 10,20:PRINT "How many categories does ";DC;" have?";:AR=10:AC=52+LEN(DC):GOSUB 4800:CJ=VAL(IP$):PRINT
  10. 50  PRINT:PRINT TAB(32);"CASES";TAB(55);"CONTROLS": PRINT" ";DC;" CATEGORY";
  11. 55  PRINT TAB(25);"+";DT;TAB(36);"-";DT;TAB(50);"+";DT;TAB(61);"-";DT
  12. 60  PRINT STRING$(17,196);TAB(23);STRING$(48,196)
  13. 65  N=0:SA=0:SB=0:SN=0
  14. 70  FOR Z=1 TO CJ:AR=CSRLIN:LOCATE AR,5:INPUT;"",A$
  15. 75  AC=27:GOSUB 170:BA=I:AC=38:GOSUB 170:BB=I:AC=52:GOSUB 170:BC=I:AC=63:GOSUB 170:BD=I:PRINT
  16. 80  N=BA+BB+BC+BD:SA=SA+BA*BD/N:SB=SB+BB*BC/N
  17. 85  SN=SN+(BA+BB)*(BA+BC)*(BC+BD)*(BB+BD)/(N*N*(N-1))
  18. 90  NEXT Z:PRINT
  19. 95  X=ABS(SA-SB)-0.5:X=X*X/SN:V1=CJ-1
  20. 100  COLOR CLR2,CLR1:PRINT TAB(10);"CHI-SQUARE = ";X;TAB(42);"df =";V1;
  21. 105  IF X<31 OR V1>2 THEN J=V1/2-1:R=1 ELSE P=0:GOTO 135
  22. 110  FOR B=1 TO INT(V1/2-0.5):R=R*J:J=J-1:NEXT
  23. 115  IF V1 MOD 2<>0 THEN R=R*1.77245
  24. 120  S=1:I=1:VC=V1+2:K=((X/2)^(V1/2))*2/(EXP(X/2)*R*V1)
  25. 125  I=I*X/VC:S=S+I:VC=VC+2:IF I>0 THEN 125
  26. 130  P=1-K*S
  27. 135  PLAY "MS O3 L64 G O2 GE L9 E"
  28. 140  PRINT TAB(57);"p = ";:IF P<9.99E-07 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
  29. 145  PRINT TAB(80):COLOR CLR1,CLR2
  30. 150  PRINT:PRINT:PRINT TAB(29);"ODDS RATIO = ";:IF SB=0 THEN PRINT "not calculable":GOTO 160
  31. 155  XO=SA/SB:XP=1.96/SQR(X):PRINT XO;TAB(14);"95% Confidence limits:  ";EXP((1-XP)*LOG(XO));"  and  ";EXP((1+XP)*LOG(XO))
  32. 160  LOCATE 25,8:INPUT;"Do you want to calculate another Mantel-Haenszel Chi-square?  ",A$:IF A$="y" OR A$="Y" THEN 20
  33. 165  GOTO 3000
  34. 170  GOSUB 4800:I=VAL(IP$):IF INT(I)=I THEN RETURN ELSE BEEP:LOCATE 25,15:PRINT "Please enter integers only.";:LOCATE AR,AC:PRINT "    ":GOTO 170
  35. 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:"
  36. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  37. 5010  ON ERROR GOTO 0:END
  38.