5 COMMON P1(), X(), D(), SDIST(), E(), XAXIS(), YAXIS(), EY()
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 "                              P O . B A S                       "
60 PRINT "       ------------------------------------------------------------"
70 PRINT "       ORDINATION using the POLAR method as outlined below: "
80 PRINT "            1. Q-MODE Distances are computed between all pairs of "
90 PRINT "               STANDS or SAMPLING UNITS.                           "
100 PRINT "            2. ORDINATION on X AXIS:  Endstands 'AX' & 'BX' are    "
110 PRINT "               determined. AX has the largest SUM of distances     "
120 PRINT "               with all other SUs and BX is the SU with the        "
130 PRINT "               largest distance to AX.                             "
140 PRINT "            3. Each of remaining SUs are positioned along X axis"
150 PRINT "               (between AX & BX) using Beal's geometric formula    "
170 PRINT "            4. ORDINATION on Y AXIS: User OPTION.  'Poorness of    "
180 PRINT "               Fit'(e) of SUs on the X axis are computed.  SU with "
190 PRINT "               largest value of 'e' is 'AY' and the SU with the    "
200 PRINT "               largest distance to AY (within 1/10 of AY on the X  "
210 PRINT "               axis) is designed 'BY'. Step 3 (for Y axis) repeated"
220 PRINT "            5. ENDPOINT SELECTION based on Bray-Curtis Method or   "
225 PRINT "               by Simplified Method.                               "
230 PRINT "         ----------------------------------------------------------"
240 PRINT "HIT ANY KEY TO CONTINUE"
250 IF INKEY$ = "" THEN 250
260 CLS
270 PRINT "------PART I. OPTIONS: Distance Index & Endpoint Selection----------"
280 PRINT ""
290 PRINT " The following DISTANCE INDICES may be selected to measure"
300 PRINT " the ecological resemblance between pairs of SUs.  See    "
310 PRINT " ORLOCI, L.  1974. Revisions for the Bray and Curtis      "
320 PRINT " ordination.  Can. J. Bot. 52:1773-1776  for details."
330 PRINT " "
340 PRINT " 1) Percent Dissimilarity (Bray-Curtis)    [PD - Eq. 14.6b]"
350 PRINT " 2) Euclidean Distance                     [ED - Eq. 14.1 ]"
360 PRINT " 3) Relative Euclidean Distance            [RED- Eq. 14.7 ]"
370 PRINT " 4) Absolute Distance                      [AD - Eq. 14.4 ]"
380 PRINT " 5) Mean Absolute Distance                 [MAD- Eq. 14.5 ]"
390 PRINT " "
400 INPUT " ENTER Choice of Index (1-5) "; DIST
410 PRINT " "
420 PRINT "ENDPOINT (ENDSTAND) SELECTION: Two OPTIONS are available:        "
430 PRINT "   Option #1 = Bray-Curtis Procedure (Section 18.2.1)            "
440 PRINT "   Option #2 = Simplified Procedure  (Section 18.2.2)      "
450 PRINT : INPUT "ENTER 1 or 2........"; FOXLADY
460 CLS
470 IF DIST > 5 THEN GOTO 270
480 IF AJO$ = "Y" OR AJO$ = "y" THEN GOTO 510
490 PRINT "--------------PART II.  DATA ENTRY------------------------"
500 GOSUB 2260
510 CLS
520 PRINT "  -- PART III.  COMPUTE PAIR-WISE DISTANCES BETWEEN SUs --     "
530 IF DIST = 5 THEN GOTO 1080
540 IF DIST = 4 THEN GOTO 970
550 IF DIST = 3 THEN GOTO 820
560 IF DIST = 2 THEN GOTO 710
570 PRINT : PRINT "Index is Percent Dissimilarity Index [Eq. 14.6b] "
580 W = 0: A = 0: B = 0
590 FOR SUA = 1 TO K
600 FOR SBB = 1 TO K
610 FOR SP = 1 TO L
620   IF X(SUA, SP) < X(SBB, SP) THEN MIN = X(SUA, SP) ELSE MIN = X(SBB, SP)
630   W = W + MIN
640   A = A + X(SUA, SP)
650   B = B + X(SBB, SP)
660   NEXT SP
670 D(SUA, SBB) = 100 - ((2 * W / (A + B)) * 100)
680 W = 0: A = 0: B = 0
690 NEXT SBB: NEXT SUA
700 GOTO 1220
710 PRINT : PRINT "Index is Euclidean Distance [Eq. 14.1]"
720 SSQD = 0
730 FOR SUA = 1 TO K
740 FOR SBB = 1 TO K
750 FOR SP = 1 TO L
760   SSQD = SSQD + (X(SUA, SP) - X(SBB, SP)) ^ 2
770   NEXT SP
780 D(SUA, SBB) = SQR(SSQD)
790 SSQD = 0
800 NEXT SBB: NEXT SUA
810 GOTO 1220
820 PRINT : PRINT "Index is Relative Euclidean Distance [Eq. 14.7]"
830 XSQA = 0: XSQB = 0: SDIFF = 0
840 FOR SUA = 1 TO K
850 FOR SBB = 1 TO K
860 FOR SP = 1 TO L
870   XSQA = XSQA + X(SUA, SP) ^ 2
880   XSQB = XSQB + X(SBB, SP) ^ 2
890   NEXT SP
900 FOR SP = 1 TO L
910   SDIFF = SDIFF + (X(SUA, SP) / SQR(XSQA) - X(SBB, SP) / SQR(XSQB)) ^ 2
920   NEXT SP
930 D(SUA, SBB) = SQR(SDIFF)
940 XSQA = 0: XSQB = 0: SDIFF = 0
950 NEXT SBB: NEXT SUA
960 GOTO 1220
970 PRINT : PRINT "Index is Absolute Distance [Eq. 14.4]      "
980 SABS = 0
990 FOR SUA = 1 TO K
1000 FOR SBB = 1 TO K
1010 FOR SP = 1 TO L
1020   SABS = SABS + ABS(X(SUA, SP) - X(SBB, SP))
1030   NEXT SP
1040 D(SUA, SBB) = SABS
1050 SABS = 0
1060 NEXT SBB: NEXT SUA
1070 GOTO 1220
1080 PRINT : PRINT "Index is Mean Absolute Distance [Eq. 14.5]      "
1090 SUMA = 0: SUMB = 0: SABS = 0
1100 FOR SUA = 1 TO K
1110 FOR SBB = 1 TO K
1120 FOR SP = 1 TO L
1130   SUMA = SUMA + X(SUA, SP)
1140   SUMB = SUMB + X(SBB, SP)
1150   NEXT SP
1160 FOR SP = 1 TO L
1170   SABS = SABS + ABS(X(SUA, SP) / SUMA - X(SBB, SP) / SUMB)
1180   NEXT SP
1190 D(SUA, SBB) = SABS
1200 SUMA = 0: SUMB = 0: SABS = 0
1210 NEXT SBB: NEXT SUA
1220 REM
1230 REM ---  PRINT DISTANCES  ---
1240 REM
1250 COUNTER = 0
1260 FOR SUA = 1 TO K - 1
1270 PRINT " "
1280 PRINT " Distance Between SU "; P1(SUA); " and"
1290 FOR SBB = SUA + 1 TO K
1300   PRINT P1(SBB); ")"; D(SUA, SBB);
1310   NEXT SBB
1320   PRINT : COUNTER = COUNTER + 1
1330   IF COUNTER < 5 THEN GOTO 1370
1340 PRINT "HIT ANY KEY TO CONTINUE"
1350 IF INKEY$ = "" THEN 1350
1360 COUNTER = 0
1370   NEXT SUA
1380 PRINT "HIT ANY KEY TO CONTINUE"
1390 IF INKEY$ = "" THEN 1390
1400 CLS
1410 REM--------------ENDSTAND SELECTION -----------------------------
1420 GOSUB 2930
1430 REM
1440 REM ---  CALCULATE SITE POSITIONS ON THE X AXIS  ---
1450 REM
1460 XLEN = MAXS
1470 PRINT " "
1480 PRINT "The LENGTH of the X AXIS is therefore = "; XLEN
1490 PRINT " "
1500 PRINT "HIT ANY KEY TO CONTINUE"
1510 IF INKEY$ = "" THEN 1510
1520 CLS
1530 PRINT " "
1540 PRINT "Geometric location of SUs on X axis & computation of Poorness of Fit "
1550 AXIS$ = "X": GOSUB 2820
1560 COUNTER = 0
1570 FOR SU = 1 TO K
1580   XAXIS(SU) = (XLEN ^ 2 + D(AX, SU) ^ 2 - D(BX, SU) ^ 2) / (2 * XLEN)
1590   E(SU) = SQR(ABS(D(AX, SU) ^ 2 - XAXIS(SU) ^ 2))
1600   PRINT USING "###"; P1(SU);
1610   PRINT USING "########.####"; XAXIS(SU); E(SU)
1620      COUNTER = COUNTER + 1        'SECTION TO CONTROL LINE SPACING
1630      IF COUNTER < 18 THEN GOTO 1670'    ON SCREEN
1640      PRINT "HIT ANY KEY TO CONTINUE"
1650      IF INKEY$ = "" THEN 1650
1660      PRINT : COUNTER = 0: GOSUB 2820
1670 NEXT SU
1680 REM
1690 REM ---  FIND ENDPOINT OF Y AXIS (AY)  ---
1700 PRINT
1710 INPUT "Would you like to try ordination on the Y axis ? (Y=yes/N=no)"; A$
1720 IF A$ = "y" OR A$ = "Y" THEN GOTO 1730 ELSE 2240
1730 CLS
1740 EMAX = 0
1750 FOR SU = 1 TO K
1760   IF E(SU) > EMAX THEN EMAX = E(SU): AY = SU
1770 NEXT SU
1780 PRINT "Geometric location of SUs on Y axis & computation of Poorness of Fit "
1790 PRINT " "
1800 IF FOXLADY = 2 THEN GOTO 1970
1810 PRINT "STEP 1. DETERMINE 'AY' ON THE Y AXIS"
1820 PRINT "        SU with the largest 'e'is...............#"; P1(AY)
1830 PRINT "        The value of 'e'is......................."; E(AY)
1840 PRINT
1850 REM ---  FIND OTHER ENDPOINT OF Y AXIS (AX)  ---
1860 REM
1870 MAXP = 0
1880 FOR SU = 1 TO K
1890   IF ABS(XAXIS(AY) - XAXIS(SU)) < (XLEN / 10) THEN IF D(AY, SU) > MAXP THEN MAXP = D(AY, SU): BY = SU:
1900   NEXT SU
1910 PRINT "STEP 2. DETERMINE 'BY' ON THE Y AXIS"
1920 IF MAXP = 0 THEN PRINT : PRINT " *** NOTICE:  NO SUs are within 1/10 L      "
1930 IF MAXP = 0 THEN PRINT "    of AY so the ordination cannot proceed": GOTO 2240
1940 PRINT "        SU with the greatest distance to AY is..#"; P1(BY)
1950 PRINT "        The distance is.........................."; MAXP
1960 REM
1970 REM ---  CALCULATE POSITIONS ON THE Y AXIS  ---
1980 REM
1990 YLEN = MAXP
2000 PRINT " "
2010 PRINT "Length of the Y Axis is "; YLEN
2020 PRINT " "
2030 COUNTER = 0
2040 PRINT "PRESS ANY KEY TO CONTINUE"
2050 IF INKEY$ = "" THEN 2050
2060 CLS
2070 PRINT "               * SUMMARY OF THE POLAR ORDINATION * "
2080 PRINT
2090 AXIS$ = "Y": GOSUB 2820
2100 FOR SU = 1 TO K
2110   YAXIS(SU) = (YLEN ^ 2 + D(AY, SU) ^ 2 - D(BY, SU) ^ 2) / (2 * YLEN)
2120   EY(SU) = SQR(ABS(D(AY, SU) ^ 2 + YAXIS(SU) ^ 2))
2130 PRINT USING "###"; P1(SU);
2140 PRINT USING "########.####"; XAXIS(SU); YAXIS(SU); E(SU); EY(SU)
2150       COUNTER = COUNTER + 1         'section to control line spacing
2160      IF COUNTER < 18 THEN GOTO 2230'    ON SCREEN
2170      PRINT "HIT ANY KEY TO CONTINUE"
2180      IF INKEY$ = "" THEN 2180
2190      PRINT "HIT ANY KEY TO CONTINUE"
2200      IF INKEY$ = "" THEN 2200
2210 CLS
2220      PRINT : COUNTER = 0: GOSUB 2820
2230   NEXT SU
2240 PRINT : INPUT "ReRun ORDINATION using another INDEX ? (Y=yes/N=no)"; AJO$
2250 IF AJO$ = "y" OR AJO$ = "Y" THEN GOTO 260 ELSE END
2260 REM -----------SUBROUTINE FOR DATA ENTRY---------------------------
2270 PRINT "Data INPUT options:                                            "
2280 PRINT "     Option 1 - Data already exists in a STORED data file      "
2290 PRINT "     Option 2 - Data is to be manually entered from keyboard   "
2300 PRINT "                (and subsequently STORED, if desired)          "
2310 INPUT "Choose OPTION:  Enter 1 OR 2  "; OPT
2330 INPUT "INPUT Number of SUs.......", K
2340 INPUT "INPUT Number of Species...", L
2350 DIM P1(K), X(K, L), D(K, K), SDIST(K), E(K), XAXIS(K), YAXIS(K), EY(K)
2360 PRINT ""
2320 IF OPT = 1 THEN GOTO 2560 ELSE IF OPT <> 2 THEN GOTO 2310
2370 PRINT "The data matrix is created one SU at a time.      "
2380 PRINT
2390 FOR SU = 1 TO K
2400 P1(SU) = SU
2410 FOR SP = 1 TO L
2420 PRINT "SPECIES "; SP; " in SU "; SU
2430 INPUT " "; X(SU, SP)
2440 NEXT SP: NEXT SU
2450 INPUT "STORE This DATASET ON DISK ? (ENTER Y for YES / N for NO) "; A$
2460 IF A$ = "N" OR A$ = "n" THEN GOTO 2680
2470 INPUT "Specify a name for this DATASET (e.g., ORDIN.DAT) "; OUTDAT$
2480 INPUT "Specify DISK drive: ENTER A, B, C, etc.  "; DD$
2490 OUTDAT$ = DD$ + ":" + OUTDAT$
2500 OPEN OUTDAT$ FOR OUTPUT AS #1
2510 FOR SU = 1 TO K
2520 FOR SP = 1 TO L
2530 WRITE #1, X(SU, SP)
2540 NEXT SP: NEXT SU
2550 GOTO 2680
2560 INPUT "Specify name of DATA File (e.g., ORDIN.DAT) "; DATAFIL$
2570 INPUT "Specify DISK DRIVE where located: A, B, C, etc. "; DD$
2610 FILENAM$ = DD$ + ":" + DATAFIL$
2620 OPEN "I", #1, FILENAM$
2630 FOR SU = 1 TO K
2640 P1(SU) = SU
2650 FOR SP = 1 TO L
2660 INPUT #1, X(SU, SP)
2670 NEXT SP: NEXT SU
2680 INPUT "Would you like to list the DATA ? (Y for Yes / N for NO) "; A$
2690 IF A$ = "Y" OR A$ = "y" THEN GOTO 2700 ELSE GOTO 2800
2700 PRINT "LISTING OF THE DATA SET. ROWS=species, COLUMNS=SUs    "
2710 PRINT " "
2720 FOR SP = 1 TO L
2730 FOR SU = 1 TO K
2740 PRINT X(SU, SP);
2750 NEXT SU: PRINT
2760 NEXT SP
2770 FOR I = 1 TO 2: PRINT "": NEXT I
2780 PRINT "PRESS ANY KEY TO CONTINUE"
2790 IF INKEY$ = "" THEN 2790
2800 CLOSE #1
2810 RETURN
2820 REM------------------SUBROUTINE FOR PRINTING HEADINGS-------------------
2830 PRINT
2840 IF AXIS$ = "X" THEN GOTO 2850 ELSE GOTO 2890
2850 PRINT "        LOCATION ON   POORNESS       "
2860 PRINT " SU       X  AXIS      OF FIT         "
2870 PRINT "------  ------------  ----------      "
2880 GOTO 2920
2890 PRINT "        LOCATION    LOCATION    POORNESS OF   POORNESS OF"
2900 PRINT " SU     ON X AXIS   ON Y AXIS    FIT ON X      FIT ON Y  "
2910 PRINT "------  ----------  ----------  ------------  ------------"
2920 RETURN
2930 REM SUBROUTINE TO DETERMINE THE ENDPOINTS
2940 PRINT "-----------PART IV. ENDSTAND SELECTION --------------": PRINT
2950 IF FOXLADY = 2 THEN PRINT "Endpoint selection by Simplified Method (Section 18.2.2)" ELSE PRINT "Endpoint Selection by BRAY-CURTIS Method (SECTION 18.2.1)"
2960 REM ---  SUM DISTANCES ACROSS SITES  ---
2970 REM
2980 FOR SUA = 1 TO K
2990 SDIST(SUA) = 0
3000 FOR SBB = 1 TO K
3010   SDIST(SUA) = SDIST(SUA) + D(SUA, SBB)
3020   NEXT SBB: NEXT SUA
3030 REM ---  FIND THE MOST DISSIMILAR SITE  ---
3040 REM
3050 MAXD = 0
3060 PRINT : PRINT "STEP 1. SUM of distances for each SU "
3070 PRINT
3080 FOR SU = 1 TO K
3090   PRINT "SU"; P1(SU); "=";
3100   PRINT USING "#####.##    "; SDIST(SU);
3110   IF SDIST(SU) > MAXD THEN MAXD = SDIST(SU): AX = SU
3120   NEXT SU: PRINT : PRINT
3130 IF FOXLADY = 2 THEN GOTO 3200
3140 PRINT "STEP 2. FIND 'AX' ON THE X AXIS"
3150 PRINT "        SU with largest SUM is .................#"; P1(AX)
3160 PRINT "        The sum is .............................."; SDIST(AX)
3170 REM
3180 REM ---  FIND OTHER END OF AXIS (BX)  ---
3190 REM
3200 MAXS = 0
3210 FOR SU = 1 TO K
3220   IF D(AX, SU) > MAXS THEN MAXS = D(AX, SU): BX = SU
3230   NEXT SU
3240 IF FOXLADY = 2 THEN GOTO 3300
3250 PRINT "STEP 3. FIND 'BX' ON THE X AXIS"
3260 PRINT "        SU with the largest distance to AX is...#"; P1(BX)
3270 PRINT "        The distance is.........................."; MAXS
3280 PRINT " "
3290 RETURN
3300 PRINT "STEP 2. User provides the Endpoint SUs:                ": PRINT
3310 PRINT "        Enter 2 Numbers for each AXIS, e.g., ' 3,4 ' [include comma]"
3320 INPUT "        X axis SUs .... "; AX, BX
3330 INPUT "        Y axis SUs .... "; AY, BY
3340 MAXS = D(AX, BX)
3350 MAXP = D(AY, BY)
3360 RETURN