5 COMMON X(), S1(), S2(), R(), U(), W(), S5()
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 "                         C O A . B A S                        "
70 PRINT
80 PRINT "      ------------------------------------------------------- "
90 PRINT "      This program computes a CORRESPONDENCE ANALYSIS for     "
100 PRINT "        THREE COMPONENTS based on SPECIES scalar-products    "
110 PRINT "        after a DOUBLE TRANSFORMATION of the data matrix     "
120 PRINT "      -------------------------------------------------------"
130 PRINT
140 PRINT "     CORRESPONDING ORDINATION OPTIONS included are:": PRINT
150 PRINT "        Option #1: Sampling Unit (SU) Ordination": PRINT
160 PRINT "        Option #2: Species Ordination": PRINT
170 PRINT "        Option #3: BOTH SU and SPECIES Ordinations are COMPUTED"
180 PRINT : PRINT "      -------------------------------------------------------"
190 PRINT : INPUT "INPUT Choice of OPTIONs (1-3) ? ", C1
200 IF C1 < 1 OR C1 > 3 THEN PRINT "out-of-range, try again": GOTO 190
210 CLS
220 PRINT "- - - - - - - - - PART I.  DATA ENTRY - - - - - - - - - - -": PRINT
230 PRINT "This program uses abundance data for species obtained from "
240 PRINT "   Sampling Units (SUs = plots, stands, locations, etc.).  ": PRINT
250 PRINT "These data are organized into a DATA MATRIX, where the     "
260 PRINT "   abundances of species form the ROWS and the SUs form    "
270 PRINT "   the columns. For example:": PRINT
280 PRINT "                         SU"
290 PRINT "                1    2    3    4    5"
300 PRINT "      Species  --   --   --   --   --"
310 PRINT "          1     2    5    5    3    0"
320 PRINT "          2     0    3    4    2    1": PRINT
330 GOSUB 2610
340 CLS : PRINT "- - -  PART II.  CORRESPONDENCE ANALYSIS - - -": PRINT
350 REM - SPECIES (ROW) TOTALS
360 FOR I = 1 TO S
370 S1(I) = 0
380 FOR J = 1 TO N
390 S1(I) = S1(I) + X(I, J)
400 NEXT J
410 NEXT I
420 REM - SAMPLING UNIT (COLUMN) TOTALS AND THE GRAND TOTAL
430 S3 = 0
440 FOR J = 1 TO N
450 S2(J) = 0
460 FOR I = 1 TO S
470 S2(J) = S2(J) + X(I, J)
480 NEXT I
490 S3 = S3 + S2(J)
500 NEXT J
510 REM - TRANSFORM MATRIX X BY DIVIDING BY THE SQRT OF TOTALS
520 FOR J = 1 TO N
530 FOR I = 1 TO S
540 X(I, J) = X(I, J) / SQR(S1(I))
550 X(I, J) = X(I, J) / SQR(S2(J))
560 NEXT I
570 NEXT J
580 REM - CHECK FOR SPECIES OR SU COMPONENT ORDINATION OPTION
590 IF C1 = 2 THEN GOTO 960
600 REM - Q MATRIX BY PRE-MULTIPLICATION OF X BY ITS TRANSPOSE
610 PRINT " "
620 PRINT " Q Matrix "
630 FOR I = 1 TO N
640 FOR J = I TO N
650 S0 = 0
660 FOR K = 1 TO S
670 S0 = S0 + (X(K, I) * X(K, J))
680 NEXT K
690 R(I, J) = S0
700 R(J, I) = S0
710 NEXT J
720 FOR J = 1 TO N
730 PRINT USING "###.###"; R(I, J);
740 NEXT J: PRINT
750 NEXT I
760 M1 = N
770 GOSUB 3110
780 PRINT "SAMPLING UNIT Coordinates on the 1st 3 COMPONENTS "
790 GOSUB 1340
800 FOR J = 1 TO N1
810 FOR I = 1 TO N
820 S5(I, J) = (S5(I, J) * SQR(S3)) / SQR(S2(I))
830 NEXT I
840 NEXT J
850 GOSUB 3110
860 PRINT : PRINT "                 COMPONENTS "
870 PRINT "   SU       I        II       III "
880 PRINT "  ---    ------    ------    ------"
890 FOR I = 1 TO N
900 PRINT USING "#####"; I;
910 FOR J = 1 TO N1
920 PRINT USING "######.###"; S5(I, J);
930 NEXT J: PRINT
940 NEXT I
950 GOSUB 3110
960 IF C1 = 1 THEN GOTO 1330
970 REM - R MATRIX BY POST-MULTIPLICATION OF X BY ITS TRANSPOSE
980 PRINT " "
990 PRINT " R Matrix "
1000 FOR I = 1 TO S
1010 FOR J = I TO S
1020 S0 = 0
1030 FOR K = 1 TO N
1040 S0 = S0 + (X(I, K) * X(J, K))
1050 NEXT K
1060 R(I, J) = S0
1070 R(J, I) = S0
1080 NEXT J
1090 FOR J = 1 TO S
1100 PRINT USING "###.###"; R(I, J);
1110 NEXT J: PRINT
1120 NEXT I
1130 M1 = S
1140 GOSUB 3110
1150 PRINT "SPECIES Coordinates on the 1st 3 COMPONENTS"
1160 GOSUB 1340
1170 FOR J = 1 TO N1
1180 FOR I = 1 TO S
1190 S5(I, J) = (S5(I, J) * SQR(S3)) / SQR(S1(I))
1200 NEXT I
1210 NEXT J
1220 GOSUB 3110
1230 PRINT : PRINT "                COMPONENTS "
1240 PRINT "  SPP      I        II        III"
1250 PRINT "  ---   ------    ------    ------ "
1260 FOR I = 1 TO S
1270 PRINT USING "####"; I;
1280 FOR J = 1 TO N1
1290 PRINT USING "######.###"; S5(I, J);
1300 NEXT J: PRINT
1310 NEXT I
1320 PRINT "End of Program": CLEAR
1330 END
1340 REM - CALCULATE THE FIRST THREE EIGENVALUES/VECTORS of R or Q
1350 FOR I = 1 TO M1
1360 FOR J = 1 TO M1
1370 S5(I, J) = 0
1380 IF I = J THEN S5(I, J) = 1
1390 NEXT J
1400 NEXT I
1410 N1 = M1
1420 IF N1 > 3 THEN N1 = 3
1430 FOR I = 1 TO N1
1440 W(I) = 0
1450 N2 = I + 1
1460 FOR J = N2 TO M1
1470 IF W(I) > ABS(R(I, J)) THEN GOTO 1500
1480 W(I) = ABS(R(I, J))
1490 U(I) = J
1500 NEXT J
1510 NEXT I
1520 H1 = 7.45E-09
1530 H2 = 10000
1540 FOR I = 1 TO N1
1550 IF I = 1 THEN GOTO 1570
1560 IF S6 >= W(I) THEN GOTO 1600
1570 S6 = W(I)
1580 N3 = I
1590 N4 = U(I)
1600 NEXT I
1610 IF S6 <= 0 THEN GOTO 2470
1620 IF H2 <= 0 THEN GOTO 1640
1630 IF S6 > H2 THEN GOTO 1710
1640 H3 = ABS(R(1, 1))
1650 FOR I = 2 TO M1
1660 IF H3 <= ABS(R(I, I)) THEN GOTO 1680
1670 H3 = ABS(R(I, I))
1680 NEXT I
1690 H2 = H3 * H1
1700 IF H2 >= S6 THEN GOTO 2470
1710 T1 = R(N3, N3) - R(N4, N4)
1720 T2 = (2 * SGN(T1)) * R(N3, N4)
1730 T3 = ABS(T1) + SQR((T1 * T1) + (4 * (R(N3, N4) * R(N3, N4))))
1740 T4 = T2 / T3
1750 T5 = 1 / SQR(1 + (T4 * T4))
1760 T6 = T4 * T5
1770 T7 = R(N3, N3)
1780 R(N3, N3) = (T5 * T5) * (T7 + T4 * (2 * R(N3, N4) + T4 * R(N4, N4)))
1790 R(N4, N4) = (T5 * T5) * (R(N4, N4) - T4 * (2 * R(N3, N4) - T4 * T7))
1800 R(N3, N4) = 0
1810 IF R(N3, N3) >= R(N4, N4) THEN GOTO 1880
1820 T8 = R(N3, N3)
1830 R(N3, N3) = R(N4, N4)
1840 R(N4, N4) = T8
1850 T8 = (-1 * SGN(T6)) * T5
1860 T5 = ABS(T6)
1870 T6 = T8
1880 FOR I = 1 TO N1
1890 IF I = N3 THEN GOTO 2050
1900 IF I < N3 THEN GOTO 1920
1910 IF I = N4 THEN GOTO 2050
1920 IF U(I) = N3 THEN GOTO 1940
1930 IF U(I) < N4 OR U(I) > N4 THEN GOTO 2050
1940 K = U(I)
1950 T8 = R(I, K)
1960 R(I, K) = 0
1970 N2 = I + 1
1980 W(I) = 0
1990 FOR J = N2 TO M1
2000 IF W(I) > ABS(R(I, J)) THEN GOTO 2030
2010 W(I) = ABS(R(I, J))
2020 U(I) = J
2030 NEXT J
2040 R(I, K) = T8
2050 NEXT I
2060 W(N3) = 0
2070 W(N4) = 0
2080 FOR I = 1 TO M1
2090 IF I = N3 THEN GOTO 2400
2100 IF I > N3 THEN GOTO 2210
2110 T8 = R(I, N3)
2120 R(I, N3) = T5 * T8 + T6 * R(I, N4)
2130 IF W(I) >= ABS(R(I, N3)) THEN GOTO 2160
2140 W(I) = ABS(R(I, N3))
2150 U(I) = N3
2160 R(I, N4) = -T6 * T8 + T5 * R(I, N4)
2170 IF W(I) >= ABS(R(I, N4)) THEN GOTO 2400
2180 W(I) = ABS(R(I, N4))
2190 U(I) = N4
2200 GOTO 2400
2210 IF I = N4 THEN GOTO 2400
2220 IF I > N4 THEN GOTO 2310
2230 T8 = R(N3, I)
2240 R(N3, I) = T5 * T8 + T6 * R(I, N4)
2250 IF W(N3) >= ABS(R(N3, I)) THEN GOTO 2280
2260 W(N3) = ABS(R(N3, I))
2270 U(N3) = I
2280 R(I, N4) = -T6 * T8 + T5 * R(I, N4)
2290 IF W(I) >= ABS(R(I, N4)) THEN GOTO 2400
2300 IF W(I) < ABS(R(I, N4)) THEN GOTO 2180
2310 T8 = R(N3, I)
2320 R(N3, I) = T5 * T8 + T6 * R(N4, I)
2330 IF W(N3) >= ABS(R(N3, I)) THEN GOTO 2360
2340 W(N3) = ABS(R(N3, I))
2350 U(N3) = I
2360 R(N4, I) = -T6 * T8 + T5 * R(N4, I)
2370 IF W(N4) >= ABS(R(N4, I)) THEN GOTO 2400
2380 W(N4) = ABS(R(N4, I))
2390 U(N4) = I
2400 NEXT I
2410 FOR I = 1 TO M1
2420 T8 = S5(I, N3)
2430 S5(I, N3) = T5 * T8 + T6 * S5(I, N4)
2440 S5(I, N4) = -T6 * T8 + T5 * S5(I, N4)
2450 NEXT I
2460 GOTO 1540
2470 PRINT " "
2480 PRINT "First 3 Eigenvalues and Vectors of this MATRIX ": PRINT
2490 PRINT "  Values: ";
2500 FOR I = 1 TO N1
2510 PRINT USING "####.###"; R(I, I);
2520 NEXT I: PRINT : PRINT
2530 FOR J = 1 TO N1
2540 PRINT "  VECTOR";
2550 PRINT USING "##"; J;
2560 FOR I = 1 TO M1
2570 PRINT USING "####.###"; S5(I, J);
2580 NEXT I: PRINT
2590 NEXT J
2600 RETURN
2610 REM - - - - -  SUBROUTINE FOR DATA ENTRY  - - - - -
2620 PRINT "Species Data INPUT options:"
2630 PRINT "  Option 1 - Species Data already exists in a STORED data file"
2640 PRINT "  Option 2 - Species Data is to be manually entered from keyboard"
2650 PRINT "             (and subsequently STORED, if desired)": PRINT
2660 INPUT "Choose OPTION:  Input 1 or 2  "; OPT
2670 IF OPT < 1 OR OPT > 2 THEN PRINT "value out-of-range, try again ": GOTO 2660
2680 INPUT "INPUT the NUMBER of SAMPLING UNITS (SUs) "; N
2690 INPUT "INPUT the NUMBER of SPECIES "; S: PRINT
2700 DIM X(S, N), S1(S), S2(N)
2710 IF N >= S THEN NS = N + 1
2720 IF S >= N THEN NS = S + 1
2730 DIM R(NS, NS), U(NS), W(NS), S5(NS, NS)
2740 IF OPT = 1 THEN GOTO 2920 ELSE IF OPT <> 2 THEN GOTO 2750
2750 PRINT
2760 PRINT "The data matrix is created one COLUMN (or SU) at a time,"
2770 PRINT "   that is, INPUT abundances for SPECIES by SU": PRINT
2780 FOR SU = 1 TO N: FOR SP = 1 TO S
2790 PRINT "Abundance for Species "; SP; " in SU "; SU;
2800 INPUT " = "; X(SP, SU)
2810 NEXT SP: NEXT SU
2820 INPUT "STORE This DATASET ON DISK ? (ENTER Y for YES / N for NO) "; A$
2830 IF A$ = "N" OR A$ = "n" THEN GOTO 2990 ELSE 2840
2840 INPUT "Specify a name for this DATASET (e.g., COA.DAT) "; OUTDAT$
2850 INPUT "Specify DISK drive: ENTER A, B, C, etc.  "; DD$
2860 OUTDAT$ = DD$ + ":" + OUTDAT$
2870 OPEN OUTDAT$ FOR OUTPUT AS #1
2880 FOR SU = 1 TO N: FOR SP = 1 TO S
2890 PRINT #1, X(SP, SU);
2900 NEXT SP: NEXT SU: PRINT
2910 GOTO 2990
2920 INPUT "Specify name of DATA File (e.g., COA.DAT) "; DATAFIL$
2930 INPUT "Specify DISK DRIVE where located: A, B, C, etc. "; DD$
2940 FILENAM$ = DD$ + ":" + DATAFIL$
2950 OPEN "I", #1, FILENAM$
2960 FOR SU = 1 TO N: FOR SP = 1 TO S
2970 INPUT #1, X(SP, SU)
2980 NEXT SP: NEXT SU: PRINT
2990 INPUT "Would you like to list the DATA ? (Y for Yes / N for NO) "; A$
3000 IF A$ = "Y" OR A$ = "y" THEN GOTO 3010 ELSE GOTO 3090
3010 PRINT "LISTING OF THE DATA SET: ROW = species, COLUMNS = SUs": PRINT
3020 FOR SP = 1 TO S
3030 FOR SU = 1 TO N
3040 PRINT X(SP, SU);
3050 NEXT SU: PRINT
3060 NEXT SP: PRINT
3070 PRINT "PRESS ANY KEY TO CONTINUE"
3080 IF INKEY$ = "" THEN 3080
3090 CLOSE #1
3100 RETURN
3110 PRINT : PRINT "Hit ANY KEY to CONTINUE"
3120 IF INKEY$ = "" THEN 3120
3130 PRINT : RETURN