10 OPTION BASE 1
20 CLS
30 PRINT "          STATISTICAL ECOLOGY:  A PRIMER ON METHODS AND COMPUTING "
40 PRINT
50 PRINT "           I N T E R A C T I V E    B A S I C    P R O G R A M    "
60 PRINT
70 PRINT "                        S P C O V A R . B A S                     "
80 PRINT
90 PRINT "         --------------------------------------------------------"
100 PRINT "         THIS PROGRAM COMPUTES:": PRINT
110 PRINT "                  1. Pearson's Product-Moment Correlation          "
120 PRINT "                  2. Spearman's Rank Correlation                   "
130 PRINT "                                                                 "
140 PRINT "         --------------------------------------------------------"
150 PRINT "          Based on abundance data (density, percent cover,       "
160 PRINT "          biomass, etc) between pairs of species                 "
170 PRINT "         --------------------------------------------------------"
180 PRINT
190 PRINT "PRESS ANY KEY TO CONTINUE"
200 IF INKEY$ = "" THEN 200
210 CLS
220 PRINT "- - - - - - - - - -PART I. DATA ENTRY- - - - - - - - - - ": PRINT ""
230 PRINT "This program utilizes ABUNDANCE data of S species found  "
240 PRINT "   in N sampling units (SUs) (plots, quadrats, stands, etc.)   "
250 PRINT "                                                         "
260 PRINT "These data are organized into a SxN DATA MATRIX:             "
270 PRINT "   For example, as in Example 12.3                       "
280 PRINT "                           SUs (Quadrats)                "
290 PRINT "               (1)  (2)  (3)  (4)  (5)  (6)  (7)  (8)  (9)     "
300 PRINT "Species (1):  88.4 84.8 74.1 73.2 60.7 57.1 55.4 43.8 41.1     "
310 PRINT "Species (2):   8.9  3.6 19.6 11.6 31.3 23.2 18.8 32.1 33.0     "
320 PRINT
330 REM FOR I=1 TO 5:PRINT "":NEXT I
340 REM PRINT"PRESS ANY KEY TO CONTINUE"
350 REM IF INKEY$="" THEN 430
360 REM CLS
370 GOSUB 520
380 CLS
390 PRINT "---------PART II. COMPUTATION OF CORRELATIONS ----------------"
400 GOSUB 1100: 'COMPUTATION OF PEARSON'S CORRELATIONS
410 REM -----------PART III. SECTION FOR OUTPUT ------------------------
420 PRINT : PRINT "A. Pearson's Product-Moment Correlations between all PAIR-WISE"
430 PRINT "         combinations of species": PRINT
440 GOSUB 1260
450 CLS
460 PRINT : PRINT "B. Spearman's Rank Correlations between all PAIR-WISE"
470 PRINT "         combinations of species                   ": PRINT
480 GOSUB 1370:    'RANKING OF MATRIX
490 GOSUB 1100:    'CORRELATIONS
500 GOSUB 1260:    'PRINTING RESULTS
510 END
520 REM -----------SUBROUTINE FOR DATA ENTRY---------------------------
530 PRINT " Data INPUT options: "
540 PRINT "     Option 1 - Data already exists in a STORED data file "
550 PRINT "     Option 2 - Data is to be manually entered from the keyboard "
560 PRINT "                NOTE: These data will be STORED for ranking."
570 PRINT : INPUT "Choose OPTION:  Enter 1 OR 2  "; OPT
580 IF OPT = 1 THEN GOTO 830 ELSE IF OPT <> 2 THEN GOTO 570
590 INPUT "INPUT Number of SUs......", N
600 INPUT "INPUT Number of Species..", S
610 SIZE = S * (S - 1) / 2
620 DIM X(S, N), R(SIZE), RX(S, N), COL!(S), SEL(S), DT!(S, N)
630 PRINT ""
640 PRINT "The data matrix is created one COLUMN (or SU) at a time.      "
650 PRINT " ENTER abundance data for each species in the SU              "
660 PRINT
670 FOR SU = 1 TO N
680 FOR SP = 1 TO S
690 PRINT "SPECIES "; SP; " in SU "; SU;
700 INPUT " = "; X(SP, SU)
710 NEXT SP: NEXT SU
720 PRINT "These DATA must now be STORED on DISK "
730 INPUT "..Specify a name for this DATASET (e.g., SPCOV.DAT) "; DATAFILE$
740 INPUT "..Specify DISK drive: ENTER A, B, C, etc.  "; DD$
750 DD$ = DD$ + ":"
760 FILENAM$ = DD$ + DATAFILE$
770 OPEN FILENAM$ FOR OUTPUT AS #1
780 FOR SU = 1 TO N
790 FOR SP = 1 TO S
800 WRITE #1, X(SP, SU)
810 NEXT SP: NEXT SU
820 GOTO 960
830 INPUT "Specify name of DATA File (e.g., SPCOV.DAT) "; DATAFILE$
840 INPUT "Specify DISK DRIVE where located: A, B, C, etc. "; DD$
850 DD$ = DD$ + ":"
860 INPUT "INPUT Number of SUs.......", N
870 INPUT "INPUT Number of Species...", S
880 SIZE = S * (S - 1) / 2
890 DIM X(S, N), R(SIZE), RX(S, N), COL!(S), SEL(S), DT!(S, N)
900 FILENAM$ = DD$ + DATAFILE$
910 OPEN "I", #1, FILENAM$
920 FOR SU = 1 TO N
930 FOR SP = 1 TO S
940 INPUT #1, X(SP, SU)
950 NEXT SP: NEXT SU
960 INPUT "Would you like to list the DATA ? (Y for Yes / N for NO) "; A$
970 IF A$ = "Y" OR A$ = "y" THEN GOTO 980 ELSE GOTO 1080
980 PRINT "LISTING OF THE DATA SET. ROWS=species, COLUMNS=SUs        "
990 PRINT
1000 FOR SP = 1 TO S
1010 FOR SU = 1 TO N
1020 PRINT X(SP, SU);
1030 NEXT SU: PRINT
1040 NEXT SP
1050 FOR I = 1 TO 2: PRINT "": NEXT I
1060 PRINT "PRESS ANY KEY TO CONTINUE"
1070 IF INKEY$ = "" THEN 1070
1080 CLOSE #1
1090 RETURN
1100 REM -------------SUBROUTINE FOR COMPUTING CORRELATIONS --------------
1110 INDEX = 1
1120 FOR I = 1 TO S - 1: FOR J = I + 1 TO S
1130 SUMCC = 0: SUM1 = 0: SUM2 = 0: SUM1SQ = 0: SUM2SQ = 0
1140 FOR K = 1 TO N
1150     SUMCC = SUMCC + X(I, K) * X(J, K)
1160     SUM1 = SUM1 + X(I, K)
1170     SUM2 = SUM2 + X(J, K)
1180     SUM1SQ = SUM1SQ + X(I, K) ^ 2
1190     SUM2SQ = SUM2SQ + X(J, K) ^ 2
1200 NEXT K
1210 ' CORRELATION COEFFICIENT
1220 R(INDEX) = (SUMCC - SUM1 * SUM2 / N) / (SQR((SUM1SQ - (SUM1 ^ 2) / N) * (SUM2SQ - (SUM2 ^ 2) / N)))
1230   INDEX = INDEX + 1
1240 NEXT J: NEXT I
1250 RETURN
1260 REM-------------SUBROUTINE FOR PRINTING---------------------
1270 INDEX = 0
1280 FOR I = 1 TO S - 1
1290 PRINT "SPECIES"; I; ")"; " Correlations with SPECIES"
1300 FOR J = I + 1 TO S
1310 INDEX = INDEX + 1: PRINT J; ")";
1320 PRINT USING "##.### "; R(INDEX);
1330 NEXT J: PRINT : NEXT I
1340 FOR I = 1 TO 2: PRINT : NEXT I: PRINT "PRESS ANY KEY TO CONTINUE"
1350 IF INKEY$ = "" THEN 1350
1360 RETURN
1370 REM--------------SUBROUTINE FOR RANKING---------------------
1380 '  BASED ON ALGORITHM DEVELOPED BY DAVID M. FOGG                   '
1390 '  NORTHWEST ANALYTICAL - PORTLAND, OR                             '
1400 BL$ = CHR$(7)
1410 COLS = S
1420 MXRO = N
1430 GOSUB 1540
1440 YN% = 0
1450 WHILE YN% = 0: YN$ = "Y": YN% = INSTR(" YyNn", LEFT$(YN$, 1)) \ 2: WEND
1460 YN% = YN% - 2
1470 RUP = YN%
1480 GOTO 1640
1490 IF EOF(1) THEN RETURN
1500 FOR COL = 1 TO HICOL: INPUT #1, COL!(SEL(COL)): NEXT
1510 IF HICOL < ICOLS THEN LINE INPUT #1, GI$
1520 ROWS = ROWS + 1
1530 RETURN
1540 ROWS = 0: HICOL = 0: ICOLS = 0
1550 IFIL$ = FILENAM$
1560 ON ERROR GOTO 1630
1570 CLOSE 1: OPEN "I", 1, IFIL$
1580 ON ERROR GOTO 1870
1590 WHILE ICOLS < COLS: ICOLS = S: WEND
1600 FOR COL = 1 TO COLS: TS = 0: WHILE TS < 1 OR TS > ICOLS: TS = COL: WEND: SEL(TS) = COL: NEXT
1610 FOR COL = ICOLS TO 1 STEP -1: IF SEL(COL) THEN HICOL = COL: RETURN
1620 NEXT
1630 PRINT BL$; "*** "; IFIL$; ": BAD FILE NAME!": RESUME 1550
1640 WHILE NOT EOF(1): GOSUB 1490
1650 FOR C = 1 TO COLS: D! = COL!(C): DT!(C, ROWS) = D!
1660 B = 0: SS = ROWS - 1
1670 IF RUP THEN 1750
1680 FOR R = 1 TO SS
1690 IF D! > DT!(C, R) THEN RX(C, R) = RX(C, R) + 2: B = B + 1 ELSE IF D! = DT!(C, R) THEN RX(C, R) = RX(C, R) + 1: RX(C, ROWS) = RX(C, R)
1700 NEXT
1710 IF RX(C, ROWS) = 0 THEN RX(C, ROWS) = (ROWS - B) * 2
1720 NEXT
1730 WEND
1740 GOTO 1790
1750 FOR R = 1 TO SS
1760 IF D! < DT!(C, R) THEN RX(C, R) = RX(C, R) + 2: B = B + 1 ELSE IF D! = DT!(C, R) THEN RX(C, R) = RX(C, R) + 1: RX(C, ROWS) = RX(C, R)
1770 NEXT
1780 GOTO 1710
1790 GOSUB 1860
1800 FOR R = 1 TO ROWS
1810  FOR C = 1 TO COLS
1820   X(C, R) = RX(C, R) / 2
1830  NEXT C
1840 NEXT R
1850 GOTO 1960
1860 RETURN
1870 ' {ERRORECOVERY STARTS HERE - IF IMPLEMENTED; DON'T DELETE THIS REM}
1880 IF ERR = 62 AND ERL = 1500 THEN PRINT BL$; "*** BAD INPUT: ABORTING ***": GOTO 1960
1890 ' * * * *  UNRECOVERABLE ERRORS  * * * * *
1900 PRINT : PRINT
1910 PRINT BL$; "      * * *  E R R O R  * * *"
1920 PRINT "Check your input data for validity..."
1930 PRINT "Try re-running the program..."
1940 PRINT "ERROR DESCRIPTION --"
1950 ' >>-----> EGRESS >>----->
1960 ON ERROR GOTO 0
1970 RETURN