1  ! PROGRAM FQSC, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM FQSC IS A PROGRAM IN THE CANONICAL CORRELATION CHAIN.
   ! 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 WILL 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
70 !****FQSC
85 OPEN "DAT1"+FNZ$ AS FILE 1
100 OPEN"DISC2"+FNZ$ ASFILE2
115 OPEN "DISC1"+FNZ$ ASFILE 3
130 OPEN"TMP"+FNZ$ AS FILE 4
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)
190 DIM#4,A(50,50),B(50,50)
205 DEF FNR(Q):INPUT Z$:Q=INSTR(1,Z$,"SOS"):IF Q>0 THEN 235 
220 Q=VAL(Z$):GOTO 250 
235 Q=808
250 FNR=Q:FNEND
340 L6=L6(0): S6=T9(0)
355 T6=L6+S6
370 FOR I=1 TO L6:FOR J=1 TO S6: L=L6+J: S2=0:FOR K=1 TO L6
385 S2=S2+R(I,K)*R(K,L):NEXT K: B(I,J)=S2:NEXT J:NEXT I
400 FOR I=1 TO S6: L=L6+I:FOR J=1 TO S6: M=S6+J:S2=0
415 FOR K=1 TO L6: S2=S2+R(L,K)*B(K,J):NEXT K: R(I,M)=S2
430 NEXT J: NEXT I
445 FOR I=1 TO S6: L=L6+I:FOR J=1 TO S6: M=L6+J:R(I,J)=R(L,M)
460 NEXT J:NEXT I: G9(0)=L6: L6(0)=S6
475 S$=" FQSC   0505": K$=SYS(CHR$(8)+S$)
490 CHAIN "FQRT"
505 OPEN "DAT1"+FNZ$ AS FILE 1
520 OPEN "DISC2"+FNZ$ AS FILE 2
535 OPEN "DISC1"+FNZ$ AS FILE 3
550 OPEN "TMP"+FNZ$ AS FILE 4
565 S6=T9(0): L6=L6(0)
580 FOR J=1 TO S6:S2=1/SQR(F9(J)):FOR I= 1TO S6: R(I,J)=R(I,J)*S2
595 NEXT I:NEXT J:FOR I=1 TO S6: L=S6+I:FOR J=1 TO S6: M=S6+J
610 S2=0 :FOR K=1 TO S6: S2=S2+R(K,I)*R(K,M):NEXT K: R(L,J)=S2
625 NEXT J: NEXT I:FOR J=1 TO S6:FOR I=1 TO S6: L=S6+I: F9(I)=0
640 FOR K=1 TO S6: F9(I)=F9(I)+R(L,K)*R(K,J):NEXT K:NEXT I
655 M=S6+J:FOR I=1 TO S6: R(I,M)=R(I,J): R(I,J)=F9(I)
670 NEXT I:NEXT J: S$=" FQSC   0715": K$=SYS(CHR$(8)+S$)
685 CLOSE 1,2,3,4
700 CHAIN "FQRT"
715 OPEN "DAT1"+FNZ$ AS FILE 1:OPEN "DISC2"+FNZ$ AS FILE 2
730 OPEN "DISC1"+FNZ$ AS FILE3
745 OPEN "TMP"+FNZ$ AS FILE 4: S6=T9(0): L6=G9(0)
760 FOR J=1 TO S6:FOR I=1 TO S6: S(I)=0:FOR K=1 TO S6
775 L=S6+K: S(I)=S(I)+R(I,L)*R(K,J):NEXT K: NEXT I
790 FOR I=1 TO S6: R(I,J)=S(I):NEXT I:NEXT J:FOR J=1 TO S6
805 S2=0:FOR I=1 TO S6: S2=S2+R(I,J)*R(I,J):NEXT I: S2=SQR(S2)
820 FOR I=1 TO S6: R(I,J)=R(I,J)/S2:NEXT I:NEXT J:FOR I=1 TO S6
835 IF F9(I)>=1 THEN 865 
850 IF F9(I)>0 THEN 895 
865 PRINT:PRINT"DUE TO YOUR DATA CANONICAL CORRELATION CANNOT BE COMPUTED ACCURATELY"
880 PRINT"CHECK THE CORRELATION MATRIX":GOTO 1300 
895 NEXT I
910 PRINT
925 PRINT "NUMBER OF  LARGE     CORRESPONDING               DEGREES"
940 PRINT "EIGENVAL.  EIGENVAL. CANONICAL                   OF"
955 PRINT "REMOVED    REMAINING CORRELATIONS  LAMBDA CHISQ. FREEDOM"
970 FOR I=1 TO S6: C1=SQR(F9(I)): W7=1 :FOR J=1 TO S6
985 W7=W7*(1-F9(J)):NEXT J: C6=-(N(0)-.5*(L6+S6+1))*LOG(W7)
1000 L=I-1: F4=(L6-L)*(S6-L)
1015 F2$=" #####     ####.####  #####.#####  ####.## ###.##  ####.###"
1045 PRINT USING F2$,L,F9(I),C1,W7,C6,F4
1060 PRINT
1075 F9(I)=C1:NEXT I
1090 PRINT:PRINT"HOW MANY SETS OF LEFT AND RIGHT HAND CANONICAL COEFFICIENTS DO YOU"
1105 PRINT"WISH TO PRINT";: Q3=FNR(Q):IF Q3<>N6(0) THEN 1165 
1120 PRINT:PRINT"IF YOU GIVE A NUMBER ,LEFT AND RIGHT HAND COEFFICIENTS CORRESPONDING"
1135 PRINT"TO EACH CANONICAL CORRELATION WILL BE PRINTED. THE MAXIMUM IS"S6
1150 PRINT"IF NONE ARE DESIRED SPECIFY 0.":GOTO 1090 
1165 IF Q3<=0 THEN 1300 ELSE IF S6>=Q3 THEN 1180 ELSE Q3=S6
1180 L=S6+1:FOR I=1 TO Q3:PRINT:PRINT"CANONICAL CORRELATION"F9(I)
1195 FOR J=1 TO L6: S2=0 :FOR K=1 TO S6: S2=S2+B(J,K)*R(K,I)
1210 NEXT K: R(J,L)=S2/F9(I):NEXT J:PRINT
1225 PRINT"COEFFICIENTS FOR LEFT HAND VARIABLES"
1240 PRINTUSING"####.#####",R(J,L);FOR L=1 TO L6:PRINT
1255 PRINT"COEFFICIENTS FOR RIGHT HAND VARIABLES"
1270 PRINTUSING"####.#####",R(K,I);FOR K=1 TO S6:PRINT
1285 NEXT I
1300 S$=" CANO   0955": K$=SYS(CHR$(8)+S$)
1315 CLOSE 1,2,3
1330 KILL"TMP"+FNZ$
1345 CHAIN "CANO" 0955
1360 END