5 COMMON X(), P1(), S1(), S2(), D()
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   "
60 PRINT "                S U D I S T . B A S                        "
70 PRINT " ----------------------------------------------------------"
80 PRINT " PROGRAM SUDIST.BAS COMPUTES:"
90 PRINT "   Q-MODE Resemblance Functions -- DISTANCE COEFFICIENTS   "
100 PRINT " ----------------------------------------------------------"
110 PRINT "    1) E-GROUP DISTANCES                                  "
120 PRINT "        1. Euclidean Distance (ED)          [Eq. 14.1]    "
130 PRINT "        2. Squared Euclidean Distance (SED) [Eq. 14.2]    "
140 PRINT "        3. Mean Euclidean Distance (MED)    [Eq. 14.3]    "
150 PRINT "        4. Absolute Distance (AD)           [Eq. 14.4]    "
160 PRINT "        5. Mean Absolute Distance (MAD)     [Eq. 14.5]    "
170 PRINT "    2) BS-GROUP DISTANCES                                 "
180 PRINT "        6. Percent Dissimilarity (PD)       [Eq. 14.6c]   "
190 PRINT "    3) RE-GROUP DISTANCES                                "
200 PRINT "        7. Relative Euclidean Distance (RED)[Eq. 14.7]    "
210 PRINT "        8. Relative Absolute Distance (RAD) [Eq. 14.8]    "
220 PRINT "        9. Chord Distance (CRD)             [Eq. 14.9a]   "
230 PRINT "       10. Geodesic Distance (GDD)          [Eq. 14.10]   "
231 PRINT " ----------------------------------------------------------"
240 PRINT "PRESS ANY KEY TO CONTINUE"
250 IF INKEY$ = "" THEN 250
260 CLS
270 PRINT "--------------PART I.  DATA ENTRY ----------------------------"
280 PRINT :
290 PRINT " This program uses abundance data for S SPECIES obtained from   "
300 PRINT "   N SAMPLING UNITS (SUs) (e.g., plots, stands, etc.)           "
310 PRINT " These data are arranged into a DATA MATRIX, where the ROWS are "
320 PRINT "   the SPECIES and the COLUMNS represent SUs:               "
330 PRINT
340 PRINT " Xij = abundance of the ith species in the jth SU "
350 PRINT "                        SUs "
360 PRINT "           1    2    3    4    5    6   ...  N   "
370 PRINT " Species  ---- ---- ---- ---- ---- ----     ---- "
375 PRINT "     1    X    X    X    X    X    X        X    "
380 PRINT "           1,1  1,2  1,3  1,4  1,5  1,6      1,N ": PRINT
390 PRINT "     2    X    X    X    X    X    X    ... X    "
400 PRINT "           2,1  2,2  2,3  2,4  2,5  2,6      2,N "
410 PRINT "     :    :                           :          "
420 PRINT "     S    X    X    X    X    X    X    ... X    "
430 PRINT "           S,1  S,2  S,3  S,4  S,5  S,6      S,N "
440 GOSUB 1220
450 REM - LOOPS FOR SUMS AND SUMS OF SQS FOR RELATIVE DISTANCES
460 FOR I = 1 TO N
470 S1(I) = 0
480 S2(I) = 0
490 FOR J = 1 TO K
500 S1(I) = S1(I) + X(J, I)
510 S2(I) = S2(I) + (X(J, I) * X(J, I))
520 NEXT J
530 NEXT I
540 REM - LOOPS TO CALCULATE DISTANCES BETWEEN ALL PAIR-WISE
550 REM - COMBINATIONS OF SAMPLING UNITS
560 CLS : PRINT "----------------PART II. CALCULATION OF DISTANCES -------------------"
570 GOSUB 2000
610 W = K: M = N - 1: M1 = 1: LINENUMB = 0
640 FOR I = 1 TO M
650 L1 = M1
660 FOR N1 = I TO M
670 L = N1 + 1
680 REM - EUCLIDEAN DISTANCES:
690 D(3) = 0
700 FOR J = 1 TO K
710 F = X(J, I) - X(J, L):
720 D(3) = D(3) + (F * F):                              'SED - EQ. 14.2
730 NEXT J
740 D(1) = SQR(D(3)):                                   'ED  - EQ. 14.1
750 D(2) = SQR(D(3) / W):                               'MED - EQ. 14.3
760 REM - ABSOLUTE DISTANCES:
770 D(4) = 0
780 FOR J = 1 TO K
790 D(4) = D(4) + (ABS(X(J, I) - X(J, L))):             'AD  - EQ. 14.4
800 NEXT J
810 D(5) = D(4) / W:                                    'MAD  - EQ. 14.5
820 REM - BRAY-CURTIS DISSIMILARITY INDEX  (ORLOCI EQN)
830 D(6) = D(4) / (S1(I) + S1(L)):                      'PD  - EQ. 14.6C
840 REM - RELATIVE EUCLIDEAN DISTANCE
850 D(7) = 0
860 FOR J = 1 TO K
870 F2 = (X(J, I) / S1(I)) - (X(J, L) / S1(L))
880 D(7) = D(7) + (F2 * F2):
890 NEXT J
900 D(7) = SQR(D(7)):                                   'RED - EQ. 14.7
910 REM - RELATIVE ABSOLUTE DISTANCE
920 D(8) = 0
930 FOR J = 1 TO K
940 D(8) = D(8) + (ABS((X(J, I) / S1(I)) - (X(J, L) / S1(L)))): 'RAD - EQ. 14.8
950 NEXT J
960 REM - CHORD DISTANCE
970 D(10) = 0
980 S5 = 0
990 FOR J = 1 TO K
1000 S5 = S5 + (X(J, I) * X(J, L))
1010 NEXT J
1020 REM CHORD DISTANCE
1030 C1 = S5 / SQR(S2(I) * S2(L))
1040 D(9) = SQR(2! * (1! - C1)):                        ' CRD - EQ. 14.9A
1050 IF (C1 < .01) THEN C1 = .01
1060 C2 = SQR(1 - (C1 * C1))
1070 C3 = C2 / C1
1080 IF (C3 > 1000) THEN C3 = 1000
1090 D(10) = ATN(C3):                                   'GDD - EQ. 14.10
1100 PRINT USING "###"; I; L;
1110 PRINT USING "####.#"; D(1);
1120 PRINT USING "######"; D(3);
1130 PRINT USING "####.#"; D(2);
1140 PRINT USING "######"; D(4);
1150 PRINT USING "####.#"; D(5);
1160 PRINT USING "#####.##"; D(6);
1170 PRINT USING "   ####.##"; D(7);
1180 PRINT USING "###.##"; D(8); D(9); D(10)
1185  LINENUMB = LINENUMB + 1: IF LINENUMB < 18 THEN GOTO 1190
1186  LINENUMB = 0
1187  PRINT "PRESS ANY KEY TO CONTINUE"
1188  IF INKEY$ = "" THEN 1188
1189 GOSUB 2000
1190 NEXT N1
1200 NEXT I
1210 END
1220 REM -----------SUBROUTINE FOR DATA ENTRY---------------------------
1230 PRINT "Data INPUT options:                                            "
1240 PRINT "     Option 1 - Data already exists in a STORED data file      "
1250 PRINT "     Option 2 - Data is to be manually entered from keyboard   "
1260 PRINT "                (and subsequently STORED, if desired)          "
1270 INPUT "Choose OPTION:  Enter 1 OR 2  "; OPT
1280 PRINT
1290 INPUT "INPUT Number of SUs .......", N
1300 INPUT "INPUT Number of Species....", K
1310 PRINT ""
1320 DIM X(K, N), P1(N), S1(N), S2(N), D(20)
1330 IF OPT = 1 THEN GOTO 1530
1340 PRINT "The data matrix is created one COLUMN (or SU) at a time.      "
1350 PRINT
1360 FOR SU = 1 TO N
1370 P(SU) = SU
1380 FOR SP = 1 TO K
1390 PRINT "SPECIES "; SP; " in SU "; SU
1400 INPUT " "; X(SP, SU)
1410 NEXT SP: NEXT SU
1420 INPUT "STORE This DATASET ON DISK ? (ENTER Y for YES / N for NO) "; A$
1430 IF A$ = "N" OR A$ = "n" THEN GOTO 1620
1440 INPUT "Specify a name for this DATASET (e.g., ASSOC.DAT) "; OUTDAT$
1450 INPUT "Specify DISK drive: ENTER A, B, C, etc.  "; DD$
1460 OUTDAT$ = DD$ + ":" + OUTDAT$
1470 OPEN OUTDAT$ FOR OUTPUT AS #1
1480 FOR SU = 1 TO N
1490 FOR SP = 1 TO K
1500 WRITE #1, X(SP, SU)
1510 NEXT SP: NEXT SU
1520 GOTO 1620
1530 INPUT "Specify name of DATA File (e.g., ORDIN.DAT) "; DATAFIL$
1540 INPUT "Specify DISK DRIVE where located: A, B, C, etc. "; DD$
1550 FILENAM$ = DD$ + ":" + DATAFIL$
1560 OPEN "I", #1, FILENAM$
1570 FOR SU = 1 TO N
1580 P(SU) = SU
1590 FOR SP = 1 TO K
1600 INPUT #1, X(SP, SU)
1610 NEXT SP: NEXT SU
1620 INPUT "Would you like to list the DATA ? (Y for Yes / N for NO) "; A$
1630 IF A$ = "Y" OR A$ = "y" THEN GOTO 1640 ELSE GOTO 1740
1640 PRINT "LISTING OF THE DATA SET. ROWS=species, COLUMNS=SUs        "
1650 PRINT " "
1660 FOR SP = 1 TO K
1670 FOR SU = 1 TO N
1680 PRINT X(SP, SU);
1690 NEXT SU: PRINT
1700 NEXT SP
1710 FOR I = 1 TO 2: PRINT "": NEXT I
1720 PRINT "PRESS ANY KEY TO CONTINUE"
1730 IF INKEY$ = "" THEN 1730
1740 CLOSE #1
1750 CLS
1760 RETURN
1770 PRINT
1780 PRINT "Press ANY KEY to continue..."
1790 IF INKEY$ = "" THEN 1790
1800 PRINT
1810 RETURN
2000 PRINT
2010 PRINT "   SUs  |------- E-GROUP ----------|--BS-GROUP--|------RE-GROUP--------|"
2020 PRINT "  i  j   ED   SED   MED    AD   MAD      PD       RED   RAD   CRD   GDD "
2030 PRINT " -- -- ----- ----- ----- ----- ----- ----------- ----- ----- ----- -----"
2040 RETURN