1  ! PROGRAM RANK, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM RANK COMPUTES THE KENDALL RANK CORRELATION COEFFICIENT.
   ! IT IS ONE OF THE SEVERAL PROGRAMS AND FILES WHICH COMPOSE COSAP,
   ! LAWRENCE UNIVERSITY'S CONVERSATIONALLY ORIENTED STATISTICAL
3  ! ANALYSIS PACKAGE.  COSAP IS DISTRIBUTED FOR EDUCATIONAL USE, ON
   ! THE CONDITION THAT IT NOT BE SOLD, RENTED OR LEASED FOR PROFIT.
   !
4  ! IF YOU DESIRE FURTHER INFORMATION ABOUT COSAP, PLEASE CONTACT THE
   ! LAWRENCE UNIVERSITY COMPUTER CENTER, APPLETON, WISCONSIN, 54911.
   !
10 DIM N%(30)  ! FUNCTION TO CREATE FILE EXT. BASED ON JOB#
25 DEF FNZ$ : IF N%(0)=30% THEN 40 
    ELSE CHANGE SYS(CHR$(6)+CHR$(9)+CHR$(0)) TO N% : 
   Z8$=".J"+RIGHT(NUM$(N%(1)/2%),2%)
40 FNZ$=Z8$! EXTENSION IS".J"+JOB #
55 FNEND
130 OPEN"DAT1"+FNZ$ AS FILE 1
135 OPEN L1$(1%) FOR INPUT AS FILE 5%
145 DIM#1,X(200,50),H$(30)=2,C(50,50),M4(0),M5(0),M9(0),N(0),
    J9(0),I4(0),N6(0),X2(50),L1$(8)=32%
150 DIM #5%, N$(50%)=8%,M1$(50%)=64%,O%(50%),P%(50%),D$(50%)=8%,
        T(50%),D(10000%)
160 DIM R2(200), A1(200), B1(200)
175 ! ASK TWO VARIABLES TO BE CORRELATED
200 PRINT:PRINT"THIS PROGRAM COMPUTES THE KENDALL RANK CORRELATION "
    "COEFFICIENT."
205 PRINT:PRINT"ENTER THE NAMES OF THE TWO VARIABLES FROM YOUR DATABANK"
    "  *":L1=FNC%("NAME OF FIRST VARIABLE") :
          L2=FNC%("NAME OF SECOND VARIABLE")
220 ! TEST WHETHER THE SPECIFIED VARIABLES ARE PRESENT
280 ! RANK DATA
325 V9 = L1
340 GOSUB 1285 ! DFQRA
355 FOR I=1 TO N(0):A1(I)=R2(I):NEXT I:V9=L2
370 GOSUB 1285 ! DFQRA
385 FOR I=1 TO N(0):B1(I)=R2(I):NEXT I
400 ! SORT RANK VECTORS A AND B IN SEQUENCE OF A
415 I6=0:FOR I=2 TO N(0)
430 IF A1(I)>=A1(I-1) THEN 460 
445 I6=I6+1:F=A1(I):A1(I)=A1(I-1):A1(I-1)=F:F=B1(I):B1(I)=B1(I-1):
     B1(I-1)=F
460 NEXT I
475 IF I6 <> 0 THEN 415 
490 ! COMPUTE S ON VARIABLE B.  STARTING WITH THE FIRST RANK ADD 1 TO  S
505 ! FOR EACH LARGER RANK TO ITS RIGHT AND SUBTRACT 1 FOR EACH SMALLER
520 ! RANK.  REPEAT FOR ALL RANKS.
535 S = 0
550 FOR I = 1 TO N(0) - 1
565 FOR J = I TO N(0)
580 IF B1(J) > B1(I) THEN 640 
595 IF B1(J) = B1(I) THEN 655 
610 S = S-1
625 GO TO 655 
640 S = S+1
655 NEXT J
670 NEXT I
685 ! COMPUTE TIED SCORE INDEX FOR BOTH VARIABLES
700 V9 = 2
715 FOR I = 1 TO N(0)
730 R2(I) = A1(I)
745 NEXT I
760 ! COMPUTE CORRECTION FACTORS FOR TIED RANKS
775 GOSUB 1870 ! DFQTI
790 T1 = T6
805 FOR I=1 TO N(0):R2(I)=B1(I):NEXT I
820 GOSUB 1870 ! DFQTI
835 T2 = T6
850 ! COMPUTE TAU
865 IF T1 <> 0 THEN 925 
880 IF T2 <> 0 THEN 925 
895 T8 = S/(.5*(N(0)*(N(0)-1)))
910 GO TO 955 
925 F1 = N(0)*(N(0)-1)
940 T8 = S/((SQR(.5*F1-T1))*(SQR(.5*F1-T2)))
955 PRINT
970 PRINT"KENDALL RANK CORRELATION COEFFICIENT (TAU).... "T8
985 ! COMPUTE STANDARD DEVIATION AND Z IF N IS 10 OR LARGER
1000 IF N(0)<10 THEN PRINT"SAMPLE SIZE OF";N(0);"IS TOO SMALL TO "
     "PERMIT VALID Z-VALUE.":GOTO 1090
1010 F1=N(0)*(N(0)-1)
1015 S4 = (SQR((2*(N(0)+N(0)+5))/(9*F1)))
1030 Z = T8/S4
1045 PRINT"STANDARD DEVIATION (SD)....................... "S4
1060 PRINT"Z-VALUE TO TEST SIGNIFICANCE (TAU/SD)......... "Z
1075 ! ASK WHETHER MORE CORRELATION IS TO BE PERFORMED
1090 PRINT
1105 PRINT"DO YOU WANT TO PERFORM ADDITIONAL RANK CORRELATIONS WITHIN "
     "THIS":PRINT"DATABANK";:INPUT N$
1120 IF N$="YES" THEN 205 ELSE IF N$<>"SOS" THEN 1180 
1135 PRINT
1150 PRINT"ANSWER 'YES' IF YOU WANT TO CORRELATE A DIFFERENT PAIR "
     "OF VARIABLES":PRINT"(RANKS) IN THIS DATABANK.  ELSE ANSWER 'NO'.":
     GOTO 1090
1180 K$=SYS(CHR$(7)):N$=LEFT(K$,8):S0=VAL(RIGHT(K$,9)):CLOSE 1%,5%
1195 CHAIN N$ S0
1210 !
1225 !****************************DFQRA*********************************
1240 !
1255 ! THIS SUBROUTINE RANKS DATA
1270 ! INITIALIZATION
1285 FOR I = 1 TO N(0)
1300 R2(I) = 0
1315 NEXT I
1330 ! FIND RANK OF DATA
1345 FOR I = 1 TO N(0)
1360 ! TEST WHETHER DATA POINT IS ALREADY RANKED
1375 IF R2(0) > 0 THEN 1765 
1390 ! DATA POINT TO BE RANKED
1405 S6 = 0
1420 E8 = 0
1435 A = X(I,V9)
1450 FOR J = 1 TO N(0)
1465 IF X(J,V9) > A THEN 1585 
1480 IF X(J,V9) = A THEN 1555 
1495 ! COUNT DATA POINTS WHICH ARE SMALLER
1510 S6 = S6+1
1525 GO TO 1585 
1540 ! COUNT DATA POINTS WHICH ARE EQUAL
1555 E8 = E8+1
1570 R2(J) = -1
1585 NEXT J
1600 ! TEST FOR TIE
1615 IF E8 > 1 THEN 1690 
1630 ! STORE RANK OF DATA WHERE NO TIE
1645 R2(I) = S6+1
1660 GO TO 1765 
1675 ! CALCULATE RANK OF TIED DATA POINTS
1690 P = S6+E8*(E8+1)/(E8+E8)
1705 FOR J = 1 TO N(0)
1720 IF R2(J)+1 <> 0 THEN 1750 
1735 R2(J) = P
1750 NEXT J
1765 NEXT I
1780 RETURN
1795 !
1810 !****************************DFQTI*********************************
1825 !
1840 ! THIS SUBROUTINE COMPUTES THE CORRECTION FACTOR FOR TIED RANKS
1855 ! INITIALIZATION
1870 T6 = 0
1885 B = 0
1900 A = N(0)+1
1915 D1 = 0
1930 ! FIND NEXT LARGEST RANK
1945 FOR I = 1 TO N(0)
1960 IF R2(I) <= B THEN 2020 
1975 IF R2(I) >= A THEN 2020 
1990 A = R2(I)
2005 D1 = D1+1
2020 NEXT I
2035 ! IF ALL RANKS HAVE BEEN TESTED, RETURN
2050 IF D1 <= 0 THEN 2275 
2065 B = A
2080 C2 = 0
2095 ! COUNT TIES
2110 FOR I = 1 TO N(0)
2125 IF R2(I) <> A THEN 2155 
2140 C2 = C2+1
2155 NEXT I
2170 ! CALCULATE CORRECTION FACTOR
2185 IF C2 = 0 THEN 1900 
2200 IF V9 = 1 THEN 2245 
2215 T6 = T6+C2*(C2-1)/2
2230 GO TO 1900 
2245 T6 = T6+(C2*C2*C2-C2)/12
2260 GO TO 1900 
2275 RETURN
30000 DEF FNC%(X$)
      ! FUNCTION  TO TRANSLATE VARIABLE NAMES
30010 PRINT X$; UNLESS X$="" : INPUT V$ : IF V$="" THEN PRINT :
      PRINT "VARIABLE NAME NEEDED "; : GOTO 30010
30020 GOTO 30040 IF V$=N$(I%) FOR I%=1% TO O%(0%)
30025 IF LEFT(V$,3%)="SOS" THEN FNC%=808 : GOTO 30050
30030 PRINT "*NO SUCH VARIABLE*  TRY AGAIN." : GOTO 30010
30040 N(0%)=O%(I%) : FNC%=I%
30050 FNEND
32767 END