Hello. Here is a short BASIC program for undertaking Kelly's
nonparametric factor analysis of a binary repertory grid. It should run on
most machines with only minimal modification. The program was written by
Coshall and Potter (1986) and made available for general use. It's very
straightforward to use and doesn't require any prior explanation.
Hope this may be useful to someone.
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