1  ! PROGRAM FQMX, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM FQMX IS A PROGRAM IN THE FACTOR ANALYSIS CHAIN.
   ! IT IS ONE OF THE SEVERAL PROGRAMS AND FILES THAT 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
70 !****FQMX
85 OPEN "DAT1"+FNZ$ AS FILE 1
100 OPEN "DISC2"+FNZ$ AS FILE2
115 OPEN "DISC1"+FNZ$ AS FILE 3
130 OPEN "TMP"+FNZ$ AS FILE 4
135 OPEN L1$(1%) AS FILE 5%
145 DIM#1,X(200,50),H$(30)=2,C(50,50),M4(0),M5(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,A(50,50),X3(50,50),F9(50),S(50)
190 DIM#4,R(50,50),B(50,50)
195 DIM #5%,N$(50%)=8%
205 L6=L6(0):S6=T9(0)
220 PRINT:PRINT"ITERATIONS     VARIANCES"
235 E9=.00116:T3=0:LET L2=S6-1:V9,N3=0
250 F6=L6^2:O3=.7071066
265 FOR I=1 TO L6:F9(I)=0:FOR J=1 TO S6:F9(I)=F9(I)+A(I,J)*A(I,J)
280 NEXT J:NEXT I
295 FOR I=1 TO L6:A2=SQR(F9(I)):FOR J=1 TO S6
310 A(I,J)=A(I,J)/A2:NEXT J:NEXT I
325 GOTO 370 
340 V9=V9+1
355 T3=T7
370 T7=0:FOR J=1 TO S6:A2,B2=0:FOR I=1 TO L6:C2=A(I,J)*A(I,J)
385 A2=A2+C2:B2=B2+C2^2:NEXT I
400 T7=T7+(L6*B2-A2^2)/F6:NEXT J
415 PRINTUSING"######  #######.#####",V9,T7
430 IF V9>=50 THEN 820 
445 IF T7-T3>1.0E-7 THEN 490 
460 N3=N3+1:IF N3<2 THEN 490 
475 PRINT:PRINT"NO MORE IMPROVEMENT IN VARIANCE":GOTO 820 
490 FOR J=1 TO L2:I2=J+1:FOR K1=I2 TO S6:A2,B2,C2,D2=0
505 FOR I=1 TO L6:U=(A(I,J)+A(I,K1))*(A(I,J)-A(I,K1))
520 G=A(I,J)*A(I,K1)*2:C2=C2+(U+G)*(U-G)
535 D2=D2+2*U*G:A2=A2+U:B2=B2+G:NEXT I
550 G=D2-2*A2*B2/L6:B=C2-(A2^2-B2^2)/L6
565 IF G<B THEN 595 ELSE IF G>B THEN 655 ELSE IF G+B<E9 THEN 790 
580 C4,S4=O3:GOTO 700 
595 T4=ABS(G)/ABS(B):IF T4<E9 THEN 640 
610 C4=1/SQR(1+T4^2)
625 S4=T4*C4:GOTO 700 
640 IF B>=0 THEN 790 ELSE S9,C9=O3:GOTO 760 
655 C1=ABS(G/B):IF C1<E9 THEN 685 
670 S4=1/SQR(1+C1^2):C4=C1*S4:GOTO 700 
685 C4,S4=0
700 C3=SQR((1+C4)/2):S3=S4/(2*C3):C=SQR((1+C3)/2):S=S3/(2*C)
715 IF B<=0 THEN 730 ELSE P3=C:P6=S:GOTO 745 
730 P3=O3*(C+S):P6=ABS(O3*(C-S))
745 IF G>0 THEN 760 ELSE P6=-P6
760 FOR I=1 TO L6:A2=A(I,J)*P3+A(I,K1)*P6
775 A(I,K1)=-A(I,J)*P6+A(I,K1)*P3:A(I,J)=A2:NEXT I
790 NEXT K1
805 NEXT J:GOTO 340 
820 FOR I=1 TO L6 : A2=SQR(F9(I)) : FOR J=1 TO S6 : A(I,J)=A(I,J)*A2
835 NEXT J:NEXT I:PRINT
850 PRINT"ROTATED FACTOR MATRIX  ("S6" FACTORS)"
865 FOR I=1 TO L6 : L=N2(I) : PRINT : PRINT "VARIABLE "N$(L)
880 PRINTUSING"####.####",A(I,J);FOR J=1 TO S6:PRINT:NEXT I
895 PRINT:PRINT"DO YOU WISH TO PRINT THE ORIGINAL AND FINAL COMMUNTALITIES";
910 INPUT N$:IF N$="YES" THEN 955 ELSE IF N$<>"SOS" THEN 1045 
925 PRINT:PRINT"ANSWER 'YES' IF YOU WANT TO PRINT THE PROPORTION OF VARIANCE"
940 GOTO 895 
955 PRINT
970 PRINT"VARIABLE    ORIGINAL       FINAL     DIFFERENCE"
985 F$=            "#####.####   #####.####    #####.####"
1000 FOR I=1 TO L6:A2=0 :FOR J=1 TO S6:A2=A2+A(I,J)*A(I,J)
1015 NEXT J:B2=F9(I)-A2:L=N2(I)
1030 PRINT N$(L);SPACE$(9%-LEN(N$(L))); :PRINTUSINGF$,F9(I),A2,B2:NEXT I
1045 CLOSE 1,2,3,4:K$=SYS(CHR$(7))
1060 N$=LEFT(K$,8):S0=VAL(RIGHT(K$,9))
1075 CHAIN N$  S0
1090 END