File: MDISC.FT of Tape: Various/ETH/eth11-1

(Source file text) 

---

C	SAMPLE PROGRAM FOR DISCRIMINANT ANALYSIS - MDISC
C  USES THE FOLLOWING ROUTINES: DMATX,MINV,DISCR
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	NUMBER OF GROUPS, K.
	DIMENSION N(4)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	NUMBER OF VARIABLES, M.
	DIMENSION CMEAN(6)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF M*K.
	DIMENSION XBAR(24)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF (M+1)*K.
	DIMENSION C(28)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF M*M.
	DIMENSION D(36)
C	THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE
C	TOTAL OF SAMPLE SIZES OF K GROUPS COMBINED, T WHERE
C		T = N(1)+N(2)+...+N(K)
	DIMENSION P(30),LG(30)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	TOTAL DATA POINTS WHICH IS EQUAL TO THE PRODUCT OF T*M.
	DIMENSION X(180)
C	.....................................................
1	FORMAT(A4,A2,2I2,12I5/(14I5))
2	FORMAT(//' DISCRIMINANT ANALYSIS...'A4,A2/'   NUMBER OF GROUPS'
	1 7X,I3/'   NUMBER OF VARIABLES'I7/'   SAMPLE SIZES..'/
	2 12X,'GROUP')
3	FORMAT(12X,I3,8X,I4)
4	FORMAT(//2X)
5	FORMAT(12F6.0)
6	FORMAT(/' GROUP',I3,'  MEANS'/(6F13.5))
7	FORMAT(//' POOLED DISPERSION MATRIX')
8	FORMAT(/' ROW',I3/(6F13.5))
9	FORMAT(//' COMMON MEANS'/(6F13.5))
10	FORMAT(//' GENERALIZED MAHALANOBIS D-SQUARE',F15.5/)
11	FORMAT(/' DISCRIMINANT FUNCTION',I3//6X,'CONSTANT   *   
	1COEFFICIENTS'//F13.5,'  *  '4F13.5/(18X,4F13.5))
12	FORMAT(//' EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH
	1 OBSERVATION')
13	FORMAT(/' GROUP',I3/19X'PROBABILITY ASSOCIATED WITH'11X,
	1'LARGEST'/' OBSERVATION'6X'LARGEST DISCRIMINANT FUNCTION'8X
	2'FUNCTION NO.')
14	FORMAT(I7,20X,F8.5,20X,I6)
C......................................................
C
C	OUTPUT CHANNEL = IOUT, INPUT CHANNEL = IN
	IOUT=2
	IN=1
C	READ PROBLEM PARAMETER CARD
100	READ(IN,1) PR,PR1,K,M,(N(I),I=1,K)
C	PR=PROBLEM NUMBER (MAY BE ALPHAMERIC)
C	PR1=PROBLEM NUMBER CONTINUED
C	K=NUMBER OF GROUPS
C	M=NUMBER OF VARIABLES
C	N=VECTOR OF LENGTH K CONTAINING SAMPLE SIZES
	IF(K.EQ.0) STOP
	WRITE(IOUT,2) PR,PR1,K,M
	DO 110 I=1,K
110	WRITE(IOUT,3) I,N(I)
	WRITE(IOUT,4)
C	READ DATA
	L=0
	DO 130 I=1,K
	N1=N(I)
	DO 120 J=1,N1
	READ(IN,5) (CMEAN(IJ),IJ=1,M)
	L=L+1
	N2=L-N1
	DO 120 IJ=1,M
	N2=N2+N1
120	X(N2)=CMEAN(IJ)
130	L=N2
	CALL DMATX(K,M,N,X,XBAR,D,CMEAN)
C	PRINT MEANS AND POOLED DISPERSION MATRIX
	L=0
	DO 150 I=1,K
	DO 140 J=1,M
	L=L+1
140	CMEAN(J)=XBAR(L)
150	WRITE(IOUT,6) I,(CMEAN(J),J=1,M)
	WRITE(IOUT,7)
	DO 170 I=1,M
	L=I-M
	DO 160 J=1,M
	L=L+M
160	CMEAN(J)=D(L)
170	WRITE(IOUT,8) I,(CMEAN(J),J=1,M)
	CALL MINV(D,M,DET,CMEAN,C)
	CALL DISCR(K,M,N,X,XBAR,D,CMEAN,V,C,P,LG)
C	PRINT COMMON MEANS
	WRITE(IOUT,9) (CMEAN(I),I=1,M)
C	PRINT GENERALIZED MAHALANOBIS D-SQUARE
	WRITE(IOUT,10) V
C	PRINT CONSTANTS AND COEFFICIENTS OF DISCRIMINANT FUNCTIONS
	N1=1
	N2=M+1
	DO 180 I=1,K
	WRITE(IOUT,11) I,(C(J),J=N1,N2)
	N1=N1+(M+1)
180	N2=N2+(M+1)
C	PRINT EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH
C	OBSERVATION
	WRITE(IOUT,12)
	N1=1
	N2=N(1)
	DO 210 I=1,K
	WRITE(IOUT,13) I
	L=0
	DO 190 J=N1,N2
	L=L+1
190	WRITE(IOUT,14) L,P(J),LG(J)
	IF(I-K) 200,100,100
200	N1=N1+N(I)
	N2=N2+N(I+1)
210	CONTINUE
	STOP
	END

---