home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / RANKTEST.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  6.4 KB  |  125 lines
  1. 1  '                 RANK SUM AND SIGNED RANK TESTS
  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 D(1),CS(1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),SR(1),C(1),CF(1)
  6. 22  DATA "RANK TESTS (Non-parametric tests)",22,35
  7. 30  LOCATE 7,5:PRINT "(If you know rank sums, press ENTER to skip directly to RANK TESTS.)"
  8. 35  LOCATE 6,1:GOSUB 4000
  9. 40  LOCATE 9,20:PRINT "1.)  WILCOXON RANK SUM TEST (independent samples)":PRINT
  10. 45  PRINT TAB(20);"2.)  SIGNED RANK TEST (paired samples)":PRINT
  11. 50  PRINT TAB(30);"Enter choice:":AR=13:AC=44:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-1.5)>0.5 THEN BEEP:GOTO 50
  12. 55  CLS:ON ASUB GOTO 95,330
  13. 60  PRINT TAB(5);"What are the SAMPLE NUMBERS of the 2 variables you want to compare?":PRINT:AR=CSRLIN
  14. 65  AC=17:GOSUB 4200:NS1=NS:AC=50:GOSUB 4200:NS2=NS
  15. 70  PRINT "Medians = ";TAB(17);MD(NS1);TAB(50);MD(NS2)
  16. 75  IF ASUB=2 AND T(NS1)<>T(NS2) THEN PRINT:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(35);"a signed rank test cannot be performed.":GOTO 580
  17. 90  RETURN
  18. 95  PRINT TAB(23);"WILCOXON RANK SUM TEST (two-tailed)":PRINT TAB(23);STRING$(35,205):PRINT
  19. 100  IF FILE$="" THEN PRINT ELSE GOSUB 60:N=T(NS1)+T(NS2):GOTO 130
  20. 105  DQ="Enter the NUMBER of observations in Sample ":PRINT TAB(16);DQ;"#1:":AR=5:AC=64:GOSUB 4800:N1=VAL(IP$)
  21. 110  PRINT TAB(16);DQ;"#2:":AR=6:GOSUB 4800:N2=VAL(IP$)
  22. 115  N=N1+N2:NMN=1:IF N1>N2 THEN NMN=2:SWAP N1,N2
  23. 120  LOCATE 8,18:PRINT "Enter the SUM of the ranks for Sample #";NMN;":":AR=8:GOSUB 4800:T=VAL(IP$)
  24. 125  ERASE C,CF:DIM C(N1),CF(N1):GOTO 205
  25. 130  ERASE SR:DIM SR(3,C*2+1):GOSUB 375:T1=1:T2=1
  26. 135  FOR Z=1 TO N
  27. 140  IF T1>T(NS1) THEN SR(1,Z)=VAL(D(NS2,CS(NS2,T2))):SR(2,Z)=0:T2=T2+1:GOTO 160
  28. 145  IF T2>T(NS2) THEN SR(1,Z)=VAL(D(NS1,CS(NS1,T1))):SR(2,Z)=1:T1=T1+1:GOTO 160
  29. 150  VC=VAL(D(NS1,CS(NS1,T1))):VX=VAL(D(NS2,CS(NS2,T2)))
  30. 155  IF VC<VX THEN SR(1,Z)=VC:SR(2,Z)=1:T1=T1+1:GOTO 160 ELSE SR(1,Z)=VX:SR(2,Z)=0:T2=T2+1
  31. 160  NEXT Z:AD=1:SZ=1
  32. 165  FOR Z=1 TO N:IF SR(1,Z)=SR(1,Z+1) THEN AD=AD+1:SZ=SZ+Z+1:GOTO 175
  33. 170  FOR T=Z TO (Z+1-AD) STEP -1:SR(3,T)=SZ/AD:NEXT T:SZ=Z+1:AD=1
  34. 175  NEXT Z:SR1=0:SR2=0
  35. 180  FOR Z=1 TO N:IF SR(2,Z)=1 THEN SR1=SR1+SR(3,Z) ELSE SR2=SR2+SR(3,Z)
  36. 185  NEXT
  37. 190  DQ="Sum of ranks for ":LOCATE AR,24:PRINT DQ;N$(NS1);" = ";SR1:PRINT
  38. 195  PRINT TAB(24);DQ;N$(NS2);" = ";SR2:PRINT
  39. 200  T=SR1:N1=T(NS1):N2=T(NS2):IF N1>N2 THEN SWAP N1,N2:T=SR2
  40. 205  XN=N1*(N+1):IF XN-T<T THEN T=XN-T
  41. 210  AK=0:IF N>30 AND T>XN/2-1.96*SQR(N1*N2*(N+1)/12) THEN AK=1:PRINT:PRINT:AR=CSRLIN:GOTO 565
  42. 215  T=T-N1*(N1+1)*0.5:GOSUB 220:GOTO 225
  43. 220  AR=15:COLOR 23:LOCATE 15,28:PRINT "CALCULATING PROBABILITY":RETURN
  44. 225  BF=4:WT=0:FT=0:CB=0:CF=0:FOR Z=1 TO N1:C(Z)=0:CF(Z)=0:NEXT
  45. 230  IF N1<4 THEN 290
  46. 235  IF T-CF<=N2-CB THEN CT=T-CF+1:CK=0:GOTO 275
  47. 240  CX=N2-CB+1:CD=T-CF-CX+1:CE=CX-CD:CK=INT(CD*0.5+0.5):IF CD<=CX THEN 265
  48. 245  CE=0:CJ=CD:CD=CX:IF CK>CX THEN CK=CX
  49. 250  FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25)
  50. 255  CX=CX-1:CJ=CJ-2:IF CJ>=CX THEN CD=CX ELSE CD=CJ
  51. 260  CE=CX-CD:NEXT Z:GOTO 270
  52. 265  FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25):CX=CX-1:CD=CD-2:CE=CE+1:NEXT Z
  53. 270  CT=T+1-CF-3*CK
  54. 275  FOR Z=1 TO INT(CT/3+0.7):WT=WT+INT((CT*(CT+2)+1)*0.25):CT=CT-3:NEXT Z:CF=CF+4
  55. 280  IF CF>T THEN BF=BF+1:IF BF>N1 THEN 310 ELSE CF(BF)=CF(BF)+BF:CF=CF(BF):GOTO 280
  56. 285  C(BF)=C(BF)+1:FOR Z=2 TO BF:C(Z)=C(BF):CF(Z)=CF:NEXT Z:BF=4:CB=C(4):CF=CF(4):GOTO 235
  57. 290  BF=N1-1:CT=T-CF(BF)+1:CX=N2-C(BF)+1:IF CT<=CX THEN WT=WT+CT ELSE WT=WT+CX
  58. 295  CF(BF)=CF(BF)+N1+1-BF
  59. 300  IF CF(BF)>T OR C(BF)>=N2 THEN BF=BF-1:IF BF<1 THEN 310 ELSE CF(BF)=CF(BF)+N1+1-BF:GOTO 300
  60. 305  C(BF)=C(BF)+1:FOR Z=BF+1 TO 2:C(Z)=C(BF):CF(Z)=CF(BF):NEXT Z:GOTO 290
  61. 310  FT=N:FOR Z=N1 TO 2 STEP -1:N=N-1:FT=FT*N/Z:IF FT>1E+35 THEN 320
  62. 315  NEXT Z:P=WT*2/FT:GOTO 565
  63. 320  FT=LOG(FT):FOR Z=Z-1 TO 2 STEP -1:N=N-1:FT=FT+LOG(N/Z):NEXT Z
  64. 325  P=EXP(LOG(2*WT)-FT):GOTO 565
  65. 330  PRINT TAB(26);"SIGNED RANK TEST (two-tailed)":PRINT TAB(26);STRING$(29,205):PRINT
  66. 335  IF FILE$="" THEN PRINT ELSE GOSUB 60:GOSUB 375:GOTO 380
  67. 340  LOCATE 5,12:PRINT "Enter the NUMBER of non-zero differences ranked:":AR=5:AC=62:GOSUB 4800:N=VAL(IP$)
  68. 345  ERASE C,CF:DIM C(N),CF(N):DQ="Enter the SUM of "
  69. 350  LOCATE 7,21:PRINT DQ;"negative signed ranks:":AR=7:GOSUB 4800:NN=VAL(IP$)
  70. 355  PRINT TAB(21);DQ;"positive signed ranks:":AR=8:GOSUB 4800:NP=VAL(IP$)
  71. 360  IF ABS(NN)<=NP THEN T=ABS(NN) ELSE T=NP
  72. 365  IF ABS(NN)+NP=N*(N+1)*0.5 THEN 455 ELSE BEEP:LOCATE 25,1:PRINT "The SUM of the absolute values of positive and negative ranks should = ";N*(N+1)*0.5;:GOTO 350
  73. 375  AR=10:COLOR 23:LOCATE 10,32:PRINT "RANKING SAMPLES":COLOR CLR1:RETURN
  74. 380  ERASE SR:DIM SR(3,C*2+1):N=T(NS1):NZ=N:CR=0
  75. 385  FOR Z=1 TO N:VC=VAL(D(NS1,Z)):VX=VAL(D(NS2,Z)):VD=VC-VX
  76. 390  IF ABS(VD)<0 THEN NZ=NZ-1:GOTO 405 ELSE CR=CR+1:AY=CR
  77. 395  FOR TZ=1 TO CR-1:IF ABS(VD)<ABS(SR(1,TZ)) THEN SR(1,AY)=SR(1,AY-1):AY=AY-1
  78. 400  NEXT TZ:SR(1,AY)=VD
  79. 405  NEXT Z:AD=1:SZ=1
  80. 410  FOR Z=1 TO CR:IF ABS(SR(1,Z))=ABS(SR(1,Z+1)) THEN AD=AD+1:SZ=SZ+Z+1:GOTO 425
  81. 415  FOR T=(Z+1-AD) TO Z:SR(2,T)=SZ/AD:IF SR(1,T)>0 THEN SR(3,T)=1 ELSE SR(3,T)=0  
  82. 420  NEXT T:SZ=Z+1:AD=1
  83. 425  NEXT Z:SNP=0:SNN=0
  84. 430  FOR Z=1 TO CR:IF SR(3,Z)=1 THEN SNP=SNP+SR(2,Z) ELSE SNN=SNN+SR(2,Z)
  85. 435  NEXT Z
  86. 440  LOCATE AR,20:PRINT "The sum of positive signed RANKS is ";SNP:PRINT
  87. 445  PRINT TAB(20);"The sum of negative signed RANKS is -";SNN:PRINT
  88. 450  SWAP N,NZ:T=SNN:IF SNN>SNP THEN T=SNP
  89. 455  GOSUB 220
  90. 460  IF N<5 THEN P=1:GOTO 565 ELSE WT=N+1:IF WT>T+1 THEN WT=T+1
  91. 465  IF T<=N THEN CT=T-2:GOTO 495
  92. 470  CX=N-1:CD=T-CX-2:CE=CX-CD:CK=INT(CD*0.5+0.5):CJ=CD
  93. 475  IF CD>CX THEN CE=0:CD=CX:IF CK>CX THEN CK=CX
  94. 480  FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25)
  95. 485  CX=CX-1:CJ=CJ-2:IF CJ<CX THEN CD=CJ ELSE CD=CX
  96. 490  CE=CX-CD:NEXT Z:CT=T-3*CK-2
  97. 495  FOR Z=1 TO INT(CT/3+0.7):WT=WT+INT((CT*(CT+2)+1)*0.25):CT=CT-3:NEXT Z
  98. 500  AS=0:FOR Z=1 TO N:C(Z)=Z-1:CF(Z)=AS:AS=AS+Z:NEXT Z
  99. 505  C(4)=4:CB=4:CF=10:BF=4
  100. 510  IF T-CF<=N-CB THEN CT=T-CF+1:GOTO 545 ELSE CX=N-CB+1:CD=T-CF-CX+1:CE=CX-CD:CK=INT(CD*0.5+0.5)
  101. 515  IF CD<=CX THEN 535 ELSE CE=0:CJ=CD:CD=CX:IF CK>CX THEN CK=CX
  102. 520  FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25)
  103. 525  CX=CX-1:CJ=CJ-2:IF CJ<CX THEN CD=CJ ELSE CD=CX
  104. 530  CE=CX-CD:NEXT Z:GOTO 540
  105. 535  FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25):CX=CX-1:CD=CD-2:CE=CE+1:NEXT Z
  106. 540  CT=T+1-CF-3*CK
  107. 545  FOR Z=1 TO INT(CT/3+0.7):WT=WT+INT((CT*(CT+2)+1)*0.25):CT=CT-3:NEXT Z:CF=CF+4
  108. 550  IF CF>T THEN BF=BF+1:IF BF>N THEN 560 ELSE CF(BF)=CF(BF)+BF:CF=CF(BF):FOR Z=4 TO BF-1:C(Z)=C(BF)+1:CF(Z)=CF:NEXT Z:GOTO 550
  109. 555  C(BF)=C(BF)+1:CB=C(BF):BF=4:GOTO 510
  110. 560  IF N<100 THEN P=WT/2^(N-1) ELSE P=EXP(LOG(WT)-(N-1)*LOG(2))
  111. 565  PLAY "MS O3 L64 G O2 GE L9 E"
  112. 570  LOCATE AR,20:COLOR CLR2,CLR1:PRINT TAB(33);"p =  ";:IF AK=1 THEN PRINT ">.05"; ELSE IF P>0.5 THEN PRINT "> .5"; ELSE IF P<9.99E-07 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
  113. 575  PRINT TAB(61);:COLOR CLR1,CLR2:LOCATE 25,1:PRINT TAB(79)
  114. 580  DQ="Do you want to perform another rank test ":LOCATE 25,9:PRINT DQ;
  115. 585  IF FILE$="" THEN PRINT "? (Y or N)  ";ELSE PRINT "using this datafile?  ";
  116. 590  INPUT;"",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 40
  117. 595  IF FILE$<>"" THEN LOCATE 25,7:PRINT DQ;:INPUT "using a different datafile?  ",A$:IF A$="y" OR A$="Y" THEN 20
  118. 605  GOTO 3000
  119. 4010  IF FILE$="" THEN 40
  120. 4025  ERASE D,CS,T,N$,X,X2,MD,SD,SR,C,CF
  121. 4030  DIM D(A,C),CS(A,C+5),SR(3,C*2+1),N$(A),X(A),X2(A),T(A),SD(A),MD(A),C(C),CF(C)
  122. 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:"
  123. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  124. 5010  ON ERROR GOTO 0:END
  125.