5  COMMON X(), R(), B(), C(), Q()
10 CLS
20 PRINT "      STATISTICAL ECOLOGY:  A PRIMER ON METHODS AND COMPUTING "
30 PRINT
40 PRINT "       I N T E R A C T I V E     B A S I C    P R O G R A M   "
50 PRINT
60 PRINT "                           P C A . B A S                      "
70 PRINT
80 PRINT "      ------------------------------------------------------- "
90 PRINT "      This PROGRAM COMPUTES a PRINCIPAL COMPONENTS ANALYSIS   "
100 PRINT "         for THREE COMPONENTS based on SPECIES CORRELATIONS  "
110 PRINT "      -------------------------------------------------------"
120 PRINT
130 PRINT "     OPTIONS included are:": PRINT
140 PRINT "        Option # 1.  Sampling Unit (SU) Ordination": PRINT
150 PRINT "        Option # 2.  Species Ordination ": PRINT
160 PRINT "        Option # 3.  BOTH SU and SPECIES Ordination": PRINT
170 PRINT "      -------------------------------------------------------"
180 PRINT : INPUT "INPUT your CHOICE of Options (1-3) ? ", C1
190 IF C1 < 1 OR C1 > 3 THEN PRINT "out-of-range, try again": GOTO 180
200 CLS
210 PRINT "- - - - - - - - - PART I.  DATA ENTRY - - - - - - - - - - -": PRINT
220 PRINT "This program uses abundance data for species obtained from "
230 PRINT "   Sampling Units (SUs = plots, stands, locations, etc.).  ": PRINT
240 PRINT "These data are organized into a DATA MATRIX, where the     "
250 PRINT "   abundances of species form the ROWS and the SUs form    "
260 PRINT "   the columns. For example:": PRINT
270 PRINT "                         SU"
280 PRINT "                1    2    3    4    5"
290 PRINT "      Species  --   --   --   --   --"
300 PRINT "          1     2    5    5    3    0"
310 PRINT "          2     0    3    4    2    1": PRINT
320 GOSUB 2050
330 CLS : PRINT "- - -  PART II.  PRINCIPAL COMPONENTS ANALYSIS - - -": PRINT
340 REM - SPECIES CENTER THE DATA
350 FOR K = 1 TO S
360 S1 = 0: S2 = 0
370 FOR I = 1 TO N
380 S1 = S1 + X(K, I)
390 S2 = S2 + (X(K, I) * X(K, I))
400 NEXT I
410 S3 = S1 / N
420 S4 = SQR(S2 - ((S1 * S1) / N))
430 FOR I = 1 TO N
440 X(K, I) = (X(K, I) - S3) / S4
450 NEXT I
460 NEXT K
470 REM - R MATRIX BY MULTIPLICATION OF SPECIES CENTERED DATA
480 PRINT " "
490 PRINT "R MATRIX (SPECIES CORRELATIONS) - UPPER TRIANGLE ": PRINT
500 Q7 = 0
510 FOR I = 1 TO S
520 FOR J = I TO S
530 S0 = 0
540 FOR K = 1 TO N
550 S0 = S0 + (X(I, K) * X(J, K))
560 NEXT K
570 R(I, J) = S0: R(J, I) = S0
580 NEXT J
590 Q7 = Q7 + R(I, I)
600 IF I = 1 THEN GOTO 700
610 L = I - 1
620 PRINT "Correlation between Species";
630 PRINT USING "###"; L;
640 PRINT ") and Species"
650 FOR K = I TO S
660 PRINT USING "######"; K;
670 PRINT ") =";
680 PRINT USING "###.###"; R(L, K);
690 NEXT K: PRINT
700 NEXT I
710 PRINT : PRINT "HIT ANY KEY TO CONTINUE"
720 IF INKEY$ = "" THEN GOTO 720
730 CLS
740 PRINT "Summary of Eigenanalysis: "
750 REM - LOOPS TO CALCULATE THE PRINCIPAL COMPONENTS OF R
760 N1 = S
770 IF N1 > 3 THEN N1 = 3
780 FOR I = 1 TO S
790  B(I, I) = 1
800 NEXT I
810  A = 1E-08: C = 0
820 FOR I = 2 TO S
830 FOR J = 1 TO I - 1
840  C = C + 2 * (R(I, J) ^ 2)
850 NEXT J, I
860  Y = SQR(C): O = (A / S) * Y: T = Y: D = 0
870  T = T / S
880 FOR Q = 2 TO S: FOR P = 1 TO Q - 1
890 IF ABS(R(P, Q)) < T THEN 1060
900  D = 1: V = R(P, P): Z = R(P, Q): E = R(Q, Q): F = .5 * (V - E): IF F = 0 THEN 920
910  G = -(SGN(F)): GOTO 930
920  G = -1
930  G = G * Z / SQR(Z ^ 2 + F ^ 2): H = G / SQR(2 * (1 + SQR(1 - G ^ 2))): K = SQR(1 - H ^ 2)
940 FOR I = 1 TO S
950  IF I = P OR I = Q THEN 990
960  C = R(I, P): F = R(I, Q)
970  R(Q, I) = C * H + F * K: R(I, Q) = R(Q, I)
980  R(P, I) = C * K - F * H: R(I, P) = R(P, I)
990  C = B(I, P): F = B(I, Q)
1000  B(I, Q) = C * H + F * K: B(I, P) = C * K - F * H
1010 NEXT I
1020  AA = 2 * Z * H * K
1030  R(P, P) = V * K * K + E * H * H - AA
1040  R(Q, Q) = V * H * H + E * K * K + AA
1050  R(P, Q) = (V - E) * H * K + Z * (K * K - H * H): R(Q, P) = R(P, Q)
1060 NEXT P, Q
1070  IF D <> 1 THEN 1090
1080  D = 0: GOTO 880
1090  IF T > O THEN 870
1100 FOR I = 1 TO S
1110  Q(I) = I: Q3 = Q3 + Q2 * R(I, I)
1120 NEXT I
1130 IF S > 2 THEN 1160
1140 IF R(1, 1) > R(2, 2) THEN 1310
1150  Q = R(1, 1): R(1, 1) = R(2, 2): R(2, 2) = Q: Q = Q(1): Q(1) = Q(2): Q(2) = Q: GOTO 1310
1160  K = 0: Q = 1: L = S
1170  M = INT((L + Q) / 2): M = R(M, M): I = Q: J = L
1180 IF R(I, I) <= M THEN 1200
1190  I = I + 1: GOTO 1180
1200 IF R(J, J) >= M THEN 1220
1210  J = J - 1: GOTO 1200
1220 IF I > J THEN 1260
1230 IF I = J THEN 1250
1240  P = R(J, J): R(J, J) = R(I, I): R(I, I) = P: P = Q(J): Q(J) = Q(I): Q(I) = P
1250  I = I + 1: J = J - 1: IF I <= J THEN 1180
1260 IF I >= L THEN 1280
1270  S0(K) = I: L(K) = L: K = K + 1
1280  L = J: IF Q < L THEN 1170
1290 IF K = 0 THEN 1310
1300  K = K - 1: Q = S0(K): L = L(K): GOTO 1170
1310 PRINT
1320  PRINT
1330  PRINT "                PERCENT OF   ACCUMULATED "
1340  PRINT " EIGENVALUE       TRACE       % of TRACE "
1350  PRINT " --- --------   ----------   ----------- "
1360  W = 0
1370 FOR J = 1 TO S
1380  IF W > 1 THEN 1440
1390  PRINT USING "###"; J;
1400  PRINT " = "; : PRINT USING "###.###"; R(J, J);
1410  PRINT USING "########.#"; 100 * R(J, J) / Q7; : PRINT "%  ";
1420  W = W + R(J, J) / Q7
1430  PRINT USING "########.#"; 100 * W; : PRINT "%"
1440 NEXT J: PRINT
1450 FOR J = 1 TO S
1460  V = O
1470  K = Q(J)
1480 FOR I = 1 TO S
1490  V = V + B(I, K) ^ 2
1500 NEXT I
1510  PRINT "EIGENVECTOR "; J; " = ";
1520 FACT = SQR(V)
1530 FOR I = 1 TO S
1540  B(I, K) = B(I, K) / FACT
1550 PRINT USING "###.###"; B(I, K);
1560 NEXT I: PRINT
1570 NEXT J: PRINT
1580 PRINT : PRINT "HIT ANY KEY TO CONTINUE"
1590 IF INKEY$ = "" THEN GOTO 1590
1600 CLS
1610 IF C1 = 2 THEN GOTO 1820
1620 PRINT : PRINT "SAMPLING UNIT Coordinates on the 1st 3 Principal Components"
1630 FOR I = 1 TO N1
1640  K = Q(I)
1650 FOR J = 1 TO N
1660  C(K, J) = 0
1670 FOR H = 1 TO S
1680  C(K, J) = C(K, J) + B(H, K) * X(H, J)
1690 NEXT H, J, I
1700 PRINT "                 COMPONENTS "
1710 PRINT "   SU       I        II        III "
1720 PRINT "  ---    ------    ------    ------"
1730 FOR J = 1 TO N
1740 PRINT USING "#####"; J;
1750 FOR I = 1 TO N1
1760  K = Q(I)
1770 PRINT USING "######.###"; C(K, J);
1780 NEXT I: PRINT
1790 NEXT J: PRINT
1800 IF C1 = 1 THEN END ELSE PRINT : PRINT "HIT ANY KEY TO CONTINUE"
1810 IF INKEY$ = "" THEN GOTO 1810
1820 CLS
1830 PRINT : PRINT "SPECIES Coordinates (Correlations) on the 1st 3 Principal Components"
1840 FOR I = 1 TO N1
1850 R(I, I) = SQR(R(I, I))
1860 NEXT I
1870 FOR J = 1 TO N1
1880  K = Q(J)
1890 FOR I = 1 TO S
1900 B(I, K) = B(I, K) * R(J, J)
1910 NEXT I
1920 NEXT J
1930 PRINT "                 COMPONENTS "
1940 PRINT "  SPP       I        II        III "
1950 PRINT "  ---    ------    ------    ------"
1960 FOR I = 1 TO S
1970 PRINT USING "#####"; I;
1980 FOR J = 1 TO N1
1990  K = Q(J)
2000 PRINT USING "######.###"; B(I, K);
2010 NEXT J: PRINT
2020 NEXT I: PRINT
2030 PRINT "END OF THE PROGRAM": CLEAR
2040 END
2050 REM - - - - -  SUBROUTINE FOR DATA ENTRY  - - - - -
2060 PRINT "Species Data INPUT options:"
2070 PRINT "  Option 1 - Species Data already exists in a STORED data file"
2080 PRINT "  Option 2 - Species Data is to be manually entered from keyboard"
2090 PRINT "             (and subsequently STORED, if desired)": PRINT
2100 INPUT "Choose OPTION:  Input 1 or 2  "; OPT
2110 IF OPT < 1 OR OPT > 2 THEN PRINT "value out-of-range, try again ": GOTO 2100
2120 INPUT "INPUT the NUMBER of SAMPLING UNITS (SUs) "; N
2130 INPUT "INPUT the NUMBER of SPECIES "; S: PRINT
2140 DIM X(S, N), R(S, S), B(S, S), C(S, N), Q(S)
2150 IF OPT = 1 THEN GOTO 2330 ELSE IF OPT <> 2 THEN GOTO 2160
2160 PRINT
2170 PRINT "The data matrix is created one COLUMN (or SU) at a time,"
2180 PRINT "   that is, INPUT abundances for SPECIES by SU": PRINT
2190 FOR SU = 1 TO N: FOR SP = 1 TO S
2200 PRINT "Abundance for Species "; SP; " in SU "; SU;
2210 INPUT " = "; X(SP, SU)
2220 NEXT SP: NEXT SU
2230 INPUT "STORE This DATASET ON DISK ? (ENTER Y for YES / N for NO) "; A$
2240 IF A$ = "N" OR A$ = "n" THEN GOTO 2400 ELSE 2250
2250 INPUT "Specify a name for this DATASET (e.g., PCA.DAT) "; OUTDAT$
2260 INPUT "Specify DISK drive: ENTER A, B, C, etc.  "; DD$
2270 OUTDAT$ = DD$ + ":" + OUTDAT$
2280 OPEN OUTDAT$ FOR OUTPUT AS #1
2290 FOR SU = 1 TO N: FOR SP = 1 TO S
2300 PRINT #1, X(SP, SU);
2310 NEXT SP: NEXT SU: PRINT
2320 GOTO 2400
2330 INPUT "Specify name of DATA File (e.g., PCA.DAT) "; DATAFIL$
2340 INPUT "Specify DISK DRIVE where located: A, B, C, etc. "; DD$
2350 FILENAM$ = DD$ + ":" + DATAFIL$
2360 OPEN "I", #1, FILENAM$
2370 FOR SU = 1 TO N: FOR SP = 1 TO S
2380 INPUT #1, X(SP, SU)
2390 NEXT SP: NEXT SU: PRINT
2400 INPUT "Would you like to list the DATA ? (Y for Yes / N for NO) "; A$
2410 IF A$ = "Y" OR A$ = "y" THEN GOTO 2420 ELSE GOTO 2500
2420 PRINT "LISTING OF THE DATA SET: ROW = species, COLUMNS = SUs": PRINT
2430 FOR SP = 1 TO S
2440 FOR SU = 1 TO N
2450 PRINT X(SP, SU);
2460 NEXT SU: PRINT
2470 NEXT SP: PRINT
2480 PRINT "PRESS ANY KEY TO CONTINUE"
2490 IF INKEY$ = "" THEN 2490
2500 CLOSE #1
2510 RETURN