800 PRINT CHR$(27)+"E"+CHR$(27)+"H"
900 PRINT," NONPARAMETRIC FACTOR ANALYSIS PROGRAM":PRINT:PRINT:PRINT
1000 PRINT "DO YOU WISH TO GIVE THIS ANALYSIS A NAME?" 1010 PRINT:INPUT
"TYPE 'YES' OR 'NO' ";A13$ 1020 IF (A13$ = "YES" OR A13$ = "yes") THEN 1030
ELSE 1050 1030 PRINT:PRINT:INPUT "TYPE IN THE NAME YOU DESIRE ";A14$ 1040
GOTO 1060
1050 A14$ = ""
1060 PRINT
1065 PRINT
1070 DIM R%(25,25), A%(25,25), B%(25,25), D%(25,25), F%(25), G%(25), H%(25)
1080 DIM J%(4), C%(25), S%(1,25), M%(25,25), K%(25,1), N%(25), T%(1,25)
1090 DIM P(25),K$(25)
1100 INPUT "HOW MANY ELEMENTS (COLUMNS) HAVE YOU";J 1110 PRINT
1120 INPUT "HOW MANY VARIABLES (ROWS) HAVE YOU";I 1130 PRINT
1140 PRINT "INPUT DATA,ROW BY ROW,AS FOLLOWS:" 1150 PRINT "TYPE '0' FOR A VOID"
1160 PRINT "TYPE '1' FOR AN INCIDENT"
1170 PRINT
1180 FOR R = 1 TO I
1190 FOR C = 1 TO J
1200 PRINT "ROW ";R;": COLUMN ";C;
1210 INPUT "INCIDENT OR VOID";R%(R,C)
1220 NEXT C
1230 NEXT R
1240 PRINT
1245 PRINT
1250 PRINT TAB(14);"COLUMN NUMBER"
1260 IF J < 10 THEN 1270 ELSE 1290
1270 T19 = (J*4)-3
1280 GOTO 1300
1290 T19 = (J*4)-2
1300 FOR K19 = 1 TO T19
1310 IF K19 = 1 THEN 1320 ELSE 1340
1320 PRINT TAB(14);"_";
1330 GOTO 1350
1340 PRINT"_";
1350 NEXT K19
1360 PRINT
1370 FOR X = 1 TO J
1380 B7 = (4*X)+10
1390 PRINT TAB(B7);X;
1400 NEXT X
1410 PRINT
1420 FOR K19 = 1 TO T19
1430 IF K19 = 1 THEN 1440 ELSE 1460
1440 PRINT TAB(14);"_";
1450 GOTO 1470
1460 PRINT"_";
1470 NEXT K19
1480 PRINT
1485 PRINT
1490 FOR R = 1 TO I
1500 FOR C = 1 TO J
1510 B7 = (4*C)+10
1520 IF (C = 1 AND R < 10) THEN 1530 ELSE 1550 1530 PRINT"ROW ";R": ";
1540 GOTO 1580
1550 IF (C = 1 AND R >=10) THEN 1560 ELSE 1580 1560 PRINT"ROW ";R": ";
1570 GOTO 1580
1580 PRINT TAB(B7);R%(R,C);
1590 NEXT C
1600 PRINT
1610 NEXT R
1620 PRINT
1630 INPUT "IS THIS CORRECT? TYPE 'YES' OR 'NO' ";A$ 1640 IF (A$ = "YES" OR
A$ = "yes" ) THEN 1710 ELSE 1650 1650 INPUT "IN WHICH ROW IS ERROR";P
1660 INPUT "IN WHICH COLUMN IS ERROR";Q
1670 PRINT
1680 PRINT "ROW ";P": COLUMN ";Q
1690 INPUT "INCIDENT OR VOID";R%(P,Q)
1700 GOTO 1240
1710 FOR R = 1 TO I
1715 FOR C = 1 TO J
1720 M%(R,C) = R%(R,C)
1725 NEXT C
1730 NEXT R
1740 FOR X = 1 TO J
1750 P(X) = 0
1760 NEXT X
1770 P(J) = EXP(-J*(LOG(2)))
1780 IF P(J) > 0.05 THEN 1790 ELSE 1810
1790 M = J
1800 GOTO 1930
1810 Q5 = 0
1820 FOR U = 1 TO 40
1830 P = J - U
1840 P1 = P + 1
1850 P(P) = (P1*P(P1))/(J - P)
1860 FOR X = J TO 1 STEP -1
1870 Q5 = Q5 + P(X)
1880 IF Q5 >0.05 THEN 1920 ELSE 1890
1890 NEXT X
1900 Q5 = 0
1910 NEXT U
1920 M = (J - U) + 1
1930 PRINT
1935 PRINT
1940 PRINT"THE PROBABILITY OF ";M" OR MORE MATCHINGS OF THE TRIAL" 1950
PRINT"SCANNING PATTERN WITH ANY ONE ROW OCCURRING BY CHANCE," 1960 PRINT"IS
LESS THAN ONE IN TWENTY. THERE IS A MAXIMUM OF ";J 1970 PRINT"SUCH
MATCHINGS. THIS PROBABILITY WAS COMPUTED USING" 1980 PRINT"THE BINOMIAL
DENSITY WITH PARAMETER p = 0.5" 1990 PRINT
1995 PRINT
2000 PRINT"FIDUCAL LIMIT IS THUS ";M
2020 F1 = 1
2030 IF F1 <> 1 THEN 2040 ELSE 2100
2040 FOR R = 1 TO I
2050 FOR C = 1 TO J
2060 IF R%(R,C) = 9 THEN 2090 ELSE 2070
2070 R%(R,C) = M%(R,C)
2080 NEXT C
2090 NEXT R
2100 FOR P3 = 1 TO 20
2110 LPRINT
2120 NEXT P3
2130 D13 = 0
2140 FOR R = 1 TO I
2150 IF R%(R,1) = 9 THEN 2160 ELSE 2170
2160 D13 = D13 + 1
2170 NEXT R
2180 IF I - D13 <= 1 THEN 2190 ELSE 2200 2190 GOTO 5330
2200 IF (A14$ <> "" AND F1 = 1) THEN 2210 ELSE 2240 2210 FOR A14 = 1 TO 3
2220 LPRINT "******** ANALYSIS NAME IS ";A14$;"********" 2230 NEXT A14
2240 GOSUB 6230
2250 LPRINT "******** FIDUCAL LIMIT FOR THIS ANALYSIS IS ";M;"********"
2260 GOSUB 6230
2270 LPRINT "******** FACTOR " ;F1;" IS NOW TO BE DERIVED ********" 2280 LPRINT
2285 LPRINT
2290 IF F1 <> 1 THEN 2300 ELSE 2340
2300 LPRINT "+++++ ALL VARIABLES (ROWS) REMOVED BY PREVIOUS FACTORS" 2310
LPRINT " ARE INDICATED BY '9' IN ALL FOLLOWING MATRICES+++++"
2320 LPRINT
2330 Z9 = 0
2340 T3 = 0
2350 FOR R = 1 TO I
2360 K%(R,1) = 0
2370 IF R%(R,1) <> 9 THEN 2380 ELSE 2390 2380 T3 = T3 + 1
2390 NEXT R
2400 IF T3 <=1 THEN 2410 ELSE 2420
2410 GOTO 5330
2420 LPRINT TAB(14);"COLUMN NUMBER"
2430 IF J < 10 THEN 2440 ELSE 2460
2440 T13 = (J*4)-3
2450 GOTO 2470
2460 T13 = (J*4)-2
2470 FOR K13 = 1 TO T13
2480 IF K13 = 1 THEN 2490 ELSE 2510
2490 LPRINT TAB(14);"_";
2500 GOTO 2520
2510 LPRINT "_";
2520 NEXT K13
2530 LPRINT
2540 FOR X = 1 TO J
2550 B8 = (4*X)+10
2560 LPRINT TAB(B8);X;
2570 NEXT X
2580 LPRINT
2590 FOR K13 = 1 TO T13
2600 IF K13 = 1 THEN 2610 ELSE 2630
2610 LPRINT TAB(14);"_";
2620 GOTO 2640
2630 LPRINT "_";
2640 NEXT K13
2650 LPRINT
2660 LPRINT
2670 FOR R = 1 TO I
2680 FOR C = 1 TO J
2690 B8 = (4*C)+10
2700 IF (C = 1 AND R < 10) THEN 2710 ELSE 2730 2710 LPRINT "ROW ";R": ";
2720 GOTO 2760
2730 IF (C = 1 AND R >=10) THEN 2740 ELSE 2760 2740 LPRINT "ROW ";R;": ";
2750 GOTO 2760
2760 LPRINT TAB(B8);R%(R,C);
2770 NEXT C
2780 LPRINT
2790 NEXT R
2800 FOR H6 = 1 TO 3
2810 LPRINT
2820 NEXT H6
2830 FOR C = 1 TO J
2840 R%(0,C) = 0
2850 NEXT C
2860 LPRINT
2870 FOR C = 1 TO J
2880 FOR R = 1 TO I
2890 IF R%(R,C) = 9 THEN 2910 ELSE 2900
2900 R%(0,C) = R%(0,C) + R%(R,C)
2910 NEXT R
2920 NEXT C
2930 LPRINT TAB(14);"COLUMN TOTALS ARE"
2940 FOR C = 1 TO J
2950 B9 = (4*C)+10
2960 LPRINT TAB(B9);R%(0,C);
2970 NEXT C
2980 LPRINT
2990 FOR C = 1 TO J
3000 S%(1,C) = 0
3010 NEXT C
3020 T = 0
3030 FOR D1 = 0 TO J
3040 FOR C = 1 TO J
3050 IF R%(0,C) = I - D1 THEN 3060 ELSE 3080 3060 S%(1,C) = 1
3070 T = T + 1
3080 NEXT C
3090 IF T = J/2 THEN 3120 ELSE 3100
3100 IF T < J/2 THEN 3110 ELSE 3120
3110 NEXT D1
3120 GOSUB 3140
3130 F1 = F1 + 1
3135 GOTO 2030
3140 D2 = D1 - 1
3150 D3 = D1
3160 D4 = D1 + 1
3170 FOR C = 1 TO J
3180 A%(1,C) = 0
3181 B%(1,C) = 0
3182 D%(1,C) = 0
3190 NEXT C
3200 FOR D6 = 0 TO D2
3210 FOR C = 1 TO J
3220 IF R%(0,C) = I - D6 THEN 3230 ELSE 3240 3230 A%(1,C) = 1
3240 NEXT C
3250 NEXT D6
3260 FOR D7 = 0 TO D3
3270 FOR C = 1 TO J
3280 IF R%(0,C) = I- D7 THEN 3290 ELSE 3300 3290 B%(1,C) = 1
3300 NEXT C
3310 NEXT D7
3320 FOR D8 = 0 TO D4
3330 FOR C = 1 TO J
3340 IF R%(0,C) = I - D8 THEN 3350 ELSE 3360 3350 D%(1,C) = 1
3360 NEXT C
3370 NEXT D8
3380 FOR R = 1 TO I
3390 F%(R) = 0
3391 G%(R) = 0
3392 H%(R) = 0
3400 NEXT R
3410 FOR R = 1 TO I
3420 FOR C = 1 TO J
3430 IF A%(1,C) =R%(R,C) THEN 3440 ELSE 3450 3440 F%(R) = F%(R) + 1
3450 NEXT C
3460 NEXT R
3470 FOR R = 1 TO I
3480 FOR C = 1 TO J
3490 IF R%(R,C) = 9 THEN 3530 ELSE 3500
3500 IF B%(1,C) = R%(R,C) THEN 3510 ELSE 3520 3510 G%(R) = G%(R) + 1
3520 NEXT C
3530 NEXT R
3540 FOR R = 1 TO I
3550 FOR C = 1 TO J
3560 IF R%(R,C) = 9 THEN 3600 ELSE 3570
3570 IF D%(1,C) = R%(R,C) THEN 3580 ELSE 3590 3580 H%(R) = H%(R) + 1
3590 NEXT C
3600 NEXT R
3610 FOR R = 1 TO I
3620 IF R%(R,1) = 9 THEN 3690 ELSE 3630
3630 IF F%(R) <J/2 THEN 3640 ELSE 3650
3640 F%(R) = J - F%(R)
3650 IF G%(R) <J/2 THEN 3660 ELSE 3670
3660 G%(R) = J - G%(R)
3670 IF H%(R) <J/2 THEN 3680 ELSE 3690
3680 H%(R) = J - H%(R)
3690 NEXT R
3700 FOR L = 1 TO 4
3710 J%(L) = 0
3720 NEXT L
3730 FOR R = 1 TO I
3740 C%(R) = 0
3750 J%(1) = J%(1) + F%(R)
3751 J%(2) = J%(2) + G%(R)
3752 J%(3) = J%(3) + H%(R)
3760 NEXT R
3770 FOR C = 1 TO J
3780 T%(1,C) = 0
3790 NEXT C
3800 IF (J%(1) >= J%(2) AND J%(1) >= J%(3)) THEN 3810 ELSE 3820 3810 GOTO 3860
3820 IF (J%(2) >= J%(1) AND J%(2) >= J%(3)) THEN 3830 ELSE 3840 3830 GOTO 3900
3840 IF (J%(3) >= J%(1) AND J%(3) >= J%(2)) THEN 3850 ELSE 3970 3850 GOTO 3940
3860 FOR C = 1 TO J
3870 T%(1,C) = A%(1,C)
3880 NEXT C
3890 GOTO 3980
3900 FOR C = 1 TO J
3910 T%(1,C) = B%(1,C)
3920 NEXT C
3930 GOTO 3980
3940 FOR C = 1 TO J
3950 T%(1,C) = D%(1,C)
3960 NEXT C
3970 GOTO 3980
3980 LPRINT TAB(14);"TRIAL SCANNING PATTERN IS:" 3990 FOR C = 1 TO J
4000 B10 = (4*C)+10
4010 LPRINT TAB(B10);T%(1,C);
4020 NEXT C
4030 LPRINT
4040 FOR R = 1 TO I
4050 FOR C = 1 TO J
4060 IF R%(R,C) = 9 THEN 4100 ELSE 4070
4070 IF T%(1,C) = R%(R,C) THEN 4080 ELSE 4090 4080 C%(R) = C%(R) + 1
4090 NEXT C
4100 NEXT R
4110 LPRINT
4115 LPRINT
4120 LPRINT "ROW TOTALS ARE:"
4130 FOR R = 1 TO I
4140 IF R%(R,1) = 9 THEN 4150 ELSE 4170
4150 LPRINT "ROW ";R;" HAS ALREADY BEEN FACTORED" 4160 GOTO 4180
4170 LPRINT "ROW ";R;" TOTAL IS ";C%(R)
4180 NEXT R
4190 LPRINT
4195 LPRINT
4200 Z1 = 0
4205 Z2 = 0
4210 FOR R = 1 TO I
4220 IF (C%(R) = 0 AND R%(R,1) = 9) THEN 4250 ELSE 4230 4230 IF C%(R) = J/2
THEN 4240 ELSE 4250
4240 Z1 = Z1 + 1
4250 NEXT R
4260 FOR R = 1 TO I
4270 IF R%(R,1) = 9 THEN 4300 ELSE 4280
4280 IF C%(R) <= INT(J/2) THEN 4290 ELSE 4300 4290 Z2 = Z2 + 1
4300 NEXT R
4310 IF Z1 = Z2 THEN 4580 ELSE 4320
4320 FOR R = 1 TO I
4330 IF (C%(R) = 0 AND R%(R,1) = 9) THEN 4460 ELSE 4340 4340 IF C%(R) <=
INT(J/2) THEN 4350 ELSE 4460 4350 LPRINT "REFLECTION IS TAKING PLACE" 4360
LPRINT
4370 LPRINT "IT INVOLVES ROW ";R
4380 K$(R) = "(REFLECTED) "
4390 LPRINT
4400 FOR C = 1 TO J
4410 IF R%(R,C) = 0 THEN 4420 ELSE 4440
4420 R%(R,C) = R%(R,C) + 1
4430 GOTO 4450
4440 R%(R,C) = R%(R,C) - 1
4450 NEXT C
4460 NEXT R
4470 LPRINT
4480 IF Z2 <> 0 THEN 4490 ELSE 4580
4490 IF F1 = 1 THEN 4520 ELSE 4500
4500 LPRINT "VARIABLES REMOVED BY FACTOR ANALYSIS ARE" 4510 LPRINT
"REPRESENTED BY '9' IN THE FOLLOWING MATRICES" 4520 LPRINT
4530 LPRINT TAB(14);"REFLECTED MATRIX IS:" 4540 Z9 = Z9 + 1
4550 IF Z9 > 6 THEN 4580 ELSE 4560
4560 GOTO 2340
4570 LPRINT
4580 GOSUB 5390
4590 LPRINT
4595 LPRINT
4600 LPRINT "***** FACTOR ";F1;" IS NOW COMPLETE *****" 4610 LPRINT
4620 V78 = 0
4630 V10 = 0
4640 V8 = 0
4645 V9 = 0
4650 V78 = V78 + 1
4660 IF V78 > 2 THEN 4670 ELSE 4750
4670 PRINT
4680 IF Z9 > 6 THEN 4750
4690 PRINT "WE WILL HAVE TO ACCEPT A FIDUCAL LIMIT OF ";N45 4700 PRINT "WE
HAVE TO ACCEPT THIS LEVEL OF GENERALITY OR NO FACTOR" 4710 PRINT "WOULD BE
DERIVED"
4720 PRINT
4730 M = N45
4740 GOTO 4960
4750 V10 = V10 + 1
4760 IF V10 <> 1 THEN 4770 ELSE 4790
4770 L$ = "STILL"
4780 GOTO 4800
4790 L$ = ""
4800 V19 = 0
4810 FOR R = 1 TO I
4820 IF C%(R) >= M THEN 4830 ELSE 4840
4830 V19 = V19 + 1
4840 NEXT R
4850 IF (V19 >= I/2 AND M <> J AND I > 4) THEN 4860 ELSE 4960 4860 PRINT
4865 PRINT
4870 PRINT "FACTOR ";F1;" IS POTENTIALLY TOO GENERAL" 4880 PRINT "ADVISE
YOU INCREASE FIDUCAL LIMIT FOR THIS FACTOR" 4890 PRINT "CURRENT FIDUCAL
LIMIT IS ";M 4900 INPUT "WHAT IS YOUR NEW FIDUCAL LIMIT";N5 4910 IF N5 <=M
THEN 4920 ELSE 4950
4920 PRINT
4925 PRINT
4930 PRINT "NO!! INCREASE FIDUCAL LIMIT!!" 4940 GOTO 4900
4950 M = N5
4960 FOR U = 1 TO I
4970 K%(U,1) = 0
4980 NEXT U
4990 FOR R = 1 TO I
5000 IF C%(R) >= M THEN 5010 ELSE 5060
5010 K%(R,1) = 1
5020 LPRINT "***** IT COMPRISES VARIABLE ";R;" ";K$(R);"*****" 5030 V8 = V8
+ C%(R)
5040 V9 = V9 + 1
5050 LPRINT
5055 LPRINT
5060 NEXT R
5070 IF V9 = 0 THEN 5160 ELSE 5080
5080 K8 = (V8/(I*J))*100
5090 LPRINT "***** FACTOR ";F1;" MATCHES ";K8;"%(";V8;") OF THE" 5100
LPRINT " ";I*J;" TOTAL NO. OF ELEMENTS IN THE GRID *****"
5110 LPRINT
5113 LPRINT
5115 LPRINT
5120 GOSUB 5470
5130 GOSUB 5390
5140 GOTO 5320
5150 LPRINT
5155 LPRINT
5160 T11 = 0
5170 FOR R = 1 TO I
5180 IF R%(R,1) <> 9 THEN 5190 ELSE 5200 5190 T11 = T11 + 1
5200 NEXT R
5210 IF T11 <=1 THEN 5330 ELSE 5220
5220 PRINT
5225 PRINT
5230 PRINT "YOU MUST ";L$" LOWER FIDUCAL LIMIT FOR FACTOR ";F1 5240 PRINT
"CURRENT FIDUCAL LIMIT IS ";M 5250 INPUT "WHAT IS YOUR NEW FIDUCAL
LIMIT";N45 5260 IF N45 >= M THEN 5270 ELSE 5300
5270 PRINT
5275 PRINT
5280 PRINT"NO!! LOWER FIDUCAL LIMIT"
5290 GOTO 5250
5300 M = N45
5310 GOTO 4640
5320 RETURN
5330 LPRINT "***** THE ANALYSIS IS NOW COMPLETE *****" 5340 FOR R = 1 TO I
5350 IF R%(R,1) <> 9 THEN 5360 ELSE 5370 5360 LPRINT "VARIABLE ";R;" IS NOT
INCLUDED IN THE GROUPING PROCEDURE" 5370 NEXT R
5380 GOTO 6350
5390 FOR P1 = 1 TO 3
5400 LPRINT
5410 FOR P2 = 1 TO 50
5420 LPRINT "+";
5430 NEXT P2
5440 NEXT P1
5450 LPRINT
5460 RETURN
5470 FOR C = 1 TO J
5480 N%(C) = 0
5490 NEXT C
5500 FOR V = 1 TO J
5510 FOR R = 1 TO I
5520 IF(K%(R,1) = 1 AND R%(R,V) = 1 ) THEN 5530 ELSE 5540 5530 N%(V) = N%(V) + 1
5540 NEXT R
5550 NEXT V
5560 LPRINT
5570 LPRINT "THE FOLLOWING ILLUSTRATES WHICH ELEMENTS HAVE THE" 5580 LPRINT
"HIGHEST NUMBERS OF INCIDENTS ON FACTOR ";F1 5640 GOSUB 6230
5650 FOR C = 1 TO J
5660 L7 = 0
5670 LPRINT "ELEMENT ";C;TAB(13);
5680 V = C
5690 L7 = N%(V)
5700 IF L7 <= 9 THEN 5710 ELSE 5770
5710 L8 = (3*L7)+1
5720 FOR L9 = 1 TO L8
5730 LPRINT "*";
5740 NEXT L9
5750 LPRINT "(";L7;")";
5760 GOTO 5820
5770 L10 = (L7*4)-8
5780 FOR L11 = 1 TO L10
5790 LPRINT "*";
5800 NEXT L11
5810 LPRINT "(";L7;")";
5820 GOSUB 6230
5830 NEXT C
5840 GOSUB 6230
5850 FOR C = 1 TO J
5860 N%(C) = 0
5870 NEXT C
5880 FOR V = 1 TO J
5890 FOR R = 1 TO I
5900 IF(K%(R,1) = 1 AND R%(R,V) = 0) THEN 5910 ELSE 5920 5910 N%(V) = N%(V) + 1
5920 NEXT R
5930 NEXT V
5940 GOSUB 6230
5950 LPRINT "THE FOLLOWING ILLUSTRATES WHICH ELEMENTS HAVE THE" 5960 LPRINT
"HIGHEST NUMBERS OF VOIDS ON FACTOR ";F1 6030 GOSUB 6230
6040 FOR C = 1 TO J
6050 LPRINT "ELEMENT ";C;TAB(13);
6060 LET V = C
6070 L18 = N%(V)
6080 IF L18 <= 9 THEN 6090 ELSE 6150
6090 L19 = (3*L18)+1
6100 FOR L20 = 1 TO L19
6110 LPRINT "*";
6120 NEXT L20
6130 LPRINT "(";L18;")";
6140 GOTO 6200
6150 L21 = (L18*4)-8
6160 FOR L22 = 1 TO L21
6170 LPRINT "*";
6180 NEXT L22
6190 LPRINT "(";L18;")";
6200 GOSUB 6230
6210 NEXT C
6220 GOTO 6270
6230 FOR L6 = 1 TO 3
6240 LPRINT
6250 NEXT L6
6260 RETURN
6270 FOR R = 1 TO I
6280 IF C%(R)>=M THEN 6290 ELSE 6320
6290 FOR C = 1 TO J
6300 R%(R,C) = 9
6310 NEXT C
6320 NEXT R
6330 RETURN
6350 END
Jack Adams-Webber Tel: 905 (688) 5544 [x 3714]
Department of Psychology Fax: 905 (688) 6922
Brock University E-mail: jadams@spartan.ac.brocku.ca
St. Catharines, Ontario
CANADA L2S 3A1
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%