1  ! PROGRAM DFQS, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM DFQS IS ONE OF THE PROGRAMS FOR DISCRIMINANT ANALYSIS
   ! 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
100 OPEN "DAT1"+FNZ$ AS FILE 1
115 OPEN "DISC2"+FNZ$ AS FILE 2
130 OPEN "DISC1"+FNZ$ AS FILE 3
145 DIM#1,X(200,50),H$(30)=2,C(50,50),M4(0),M5(0),M9(0),N(0),J9(0),
          I4(0),I7(0),N6(0),X2(50),L1$(8)=32%
160 DIM#2,N2(50),M2(50),T9(0),L6(0),G9(0),L1(0)
175 DIM#3,R(50,50),X3(50,50),F9(50),S(50)
180 R(I%,J%)=0 FOR J%=1% TO 50% FOR I%=1% TO 50%
190 G9=G9(0):L6=L6(0):T9=T9(0)
205 DEF FNR(Q):INPUT Z$:Q=INSTR(1,Z$,"SOS"):IF Q>0 THEN 235 
220 Q=VAL(Z$):GOTO 250 
235 LET Q=808
250 FNR=Q:FNEND
265 FOR I=1 TO G9:FOR J=1 TO L6:X3(I,J)=0:NEXT J:NEXT I:K=0
280 FOR I=1 TO G9:H=N2(I):FOR J=1 TO H:K=K+1:FOR K2=1 TO L6:L=M2(K2)
295 X3(I,K2)=X3(I,K2)+X(K,L):NEXT K2:NEXT J:FOR K2=1 TO L6:X3(I,K2)=
X3(I,K2)/N2(I):NEXT K2:PRINT
310 PRINT"GROUP "I" MEANS"
325 PRINT USING"########.###",X3(I,K2);FOR K2=1 TO L6
340 PRINT:NEXT I:FOR I=1 TO L6:FOR J=1 TO L6:R(I,J)=0:NEXTJ:NEXT I
355 K=0:FOR I=1 TO G9:H=N2(I):FOR J=1 TO H:K=K+1:FOR K2=1 TO L6
370 L=M2(K2):S(K2)=X(K,L)-X3(I,K2):NEXT K2:FOR K1=1 TO L6:FOR K2=K1
TO L6:R(K1,K2)=R(K1,K2)+S(K1)*S(K2):NEXT K2:NEXT K1:NEXT J:NEXT I
385 L=0:FOR I=1 TO G9:L=L+N2(I):NEXT I:S2=L-G9
400 PRINT:PRINT"POOLED DISPERSION MATRIX."
415 FOR I=1 TO L6:FOR J=I TO L6:R(I,J)=R(I,J)/S2:R(J,I)=R(I,J):NEXT J:
K=M2(I)
430 PRINT:PRINT"ROW "I
445 PRINT USING"#####.######",R(I,J);FOR J=1 TO L6
460 PRINT : NEXT I
470 L1(0)=L : S$=" DFQS   0490":K$=SYS(CHR$(8)+S$)
475 CLOSE 1,2,3
480 CHAIN"INVE"
490  OPEN "DAT1"+FNZ$ AS FILE 1
500 OPEN "DISC2"+FNZ$ AS FILE 2
510 OPEN "DISC1"+FNZ$AS FILE 3
520 L6=L6(0):G9=G9(0):S2=L1(0):FOR I=1 TO L6:S(I)=0:FOR J=1 TO G9:
S(I)=S(I)+N2(J)*X3(J,I):NEXT J:S(I)=S(I)/S2:NEXT I
535 PRINT:PRINT"COMMON MEANS."
550 PRINT USING"#####.#####",S(I);FOR I=1 TO L6
565 PRINT:F4=L6*(G9-1)
580 PRINT:PRINT"DO YOU WISH TO COMPUTE THE GENERALIZED MAHALANOBIS "
    "D-SQUARE";
595 INPUT N$:IF N$="YES" THEN 670 ELSE IF N$<>"SOS" THEN 700 
610 PRINT:PRINT"THIS STATISTIC CAN BE USED AS A CHI-SQUARE WITH"
625 PRINTF4 "DEGREES OF FREEDOM,  TO TEST THE HYPOTHESIS THAT THE"
640 PRINT"MEAN VALUES ARE THE SAME IN THE "G9" GROUPS FOR THE "L6" VARIABLES"
655 GOTO 580 
670 V=0:FOR I=1 TO L6:FOR J=1 TO L6:S2=0:FOR K=1 TO G9:S2=S2
+N2(K)*(X3(K,I)-S(I))*(X3(K,J)-S(J)):NEXT K:V=V+R(I,J)*S2:NEXT J:NEXTI
685 PRINT:PRINT"GENERALIZED MAHALANOBIS D-SQUARE "V"  (D.F.= "F4")"
700 PRINT:PRINT"DISCRIMINANT FUNCTIONS"
715 FOR I=1 TO G9:S2=0:FOR J=1 TO L6:FOR K=1 TO L6:S2=S2+R(J,K)
*X3(I,J)*X3(I,K):NEXT K:NEXT J:S(I)=-S2/2:FOR J=1 TO L6
730 F9(J)=0:FOR K=1 TO L6:F9(J)=F9(J)+R(J,K)*X3(I,K):NEXT K:NEXT J
745 FOR J=1 TO L6:X3(I,J)=F9(J):NEXT J:PRINT
760 LET F1$="########.###   ######.####  ######.####  ######.####"
775 PRINT USING"###"I;:PRINT"  CONSTANT";:PRINTUSING"######.###"S(I)
790 PRINT 
805 PRINT TAB(5);"COEFFICIENTS":PRINTUSINGF1$,X3(I,J)FOR J=1 TO L6
895 PRINT:NEXT I:CLOSE 1,2,3:S$=" DISC   0775":K$=SYS(CHR$(8)+S$)
910 CHAIN "DFQSD1"
925 END