1 '                 RANK SUM AND SIGNED RANK TESTS
2 '               Written by Tracy L. Gustafson, M.D.
3 '              Round Rock, Texas. Version 3.0, 1984
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",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)
22 DATA "RANK TESTS (Non-parametric tests)",19,35
30 LOCATE 7,5:PRINT "(If you know rank sums, press ENTER to skip directly to RANK TESTS.)"
35 LOCATE 6,1:GOSUB 4000
40 PRINT:PRINT:PRINT TAB(15);"1.)  WILCOXON RANK SUM TEST (independent samples)":PRINT
45 PRINT TAB(15);"2.)  SIGNED RANK TEST (paired samples)":PRINT:PRINT
50 PRINT TAB(20);:INPUT "Enter choice:   ",ASUB:IF ABS(ASUB-1.5)>.5 THEN BEEP:GOTO 50
55 CLS:ON ASUB GOTO 95,330
60 PRINT TAB(5);"What are the SAMPLE NUMBERS of the 2 variables you want to compare?":PRINT:AR=CSRLIN
65 AC=17:GOSUB 4200:NS1=NS:AC=50:GOSUB 4200:NS2=NS
70 PRINT "Medians = ";TAB(17);MD(NS1);TAB(50);MD(NS2)
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
90 RETURN
95 PRINT TAB(18);"WILCOXON RANK SUM TEST (two-tailed)":PRINT TAB(18);STRING$(35,205):PRINT
100 IF FILE$="" THEN PRINT ELSE GOSUB 60:N=T(NS1)+T(NS2):GOTO 130
105 DQ="Enter the NUMBER of observations in Sample ":PRINT TAB(10);DQ;:INPUT "#1:  ",N1
110 PRINT TAB(10);DQ;:INPUT "#2:  ",N2
115 PRINT:N=N1+N2:NMN=1:IF N1>N2 THEN NMN=2:SWAP N1,N2
120 PRINT TAB(12);"Enter the SUM of the ranks for Sample #";NMN;:INPUT":  ",T
125 ERASE C,CF:DIM C(N1),CF(N1):GOTO 205
130 AR=10:LOCATE 10,26:COLOR 23:PRINT "RANKING SAMPLES":COLOR CLR1:T1=1:T2=1
135 FOR Z=1 TO N
140 IF T1>T(NS1) THEN SR(1,Z)=VAL(D(NS2,CS(NS2,T2))):SR(2,Z)=0:T2=T2+1:GOTO 160
145 IF T2>T(NS2) THEN SR(1,Z)=VAL(D(NS1,CS(NS1,T1))):SR(2,Z)=1:T1=T1+1:GOTO 160
150 VC=VAL(D(NS1,CS(NS1,T1))):VX=VAL(D(NS2,CS(NS2,T2)))
155 IF VCN2 THEN SWAP N1,N2:T=SR2
205 XN=N1*(N+1):IF XN-T30 AND T>XN-1.96*SQR(N1*N2*(N+1)/12) THEN AK=1:PRINT:PRINT:AR=CSRLIN:GOTO 565
215 T=T-N1*(N1+1)*.5
220 PRINT:PRINT:AR=CSRLIN:COLOR 23:PRINT TAB(24);"CALCULATING PROBABILITY"
225 BF=4:WT=0:FT=0:CB=0:CF=0:FOR Z=1 TO N1:C(Z)=0:CF(Z)=0:NEXT
230 IF N1<4 THEN 290
235 IF T-CF<=N2-CB THEN CT=T-CF+1:CK=0:GOTO 275
240 CX=N2-CB+1:CD=T-CF-AX+1:CE=CX-CD:CK=INT(CD*.5+.5):IF CD<=CX THEN 265
245 CE=0:CJ=CD:CD=CX:IF CK>CX THEN CK=CX
250 FOR Z=1 TO CK:WT=WT+CD*.5*(CX+CE+1)+INT((CE*(CE+2)+1)*.25)
255 CX=CX-1:CJ=CJ-2:IF CJ>=CX THEN CD=CX ELSE CD=CJ
260 CE=CX-CD:NEXT Z:GOTO 270
265 FOR Z=1 TO CK:WT=WT+CD*.5*(CX+CE+1)+INT((CE*(CE+2)+1)*.25):CX=CX-1:CD=CD-2:CE=CE+1:NEXT Z
270 CT=T+1-CF-3*CK
275 FOR Z=1 TO INT(CT/3+.7):WT=WT+INT((CT*(CT+2)+1)*.25):CT=CT-3:NEXT Z:CF=CF+4
280 IF CF>T THEN BF=BF+1:IF BF>N1 THEN 310 ELSE CF(BF)=CF(BF)+BF:CF=CF(BF):GOTO 280
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
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
295 CF(BF)=CF(BF)+N1+1-BF
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
305 C(BF)=C(BF)+1:FOR Z=BF+1 TO 2:C(Z)=C(BF):CF(Z)=CF(BF):NEXT Z:GOTO 290
310 FT=N:FOR Z=N1 TO 2 STEP -1:N=N-1:FT=FT*N/Z:IF FT>1E+35 THEN 320
315 NEXT Z:P=WT*2/FT:GOTO 565
320 FT=LOG(FT):FOR Z=Z-1 TO 2 STEP -1:N=N-1:FT=FT+LOG(N/Z):NEXT Z
325 P=EXP(LOG(2*WT)-FT):GOTO 565
330 PRINT TAB(22);"SIGNED RANK TEST (two-tailed)":PRINT TAB(22);STRING$(29,205):PRINT
335 IF FILE$="" THEN PRINT ELSE GOSUB 60:GOTO 375
340 PRINT TAB(10);:INPUT "Enter the NUMBER of non-zero differences ranked:  ",N
345 ERASE C,CF:DIM C(N),CF(N):PRINT:AR=CSRLIN:DQ="Enter the SUM of "
350 PRINT TAB(15);DQ;:INPUT "negative signed ranks:  ",NN
355 PRINT TAB(15);DQ;:INPUT "positive signed ranks:  ",NP
360 IF ABS(NN)<=NP THEN T=ABS(NN) ELSE T=NP
365 IF ABS(NN)+NP=N*(N+1)*.5 THEN 455 ELSE BEEP:LOCATE 25,1:PRINT "The SUM of the absolute values of positive and negative ranks should = ";N*(N+1)*.5;:LOCATE AR,56:PRINT "     ":LOCATE AR+1,56:PRINT "     ":LOCATE AR,1:GOTO 350
375 PRINT:AR=CSRLIN:COLOR 23:PRINT TAB(26);"RANKING SAMPLES":COLOR CLR1
380 N=T(NS1):NZ=N:CR=0
385 FOR Z=1 TO N:VC=VAL(D(NS1,Z)):VX=VAL(D(NS2,Z)):VD=VC-VX
390 IF ABS(VD)<1E-10 THEN NZ=NZ-1:GOTO 405 ELSE CR=CR+1:AY=CR
395 FOR TZ=1 TO CR-1:IF ABS(VD)0 THEN SR(3,T)=1
420 NEXT T:SZ=Z+1:AD=1
425 NEXT Z:SNP=0:SNN=0
430 FOR Z=1 TO CR:IF SR(3,Z)=1 THEN SNP=SNP+SR(2,Z) ELSE SNN=SNN+SR(2,Z)
435 NEXT Z
440 LOCATE AR,15:PRINT "The sum of positive signed RANKS is ";SNP:PRINT
445 PRINT TAB(15);"The sum of negative signed RANKS is -";SNN:PRINT
450 SWAP N,NZ:T=SNN:IF SNN>SNP THEN T=SNP
455 PRINT:PRINT:AR=CSRLIN:COLOR 23:PRINT TAB(24);"CALCULATING PROBABILITY"
460 IF N<5 THEN P=1:GOTO 565 ELSE WT=N+1:IF WT>T+1 THEN WT=T+1
465 IF T<=N THEN CT=T-2:GOTO 495
470 CX=N-1:CD=T-CX-2:CE=CX-CD:CK=INT(CD*.5+.5):CJ=CD
475 IF CD>CX THEN CE=0:CD=CX:IF CK>CX THEN CK=CX
480 FOR Z=1 TO CK:WT=WT+CD*.5*(CX+CE+1)+INT((CE*(CE+2)+1)*.25)
485 CX=CX-1:CJ=CJ-2:IF CJCX THEN CK=CX
520 FOR Z=1 TO CK:WT=WT+CD*.5*(CX+CE+1)+INT((CE*(CE+2)+1)*.25)
525 CX=CX-1:CJ=CJ-2:IF AJT 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
555 C(BF)=C(BF)+1:CB=C(BF):BF=4:GOTO 510
560 IF N<100 THEN P=WT/2^(N-1) ELSE P=EXP(LOG(WT)-(N-1)*LOG(2#))
565 PLAY "MB O3 T100 L10 CL24D#L10EL32 GF# L10 G. L32 ED L16 E L30 GE L5 C"
570 LOCATE AR,1:COLOR CLR2,CLR1:PRINT TAB(27);"P =  ";:IF AK=1 THEN PRINT ">.05"; ELSE IF P>.5 THEN PRINT "> .5"; ELSE IF P<.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
575 PRINT TAB(75);:COLOR CLR1,CLR2:LOCATE 25,1:PRINT TAB(79)
580 DQ="Do you want to perform another rank test ":LOCATE 25,9:PRINT DQ;
585 IF FILE$="" THEN PRINT "? (Y or N)  ";ELSE PRINT "using this datafile?  ";
590 INPUT;"",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 40
595 IF FILE$<>"" THEN LOCATE 25,7:PRINT DQ;:INPUT "using a different datafile?  ",A$:IF A$="y" OR A$="Y" THEN 20
605 LOCATE 23,1:END
4010 IF FILE$="" THEN 40
4025 ERASE D,CS,T,N$,X,X2,MD,SD,SR,C,CF
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)
5000 BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END