$JOB MDISC[30,30]
$FORTRAN MDISC
C MDIS 10
C ..................................................................MDIS 20
C MDIS 30
C SAMPLE MAIN PROGRAM FOR DISCRIMINANT ANALYSIS - MDISC MDIS 40
C MDIS 50
C PURPOSE MDIS 60
C (1) READ THE PROBLEM PARAMETER CARD AND DATA FOR DISCRIMI- MDIS 70
C NANT ANALYSIS, (2) CALL THREE SUBROUTINES TO CALCULATE VARI-MDIS 80
C ABLE MEANS IN EACH GROUP, POOLED DISPERSION MATRIX, COMMON MDIS 90
C MEANS OF VARIABLES, GENERALIZED MAHALANOBIS D SQUARE, MDIS 100
C COEFFICIENTS OF DISCRIMINANT FUNCTIONS, AND PROBABILITY MDIS 110
C ASSOCIATED WITH LARGEST DISCRIMINANT FUNCTION OF EACH MDIS 120
C CASE IN EACH GROUP, AND (3) PRINT THE RESULTS. MDIS 130
C MDIS 140
C REMARKS MDIS 150
C THE NUMBER OF VARIABLES MUST BE GREATER THAN OR EQUAL TO MDIS 160
C THE NUMBER OF GROUPS. MDIS 170
C MDIS 180
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED MDIS 190
C DMATX MDIS 200
C MINV MDIS 210
C DISCR MDIS 220
C MDIS 230
C METHOD MDIS 240
C REFER TO 'BMD COMPUTER PROGRAMS MANUAL', EDITED BY W. J. MDIS 250
C DIXON, UCLA, 1964, AND T. W. ANDERSON, 'INTRODUCTION TO MDIS 260
C MULTIVARIATE STATISTICAL ANALYSIS', JOHN WILEY AND SONS, MDIS 270
C 1958, SECTION 6.6-6.8. MDIS 280
C MDIS 290
C ..................................................................MDIS 300
C MDIS 310
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE MDIS 320
C NUMBER OF GROUPS, K.. MDIS 330
C MDIS 340
DIMENSION N(5) MDIS 350
C MDIS 360
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE MDIS 370
C NUMBER OF VARIABLES, M.. MDIS 380
C MDIS 390
DIMENSION CMEAN(10) MDIS 400
C MDIS 410
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE MDIS 420
C PRODUCT OF M*K.. MDIS 430
C MDIS 440
DIMENSION XBAR(50) MDIS 450
C MDIS 460
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE MDIS 470
C PRODUCT OF (M+1)*K.. MDIS 480
C MDIS 490
DIMENSION C(55) MDIS 500
C MDIS 510
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE MDIS 520
C PRODUCT OF M*M.. MDIS 530
C MDIS 540
DIMENSION D(100) MDIS 550
C MDIS 560
C THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE MDIS 570
C TOTAL OF SAMPLE SIZES OF K GROUPS COMBINED, T (T = N(1)+N(2)+... MDIS 580
C +N(K)).. MDIS 590
C MDIS 600
DIMENSION P(250),LG(250) MDIS 610
C MDIS 620
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE MDIS 630
C TOTAL DATA POINTS WHICH IS EQUAL TO THE PRODUCT OF T*M.. MDIS 640
C MDIS 650
DIMENSION X(2500) MDIS 660
C MDIS 670
C ..................................................................MDIS 680
C MDIS 690
C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE MDIS 700
C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION MDIS 710
C STATEMENT WHICH FOLLOWS. MDIS 720
C MDIS 730
C DOUBLE PRECISION CMEAN,XBAR,D,DET,C,V,P MDIS 740
C MDIS 750
C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS MDIS 760
C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS MDIS 770
C ROUTINE. MDIS 780
C MDIS 790
C ...............................................................MDIS 800
C MDIS 810
1 FORMAT(A4,A2,2I2,12I5/(14I5)) MDIS 820
2 FORMAT(27H1DISCRIMINANT ANALYSIS.....,A4,A2/19H0 NUMBER OF GROUPSMDIS 830
1,7X,I3/22H NUMBER OF VARIABLES,I7/17H SAMPLE SIZES../12X,5HGROMDIS 840
2UP) MDIS 850
3 FORMAT(12X,I3,8X,I4) MDIS 860
4 FORMAT(1H0) MDIS 870
5 FORMAT(12F6.0) MDIS 880
6 FORMAT(6H0GROUP,I3,7H MEANS/(8F15.5)) MDIS 890
7 FORMAT(1H0/25H POOLED DISPERSION MATRIX) MDIS 900
8 FORMAT(4H0ROW,I3/(8F15.5)) MDIS 910
9 FORMAT(1H0//13H COMMON MEANS/(8F15.5)) MDIS 920
10 FORMAT(1H///33H GENERALIZED MAHALANOBIS D-SQUARE,F15.5//) MDIS 930
11 FORMAT(22H0DISCRIMINANT FUNCTION,I3/1H ,6X,27HCONSTANT * COEFFMDIS 940
1ICIENTS/1H F14.5,7H * ,7F14.5/(22X,7F14.5)) MDIS 950
12 FORMAT(1H0//60H EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH OBMDIS 960
1SERVATION) MDIS 970
13 FORMAT(6H0GROUP,I3/19X,27HPROBABILITY ASSOCIATED WITH,11X,7HLARGESMDIS 980
1T/13H OBSERVATION,5X,29HLARGEST DISCRIMINANT FUNCTION,8X,12HFUNCTMDIS 990
2ION NO.) MDIS1000
14 FORMAT(1H ,I7,20X,F8.5,20X,I6) MDIS1010
C MDIS1020
C ..................................................................MDIS1030
C MDIS1040
C READ PROBLEM PARAMETER CARD MDIS1050
C MDIS1060
100 READ (5,1,END=999) PR,PR1,K,M,(N(I),I=1,K) MDIS1070
C PR.......PROBLEM NUMBER (MAY BE ALPHAMERIC) MDIS1080
C PR1......PROBLEM NUMBER (CONTINUED) MDIS1090
C K........NUMBER OF GROUPS MDIS1100
C M........NUMBER OF VARIABLES MDIS1110
C N........VECTOR OF LENGTH K CONTAINING SAMPLE SIZES MDIS1120
C MDIS1130
WRITE (6,2) PR,PR1,K,M MDIS1140
DO 110 I=1,K MDIS1150
110 WRITE (6,3) I,N(I) MDIS1160
WRITE (6,4) MDIS1170
C MDIS1180
C READ DATA MDIS1190
C MDIS1200
L=0 MDIS1210
DO 130 I=1,K MDIS1220
N1=N(I) MDIS1230
DO 120 J=1,N1 MDIS1240
READ (5,5) (CMEAN(IJ),IJ=1,M) MDIS1250
L=L+1 MDIS1260
N2=L-N1 MDIS1270
DO 120 IJ=1,M MDIS1280
N2=N2+N1 MDIS1290
120 X(N2)=CMEAN(IJ) MDIS1300
130 L=N2 MDIS1310
C MDIS1320
CALL DMATX (K,M,N,X,XBAR,D,CMEAN) MDIS1330
C MDIS1340
C PRINT MEANS AND POOLED DISPERSION MATRIX MDIS1350
C MDIS1360
L=0 MDIS1370
DO 150 I=1,K MDIS1380
DO 140 J=1,M MDIS1390
L=L+1 MDIS1400
140 CMEAN(J)=XBAR(L) MDIS1410
150 WRITE (6,6) I,(CMEAN(J),J=1,M) MDIS1420
WRITE (6,7) MDIS1430
DO 170 I=1,M MDIS1440
L=I-M MDIS1450
DO 160 J=1,M MDIS1460
L=L+M MDIS1470
160 CMEAN(J)=D(L) MDIS1480
170 WRITE (6,8) I,(CMEAN(J),J=1,M) MDIS1490
C MDIS1500
CALL MINV (D,M,DET,CMEAN,C) MDIS1510
C MDIS1520
CALL DISCR (K,M,N,X,XBAR,D,CMEAN,V,C,P,LG) MDIS1530
C MDIS1540
C PRINT COMMON MEANS MDIS1550
C MDIS1560
WRITE (6,9) (CMEAN(I),I=1,M) MDIS1570
C MDIS1580
C PRINT GENERALIZED MAHALANOBIS D-SQUARE MDIS1590
C MDIS1600
WRITE (6,10) V MDIS1610
C MDIS1620
C PRINT CONSTANTS AND COEFFICIENTS OF DISCRIMINANT FUNCTIONS MDIS1630
C MDIS1640
N1=1 MDIS1650
N2=M+1 MDIS1660
DO 180 I=1,K MDIS1670
WRITE (6,11) I,(C(J),J=N1,N2) MDIS1680
N1=N1+(M+1) MDIS1690
180 N2=N2+(M+1) MDIS1700
C MDIS1710
C PRINT EVALUATION OF CALSSIFICATION FUNCTIONS FOR EACH OBSERVATION MDIS1720
C MDIS1730
WRITE (6,12) MDIS1740
N1=1 MDIS1750
N2=N(1) MDIS1760
DO 210 I=1,K MDIS1770
WRITE (6,13) I MDIS1780
L=0 MDIS1790
DO 190 J=N1,N2 MDIS1800
L=L+1 MDIS1810
190 WRITE (6,14) L,P(J),LG(J) MDIS1820
IF(I-K) 200, 100, 100 MDIS1830
200 N1=N1+N(I) MDIS1840
N2=N2+N(I+1) MDIS1850
210 CONTINUE MDIS1860
999 STOP
END MDIS1870
$DECK MDI.CDR
SAMPLE040600008000070000700008 20
3 10 9 8 24 8 30
4 12 3 8 22 7 40
9 3 2 8 9 8 50
16 2 2 2 7 2 60
5 10 5 8 23 9 70
17 3 2 8 6 3 80
2 10 9 8 29 16 90
7 10 5 8 28 18 100
9 10 27 8 28 16 110
11 7 8 9 8 15 120
8 10 2 8 27 16 130
1 6 8 14 14 13 140
7 8 9 6 18 2 150
7 9 8 2 19 9 160
7 10 5 8 27 17 170
3 11 9 15 20 10 180
9 4 10 7 9 9 190
4 13 10 7 21 15 200
8 5 16 16 16 7 210
6 9 10 5 23 11 220
8 10 5 8 27 16 230
17 3 2 7 6 3 240
3 10 8 8 23 8 250
4 12 3 8 23 7 260
9 3 2 8 21 7 270
15 2 2 2 7 2 280
9 10 26 8 27 16 290
8 9 2 8 26 16 300
7 8 6 9 18 2 310
7 10 5 8 26 16 320
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR MDI
.EXECUTE/REL MDISC,WES:SSP/LIB
%FIN::
.DELETE MDI.CDR