1  ! PROGRAM FQCU, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM FQCU IS AN ELEMENT IN THE FACTOR ANALYSIS 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 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 !****FQCU
85 OPEN "DAT1"+FNZ$ AS FILE 1
100 OPEN "DISC2"+FNZ$ AS FILE 2
115 OPEN "DISC1"+FNZ$ AS FILE 3
130 OPEN "TMP"+FNZ$ AS FILE 4
135 OPEN L1$(1%) FOR INPUT AS FILE 5%
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,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%,M1$(50%)=64%,O%(50%),P%(50%),D$(50%)=8%,
        T(50%),D(10000%)
205 DEF FNR(Q)
220 INPUT Z$
235 Q=INSTR(1,Z$,"SOS")
250 IF Q>0 THEN 295 
265 Q=VAL(Z$)
280 GOTO 310 
295 Q=808
310 FNR=Q
325 FNEND
340 L6=M9(0):FOR I=1 TO M9(0):N2(I)=I:NEXT I
355 PRINT:PRINT"DO YOU WISH TO DELETE ANY VARIABLES";:INPUT N$
370 IF N$="YES" THEN 430 ELSE IF N$<>"SOS" THEN 625 
385 PRINT:PRINT"IF YOU DO NOT WISH TO ENTER CERTAIN VARIABLES IN THE FACTOR ANALYSIS"
400 PRINT"YOU CAN STOP THEM FROM ENTERING IN THE PRESENT ANALYSIS"
415 PRINT"THEY ARE STILL AVAILABLE FOR LATER ANALYSES":GOTO 355 
430 PRINT:PRINT"HOW MANY VARIABLES DO YOU WISH TO DELETE";:N4=FNR(Q)
445 IF N4<>N6(0) THEN 475 
460 PRINT:PRINT"IF YOU DO NOT WISH TO DELETE ANY TYPE 0":GOTO 430 
475 IF N4<=0 THEN 625 
490 PRINT:PRINT"SPECIFY THESE "N4" VARIABLES   *" :
     B3(I)=FNC%("VAR. "+NUM$(I)) FOR I=1 TO N4
505 FOR I=1 TO N4:L=B3(I):N2(L)=0:NEXT I
520 L=0
535 FOR I=1 TO M9(0):IF N2(I)<=0 THEN 565 
550 L=L+1:N2(L)=N2(I)
565 NEXTI
580 L6=M9(0)-N4
595 FOR J=1 TO L6:L2=N2(J)
610 FOR I=1 TO L6:L1=N2(I):A(I,J)=A(L1,L2):NEXT I:NEXT J
625 PRINT:PRINT"DO YOU WISH TO ESTIMATE COMMUNTALITES";:INPUT N$
640 IF N$="YES" THEN 700 ELSE IF N$<>"SOS" THEN 1285 
655 PRINT:PRINT"ANSWER 'YES' IF YOU WISH TO ESTIMATE COMMUNTALITEIS"
670 PRINT"IN THE PRINCIPAL DIAGONAL OF THE CORRELATION MATRIX"
685 GOTO 625 
700 PRINT:PRINT"THE FOLLOWING OPTIONS ARE AVAILABLE"
715 PRINT"		1-UNITY IN THE PRINCIPAL DIAGONAL"
730 PRINT"		2-SQUARED MULTIPLE CORRELATION COEFFICIENT"
745 PRINT"		3-MAXIMUM ABSOLUTE ROW VALUE IN DIAGONAL"
760 PRINT"		4-IF YOU WISH TO SUPPLY THE ESTIMATE YOURSELF"
775 PRINT:PRINT"SPECIFY THE DESIRED OP. CODE":P9=FNR(Q)
790 IF P9<>N6(0) THEN 835 
805 PRINT:PRINT"IF YOU DO NOT WISH TO SPECIFY COMMUNTALITIES TYPE 0"
820 GOTO 775 
835 IF P9<=0 THEN 1285 ELSE IF P9<=4 THEN 865 
850 PRINT:PRINT"INVALID ENTRY--TRY AGAIN.":GOTO 775 
865 ON P9 GOTO 880 , 895 , 1075 , 1180 
880 FOR I=1 TO L6:A(I,I)=1:NEXT I:GOTO 1285 
895 L=0
910 FOR I=1 TO L6:FOR J=1 TO L6:IF I=J THEN 940 
925 IF A(I,J)>.99 THEN 940 ELSE L=2
940 R(I,J)=A(I,J):NEXT J:NEXT I
955 IF L<=0 THEN 1000 
970 PRINT:PRINT"SOME VARIABLES ARE TOO HIGHLY CORRELATED.THIS OPTION CANNOT BE USED"
985 GOTO 775 
990 L6(0)=L6
1000 S$=" FQCU   1040":K$=SYS(CHR$(8)+S$):CLOSE1,2,3,4,5:CHAIN "INVE"
1040 OPEN "DAT1"+FNZ$AS FILE 1:OPEN "DISC2"+FNZ$ AS FILE 2
1045 OPEN "DISC1"+FNZ$ AS FILE 3:OPEN "TMP"+FNZ$ AS FILE 4
1050 OPEN L1$(1%)FORINPUTASFILE5%
1055 L6=L6(0)
1060 FOR I=1 TO L6:R(I,I)=1-(1/A(I,I)):NEXT I 
1070 FOR J%=1% TO L6 : A(I%,J%)=R(I%,J%) FOR I%=1% TO L6 : NEXT J%
1071 GOTO 1285
1075 FOR I=1 TO L6:B6=0
1090 FOR J=1 TO L6:IF I=J THEN 1135 
1105 IF B6>=ABS(A(I,J)) THEN 1135 
1120 B6=ABS(A(I,J))
1135 NEXT J
1150 A(I,I)=B6
1165 NEXT I:GOTO 1285 
1180 PRINT:PRINT"SUPPLY "L6" ESTIMATES OF COMMUNTALITIES  *";
1195 INPUT A(J,J) FOR J= 1 TO L6
1210 PRINT:PRINT"DID YOU SUPPLY THEM CORRECTLY";:INPUT N$
1225 IF N$="YES" THEN 1285 ELSE IF N$<>"SOS" THEN 1270 
1240 PRINT:PRINT"IF YOU WISH TO CORRECT A MISTAKE ANSWER 'NO'"
1255 GOTO 1210 
1270 PRINT:PRINT"TRY AGAIN ":GOTO 1180 
1285 L6(0)=L6:CLOSE 1,2,3,4,5% :S$=" FACO   0550":K$=SYS(CHR$(8)+S$)
1300 CHAIN "FACO"   0550
30000 DEF FNC%(X$)
      ! FUNCTION  TO TRANSLATE VARIABLE NAMES
30010 PRINT X$; UNLESS X$="" : INPUT V$ : IF V$="" THEN PRINT :
      PRINT "VARIABLE NAME NEEDED "; : GOTO 30010
30020 GOTO 30040 IF V$=N$(I%) FOR I%=1% TO O%(0%)
30025 IF LEFT(V$,3%)="SOS" THEN FNC%=808 : GOTO 30050
30027 IF ASCII(V$)=48% THEN FNC%=0% : GOTO 30050
30030 PRINT "*NO SUCH VARIABLE*  TRY AGAIN." : GOTO 30010
30040 FNC%=I%
30050 FNEND
32767 END