1 SUBROUTINE WCOV(MM, M, N, A, CLAB, RLAB, TITLE, NC, DMCOV, COV, 2 1 COVLAB, COVTIT, WORK) 3C 4C<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> 5C 6C PURPOSE 7C ------- 8C 9C COMPUTES COVARIANCES WITHIN EACH CLUSTER 10C 11C DESCRIPTION 12C ----------- 13C 14C 1. THE ARRAY NC DEFINES THE CLUSTER MEMBERSHIP FOR EACH CASE. IF 15C NC(I) = J THEN CASE I IS IN CLUSTER J. 16C 17C 2. THE MEAN FOR EACH CLUSTER IS DETERMINED, AND THE CROSS PRODUCTS 18C BETWEEN EACH VARIABLE WITHIN EACH CLUSTER ARE ACCUMULATED. 19C FINALLY, THE CROSS PRODUCTS ARE DIVIDED BY THE DEGREES OF 20C FREEDOM (THE NUMBER OF CASES - THE NUMBER OF CLUSTERS). 21C 22C 3. THE ROUTINE ASSUMES THERE ARE NO MISSING VALUES. IF SOME 23C MISSING VALUES EXIST, CALL CLUSTER SUBROUTINE "TWO" TO REPLACE 24C THEM BY THE OVERALL MEAN OF THE VARIABLE, OR CALL CLUSTER 25C ROUTINE "MISS" TO REPLACE THEM BY THE CLUSTER MEAN OF THE 26C VARIABLE . SINCE THE LABELS FOR THE WITHIN-GROUP COVARIANCE 27C MATRIX ARE SYMMETRIC, ONLY ONE VECTOR OF LABELS ARE GENERATED 28C AND THAT VECTOR CAN BE USED FOR BOTH LABEL ARGUMENTS FOR THE 29C CLUSTER SUBROUTINE "OUT". SEE "WCOV" IN THE SAMPLE FILE UNDER 30C ACCOUNT HARTIGA FOR AN EXAMPLE OF CALLING "OUT" AFTER WCOV. 31C 32C INPUT PARAMETERS 33C ---------------- 34C 35C MM INTEGER SCALAR (UNCHANGED ON OUTPUT). 36C THE FIRST DIMENSION OF THE MATRIX A. MUST BE AT LEAST M. 37C 38C M INTEGER SCALAR (UNCHANGED ON OUTPUT). 39C THE NUMBER OF CASES. 40C 41C N INTEGER SCALAR (UNCHANGED ON OUTPUT). 42C THE NUMBER OF VARIABLES. 43C 44C A REAL MATRIX WHOSE FIRST DIMENSION MUST BE MM AND WHOSE SECOND 45C DIMENSION MUST BE AT LEAST N. (UNCHANGED ON OUTPUT). 46C 47C A(I,J) IS THE VALUE FOR THE J-TH VARIABLE FOR THE I-TH CASE. 48C 49C CLAB VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST N. 50C (UNCHANGED ON OUTPUT). 51C THE LABELS OF THE VARIABLES. 52C 53C RLAB VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST M. 54C (UNCHANGED ON OUTPUT). 55C THE LABELS OF THE CASES. 56C 57C TITLE 10-CHARACTER VARIABLE (UNCHANGED ON OUTPUT). 58C TITLE OF THE DATA SET. 59C 60C NC INTEGER VECTOR DIMENSIONED AT LEAST M (UNCHANGED ON OUTPUT). 61C NC(I) INDICATES THE CLUSTER NUMBER FOR CASE I. 62C 63C DMCOV INTEGER SCALAR (UNCHANGED ON OUTPUT). 64C THE FIRST DIMENSION OF THE COVARIANCE MATRIX. MUST BE AT 65C LEAST N. 66C 67C WORK REAL VECTOR DIMENSIONED AT LEAST N. 68C WORK VECTOR. 69C 70C OUTPUT PARAMETERS 71C ----------------- 72C 73C COV REAL MATRIX WHOSE FIRST DIMENSION MUST BE DMCOV AND WHOSE 74C SECOND DIMENSION MUST BE AT LEAST N. 75C THE WITHIN-GROUP COVARIANCE MATRIX. 76C 77C COVLAB VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST N. 78C THE LABELS OF THE VARIABLES FOR THE WITHIN-GROUP COVARIANCE 79C MATRIX. 80C 81C COVTIT 10-CHARACTER VARIABLE. 82C TITLE OF THE WITHIN-GROUP COVARIANCE MATRIX. 83C 84C REFERENCE 85C --------- 86C 87C HARTIGAN, J. A. (1975). CLUSTERING ALGORITHMS, JOHN WILEY & 88C SONS, INC., NEW YORK. PAGES 69, 70. 89C 90C<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> 91C 92 INTEGER DMCOV 93 DIMENSION A(MM,*), COV(DMCOV,*), NC(*), WORK(*) 94 CHARACTER*4 CLAB(*), RLAB(*), COVLAB(*) 95 CHARACTER*10 TITLE, COVTIT 96C 97C INITIALIZE COVARIANCES AND COUNT TOTAL NUMBER OF CLUSTERS 98C 99 DO 10 I=1,N 100 DO 10 J=1,N 101 10 COV(I,J)=0. 102 K=0 103 DO 20 I=1,M 104 20 IF(NC(I).GT.K) K=NC(I) 105C 106C COMPUTE MEAN FOR EACH CLUSTER 107C 108 Q=0. 109 DO 90 L=1,K 110 P=0. 111 DO 30 J=1,N 112 30 WORK(J)=0. 113 DO 50 I=1,M 114 IF(NC(I).EQ.L) THEN 115 P=P+1. 116 DO 40 J=1,N 117 40 WORK(J)=WORK(J)+A(I,J) 118 ENDIF 119 50 CONTINUE 120 DO 60 J=1,N 121 60 IF(P.NE.0.) WORK(J)=WORK(J)/P 122 IF(P.GT.0.) Q=Q+P-1. 123C 124C ADD ON CROSS PRODUCTS 125C 126 DO 80 I=1,M 127 IF(NC(I).EQ.L) THEN 128 DO 70 J=1,N 129 DO 70 JJ=1,J 130 70 COV(J,JJ)=COV(J,JJ)+(A(I,J)-WORK(J))*(A(I,JJ) 131 * -WORK(JJ)) 132 ENDIF 133 80 CONTINUE 134 90 CONTINUE 135C 136C DIVIDE BY DEGREES OF FREEDOM 137C 138 DO 100 J=1,N 139 DO 100 JJ=1,J 140 IF(Q.GT.0.) COV(J,JJ)=COV(J,JJ)/Q 141 100 COV(JJ,J)=COV(J,JJ) 142C 143C LABEL 144C 145 DO 110 J=1,N 146 110 COVLAB(J)=CLAB(J) 147 COVTIT = 'WITHIN COV' 148 RETURN 149 END 150