APPENDIX I
LISTING OF THE ADAPTS PROGRAM CODE
The entire program listing for ADAPTS is reproduced here.
If you have a functioning version of QBasic on your Macintosh,
then you should be able to paste and cut this straight into a program file.
Words in block capitals, outside of quotation marks, are
commands in the QBasic language. Any line with REM at the start
is a note that has no effect on what the program does.
Due to the page size constraints some program lines are "wrapped around".
This is a demonstration version, and as such has no error trapping.
A basic user manual is available at:
http://geosci.uchicago.edu/paleo/csource/
http:/paleo.gly.bris.ac.uk/micropal/micropalaeo/
which will explain what the contents of all the output columns are.
10 CLS
20 REM INTRO BOX
30 SH=SYSTEM (6) 'height
40 SW=SYSTEM (5) 'WIDTH
50 h% = 250
60 w% = 400
70 WINDOW 2,"WELCOME TO ADAPTS VERSION 1.0",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
80 TEXTFONT 20:TEXTSIZE 36:TEXTFACE(30): MOVETO 80,30: PRINT "A.D.A.P.T.S."
90 TEXTFONT 4:TEXTSIZE 10:TEXTFACE(1): MOVETO 5,50: PRINT "Analysis of Diversity, Asymmetry of Phylogenetic Trees"
100 MOVETO 120,65: PRINT " and Survivorship."
110 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 130,80:PRINT "INTRODUCTION"
120 TEXTSIZE 10: TEXTFACE (0): PRINT "ADAPTS is a program for analysing;"
130 PRINT "Taxonomic evolutionary rates."
140 PRINT "Taxonomic survivorship."
150 PRINT "Phylogentic tree symmetry."
160 PRINT
170 PRINT "ADAPTS was written by Alistair McGowan as part"
180 PRINT "of a MSc. project (1998) supervised by Paul Pearson,
190 PRINT "at the Department of Earth Sciences, University of Bristol "
200 PRINT "VISIT OUR WEBSITE at www.
210 PRINT "A full user manual is available at this site."
220 BUTTON 1,1,"PROCEED", (150,225)-(240,245),1
230 WHILE DIALOG(0)<>1 :WEND
240 IF DIALOG (1)=1 THEN WINDOW CLOSE 2
250 CLS
260 REM SET UP BOX
270 SH=SYSTEM (6) 'height
280 SW=SYSTEM (5) 'WIDTH
290 h% = 250
300 w% = 400
310 WINDOW 2,"SET-UP PARAMETERS",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
320 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 130,20:PRINT "SET-UP PARAMETERS"
330 PRINT
340 TEXTSIZE 10: TEXTFACE (0): PRINT "The series of windows that follows will help
350 PRINT "you to set up the parameters for your analysis."
360 PRINT "When you are finished on each screen click on 'proceed'."
370 PRINT "Consult the ADAPTS manual FOR further help."
380 PRINT
390 PRINT "Enter the number of taxa in your dataset below."
400 PRINT
410 INPUT "NUMBER OF TAXA",n%
420 BUTTON 1,1,"PROCEED", (150,225)-(240,245),1
430 WHILE DIALOG(0)<>1 :WEND
440 IF DIALOG (1)=1 THEN WINDOW CLOSE 2
450 CLS
460 REM calculation interval BOX
470 SH=SYSTEM (6) 'height
480 SW=SYSTEM (5) 'WIDTH
490 h% = 250
500 w% = 400
510 WINDOW 2,"SET-UP THE CALCULATION INTERVAL",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
520 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 100,20:PRINT "SET THE CALCULATION INTERVAL"
530 PRINT
540 TEXTSIZE 10: TEXTFACE (0): PRINT "This window allows you to define the calculation interval."
550 REM PRINT "If you only want to use the A-D tests just hit 'return'."
560 REM PRINT "Otherwise a value MUST be entered."
570 PRINT "Fractions (e.g. 0.5) are permissible."
580 PRINT "If the calculation interval is set to more than '1'"
590 PRINT "the value of start point-minus end point"
600 PRINT "(the NEXT two parameters you will be asked for)"
610 PRINT "must be EXACTLY divisible by the value of"
620 PRINT"the calculation interval or else the output may be incomplete."
630 PRINT
640 PRINT "Enter the calculation interval."
650 PRINT
660 INPUT "CALCULATION INTERVAL",timestep
670 BUTTON 1,1,"PROCEED", (150,225)-(240,245),1
680 WHILE DIALOG(0)<>1 :WEND
690 IF DIALOG (1)=1 THEN WINDOW CLOSE 2
700 CLS
710 REM start point BOX
720 SH=SYSTEM (6) 'height
730 SW=SYSTEM (5) 'WIDTH
740 h% = 250
750 w% = 400
760 WINDOW 2,"SET THE START POINT",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
770 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 100,20:PRINT"SET THE STARTING POINT"
780 PRINT
790 TEXTSIZE 10: TEXTFACE (0): PRINT "This window allows you to define the start point."
800 REM PRINT "If you only want to use the A-D tests just hit 'return'."
810 PRINT "Set the start point"
820 PRINT "equal to or greater than the oldest FAD in your dataset."
830 PRINT
840 INPUT "START POINT",start
850 BUTTON 1,1,"PROCEED", (150,225)-(240,245),1
860 WHILE DIALOG(0)<>1 :WEND
870 IF DIALOG (1)=1 THEN WINDOW CLOSE 2
880 CLS
890 REM end point BOX
900 SH=SYSTEM (6) 'height
910 SW=SYSTEM (5) 'WIDTH
920 h% = 250
930 w% = 400
940 WINDOW 2,"SET THE END POINT",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
950 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 100,20:PRINT"SET THE END POINT"
960 PRINT
970 TEXTSIZE 10: TEXTFACE (0): PRINT "This window allows you to define the end point."
980 REM PRINT "If you only want to use the A-D tests just hit 'return'."
990 REM PRINT "Otherwise set the end point"
1000 PRINT "Remeber that the start point minus the end point"
1100 PRINT "must be exactly divisible by the calculation interval."
1110 PRINT "Check this now before entering the end point"
1120 PRINT
1130 PRINT "Calculation interval:"timestep
1140 PRINT
1150 PRINT "Start point:"start
1160 PRINT
1170 PRINT "Now enter your end point value"
1180 PRINT
1190 INPUT "END POINT",ends
1200 BUTTON 1,1,"PROCEED", (150,225)-(240,245),1
1300 WHILE DIALOG(0)<>1 :WEND
1400 IF DIALOG (1)=1 THEN WINDOW CLOSE 2
1410 CLS
1420 REM procedure selection BOX
1430 DIM routines$(8)
1440 SH=SYSTEM (6) 'height
1450 SW=SYSTEM (5) 'WIDTH
1460 h% = 250
1470 w% = 400
1480 WINDOW 2,"PROCEDURE SELECTION WINDOW",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
1490 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 150,20:PRINT"SELECT PROCEDURES"
1500 PRINT
1510 TEXTSIZE 10: TEXTFACE (0): PRINT "This window allows you to choose the procedures you want."
1520 BUTTON 1,1, "TAXONOMIC EVOLUTIONARY RATES", (20,60)-(400,75),2
1530 BUTTON 2,1, "DYNAMIC SURVIVORSHIP", (20,80)-(400,95),2
1540 BUTTON 3,1, "CSS", (20,100)-(400,115),2
1550 BUTTON 4,1, "ESS", (20,120)-(400,135),2
1560 BUTTON 5,1, "A-D EXTINCTION TEST", (20,140)-(400,155),2
1570 BUTTON 6,1, "A-D SURVIVORSHIP CONTROL TEST", (20,160)-(400,175),2
1580 BUTTON 7,1, "A-D SPECIATION TEST", (20,180)-(400,195),2
1590 BUTTON 8,1, "A-D SPECIATION (RESTRICTED) TEST", (20,200)-(400,215),2
1600 BUTTON 9,1,"PROCEED", (150,225)-(240,245),1
1610 WHILE BUTTON (9)<>2
1620 WHILE DIALOG(0)<>1:WEND
1630 x= DIALOG (1)
1640 IF x =1 THEN
1650 IF BUTTON (x) = 1 THEN
1660 BUTTON x,2
1670 routines$(x) = "y"
1680 GOTO 1610
1690 END IF
1700 END IF
1710 IF x = 1 THEN
1720 IF BUTTON (x) = 2 THEN
1725 IF BUTTON(3) = 1 THEN
1730 BUTTON x,1
1740 routines$(x) = ""
1750 GOTO 1610
1755 END IF
1760 END IF
1770 END IF
1780 IF x =2 THEN
1790 IF BUTTON (x) = 1 THEN
1800 BUTTON x,2
1810 routines$(x) = "y"
1820 GOTO 1610
1830 END IF
1840 END IF
1850 IF x = 2 THEN
1860 IF BUTTON (x) = 2 THEN
1870 BUTTON x,1
1880 routines$(x) = ""
1890 GOTO 1610
1900 END IF
1910 END IF
1920 IF x =3 THEN
1930 IF BUTTON (x) = 1 THEN
1940 BUTTON x,2
1950 BUTTON 1,2
1960 routines$(x) = "y"
1970 routines$(1) = "y"
1980 GOTO 1610
1990 END IF
2000 END IF
2010 IF x = 3 THEN
2020 IF BUTTON (x) = 2 THEN
2030 BUTTON x,1
2040 BUTTON 1,1
2050 routines$(x) = ""
2060 routines$(1)=""
2070 GOTO 1610
2080 END IF
2090 END IF
2100 IF x =4 THEN
2110 IF BUTTON (x) = 1 THEN
2120 BUTTON x,2
2130 routines$(x) = "y"
2140 GOTO 1610
2150 END IF
2160 END IF
2170 IF x = 4 THEN
2180 IF BUTTON (x) = 2 THEN
2190 BUTTON x,1
2200 routines$(x) = ""
2210 GOTO 1610
2220 END IF
2230 END IF
2240 IF x =5 THEN
2250 IF BUTTON (x) = 1 THEN
2260 BUTTON x,2
2270 routines$(x) = "y"
2280 GOTO 1610
2290 END IF
2300 END IF
2310 IF x = 5 THEN
2320 IF BUTTON (x) = 2 THEN
2330 BUTTON x,1
2340 routines$(x) = ""
2350 GOTO 1610
2360 END IF
2370 END IF
2380 IF x =6 THEN
2390 IF BUTTON (x) = 1 THEN
2400 BUTTON x,2
2410 routines$(x) = "y"
2420 GOTO 1610
2430 END IF
2440 END IF
2450 IF x = 6 THEN
2460 IF BUTTON (x) = 2 THEN
2470 BUTTON x,1
2480 routines$(x) = ""
2490 GOTO 1610
2500 END IF
2510 END IF
2520 IF x =7 THEN
2530 IF BUTTON (x) = 1 THEN
2540 BUTTON x,2
2550 routines$(x) = "y"
2560 GOTO 1610
2570 END IF
2580 END IF
2590 IF x = 7 THEN
2560 IF BUTTON (x) = 2 THEN
2570 BUTTON x,1
2580 routines$(x) = ""
2590 GOTO 1610
2600 END IF
2610 END IF
2620 IF x =8 THEN
2630 IF BUTTON (x) = 1 THEN
2640 BUTTON x,2
2650 routines$(x) = "y"
2660 GOTO 1610
2670 END IF
2680 END IF
2690 IF x = 8 THEN
2700 IF BUTTON (x) = 2 THEN
2710 BUTTON x,1
2720 routines$(x) = ""
2730 GOTO 1610
2740 END IF
2750 END IF
2760 IF x = 9 THEN
2770 BUTTON x,2
2780 END IF
2790 WEND
2800 WINDOW CLOSE 2
2810 backcolor 273
2820 forecolor 38
2830 TEXTFONT 8
2840 TEXTSIZE 20
3000 REM arrays for clipboard data
3010 DIM SHARED number(n%)
3020 DIM SHARED ancestor (n%)
3030 DIM SHARED fad(n%)
3040 DIM SHARED lod(n%)
3050 DIM SHARED ranges(n%)
3060 CLS
3070 REM transfers data from clipboard
3080 OPEN "clip:" FOR INPUT AS #1
3090 REM loops until all clipboard data moved
3100 WHILE NOT EOF(1)
3110 INPUT #1, a,b,c,d,e
3120 counter = counter+1
3130 number (counter) = a
3140 fad(counter) = b
3150 lod(counter) = c
3160 ranges(counter) = d
3170 ancestor(counter) = e
3180 WEND
3190 CLOSE #1
3200 REM dimensions arrays for time dependent routines
3210 slots = (start - ends)/timestep
3220 IF slots >= 12 AND slots >=n% THEN
3230 o = slots
3240 ELSEIF n% >= 12 AND n% >= slots THEN
3250 o = n%
3260 ELSE
3270 o = 12
3280 END IF
3290 REM output arrays for routines
3300 DIM SHARED in (o)
3310 DIM SHARED div (o)
3320 DIM SHARED sp (o)
3330 DIM SHARED ex (o)
3340 DIM SHARED rs (o)
3350 DIM SHARED re (o)
3360 DIM SHARED rd (o)
3370 DIM SHARED rt(o)
3380 DIM SHARED delt (o)
3390 DIM SHARED csss(o)
3400 DIM SHARED cep(n%)
3410 DIM SHARED fsss(o)
3420 DIM SHARED sur(o)
3430 DIM SHARED fep(n%)
3440 DIM SHARED ade$ (o)
3450 DIM SHARED ran (o)
3460 DIM SHARED ader$ (o)
3470 DIM SHARED ads$ (o)
3480 DIM SHARED adsr$ (o)
3490 DIM SHARED chi(o)
3500 IF routines$(1) = "y" THEN
3510 CALL metrics
3520 END IF
3530 REM arrays for dynamic survivorship
3540 DIM SHARED acvv(o)
3550 DIM SHARED ltvv (o)
3560 DIM SHARED vvf (o)
3570 DIM SHARED rvv (o)
3580 DIM SHARED epvv(o)
3590 IF routines$(2) ="y" THEN
3600 CALL vanvalen
3610 CALL epsteinvv
3620 END IF
3630 REM dimensions arrays for CSS
3640 DIM SHARED accss (o)
3650 DIM SHARED cssf(o)
3660 DIM SHARED ltc (o)
3670 DIM SHARED rcss (o)
3680 DIM SHARED epc(o)
3690 IF routines$(3) = "y" THEN
3700 REM calculate average rate of extinction for entire period for use in CSS
3710 FOR g = 1 TO slots
3720 sum = sum + re(g)
3730 NEXT g
3740 avre = sum/slots
3750 CALL CSS
3760 CALL csstable
3770 CALL epsteincss
3780 END IF
3790 REM set up arrays for FSS
3800 DIM SHARED cfss(o)
3810 DIM SHARED fssf(o)
3820 DIM SHARED ltf(o)
3830 DIM SHARED rfss(o)
3840 DIM SHARED epf(o)
3850 IF routines$(4) = "y" THEN
3860 CALL fss
3870 CALL fsstable
3880 CALL epsteinfss
3890 END IF
3900 IF routines$(5) = "y" THEN
3910 CALL adetest
3920 END IF
3930 IF routines$(6) = "y" THEN
3940 CALL random
3950 CALL adertest
3960 END IF
3970 IF routines$(7) = "y" THEN
3980 CALL adstest
3990 END IF
4000 IF routines$(8) = "y" THEN
4100 CALL adsrtest
4200 END IF
4210 CLS
4220 OPEN "clip:" FOR OUTPUT AS #1
4230 FOR z = 1 TO o
WRITE #1, in(z),div(z),sp(z),ex(z),rs(z),re(z),rd(z),rt(z),delt(z),acvv(z),vvf(z),ltvv(z),rvv(z),epvv(z),csss(z),accss(z), cssf(z),ltc(z),rcss(z),epc(z),fsss(z),sur(z),cfss(z),fssf(z),ltf(z),rfss(z),epf(z),ade$(z),ran(z),ader$(z), ads$(z),adsr$(z),chi(z)
4240 NEXT z
4250 CLOSE #1
42600 CLS
4270 REM output BOX
4280 SH=SYSTEM (6) 'height
4290 SW=SYSTEM (5) 'WIDTH
4300 h% = 250
4310 w% = 400
4320 WINDOW 2,"OUTPUT",((SW-w%)/1.5, (SH-h%)/1.5)-((SW-w%)/1.5 +w%, (SH-h%)/1.5+h%),1
4330 TEXTFONT 4 :TEXTSIZE 12: TEXTFACE(5): MOVETO 150,20:PRINT"OUTPUT"
4340 PRINT
4350 TEXTSIZE 10: TEXTFACE (0): PRINT "Follow this procedure to transfer your results to a spreadsheet."
4360 PRINT
4370 PRINT "1. Quit ADAPTS"
4380 PRINT "2. Open the spreadsheet package of your choice."
4390 PRINT "3. Once your worksheet is open use the PASTE command."
4400 BUTTON 1,1,"PROCEED", (150,225)-(240,245),1
4410 WHILE DIALOG(0)<>1 :WEND
4420 IF DIALOG (1)=1 THEN WINDOW CLOSE 2
5000 REM subroutines follow
5010 REM carries out diversity related calculations
5020 SUB metrics STATIC
5025 PRINT "calculating taxonomic evolutionary rates"
5030 SHARED n%,start,slots,in,timestep,div,sp,ex,rs,re,rd,rt,delt
5040 REM loop for each time step
5050 FOR loop = 1 TO slots
5060 interval = start -timestep*c
5070 REM activates diversity calculations
5080 w = w+1
5090 c=c+1
5100 in(w) = interval
5110 REM calculates absolute diversity
5120 diversity=0
5130 FOR taxa = 1 TO n%
5140 IF fad (taxa) =< interval AND fad (taxa) > interval-timestep THEN
5150 IF lod (taxa) >interval-timestep THEN
5160 diversity = diversity + (fad(taxa) - lod(taxa))*(1/timestep)
5170 END IF
5180 END IF
5190 IF fad (taxa) =< interval AND fad (taxa) > interval-timestep THEN
5200 IF lod (taxa) =< interval-timestep THEN
5210 diversity=diversity + (fad (taxa) - (interval-timestep))*(1/timestep)
5220 END IF
5230 END IF
5240 IF fad (taxa) > interval THEN
5250 IF lod (taxa) =< interval-timestep THEN
5260 diversity=diversity + (timestep)*(1/timestep)
5270 END IF
5280 END IF
5290 IF fad (taxa) > interval THEN
5300 IF lod (taxa) < interval AND lod (taxa) >interval-timestep THEN
5310 diversity=diversity + (interval - lod (taxa))*(1/timestep)
5320 END IF
5330 END IF
5340 NEXT taxa
5350 div(w) = diversity
5360 REM sums number of originations in interval
5370 origins =0
5380 FOR taxa= 1 TO n%
5390 IF fad(taxa)>interval-timestep AND fad(taxa)=5400 origins = origins +1
5500 ELSE
5510 origins = origins
5520 END IF
5530 NEXT taxa
5540 sp(w) = origins
5550 REM sums number of extinctions in each time interval
5560 extinctions = 0
5570 FOR taxa = 1 TO n%
5580 IF lod(taxa) < interval AND lod (taxa) >= interval-timestep THEN
5590 extinctions = extinctions +1
5600 ELSE
5610 ext = extinctions
5620 END IF
5630 NEXT taxa
5640 ex(w) = extinctions
5650 REM calculates rate of speciation
5660 IF diversity=0 THEN
5670 Rspec = 0
5680 ELSE
5690 Rspec = (1/diversity)*(origins/timestep)
5710 END IF
5720 rs(w) = Rspec
5730 REM calculates total rate of extinction
5740 IF diversity = 0 THEN
5750 Rext = 0
5760 ELSE
5770 Rext = (1/diversity)*(extinctions/timestep)
5780 END IF
5790 re(w) = Rext
5800 REM calculates the rate of diversification of taxa
5810 df= Rspec-Rext
5820 rd (w) = df
5830 REM calculates the turnover of taxa in each interval
5840 turn= Rspec+Rext
5850 rt(w) = turn
5860 REM calculates change in diversity per interval
5870 delta = diversity*df
5880 delt(w) = delta
5890 NEXT loop
5900 PRINT "taxonomic evolutionary rates completed"
5905 PRINT
5910 END SUB
6000 REM calculates lifetable and rates for van valen
6010 SUB vanvalen STATIC
6015 PRINT "calculating dynamic survivorship lifetable"
6020 SHARED n%,slots,ltvv,timestep,vvf,acvv,rvv
6030 REM calculates life table
6040 FOR class = 1 TO slots
6050 failures = 0
6060 acvv(class) = (class*timestep)-timestep
6070 FOR taxa = 1 TO n%
6080 IF ranges(taxa)>= (class*timestep) -timestep AND ranges (taxa)<class*timestep then<br="">6090 failures = failures + 1
6100 totals = totals+1
6110 ELSE
6120 failures = failures
6130 totals = totals
6140 END IF
6150 NEXT taxa
6160 vvf(class) = failures
6170 ltvv(class) = (n%-totals)+failures
6180 IF (n%-totals)+failures = 0 THEN
6190 rate = 0
6200 ELSE
6210 rate = failures/((n%-totals)+failures)
6200 END IF
6210 rvv (class) = rate
6220 NEXT class
6230 PRINT"dynamic survivorship lifetable completed"
6235 PRINT
6240 END SUB
6250 REM epstein's test for dynamic surviorship data
6260 SUB epsteinvv STATIC
6265 PRINT "calculating Epstein's Test (dynamic survivorship)"
6270 SHARED n%,epvv
6280 REM calculate total lives
6290 unsort = 0
6300 FOR i = 1 TO (n%-1)
6310 x = ranges(i)
6320 y = ranges (i+1)
6330 IF y6340 ranges(i+1) =x
6350 ranges(i) = y
6360 END IF
6370 NEXT i
6380 FOR i = 1 TO (n%-1)
6390 x = ranges(n%-i)
6400 y = ranges(n%+1-i)
6410 IF y6420 ranges(n%+1-i) = x
6430 ranges(n%-i) = y
6440 unsort = unsort+1
6450 END IF
6460 NEXT i
6470 IF unsort >0 THEN
6480 GOTO 6290
6490 END IF
6500 total = 0
6510 FOR ep = 1 TO n%
6520 IF (ep) = 1 THEN
6530 term = n%*ranges(1)
6540 END IF
6550 IF (ep) = 2 THEN
6560 term = ranges(1)+(n%-1)*ranges(2)
6570 END IF
6580 IF (ep) >2 THEN
6590 dsum = 0
6600 FOR j = 1 TO ep-1
6610 dsum = dsum + ranges(j)
6620 NEXT j
6630 term = dsum + (n%-ep+1)*ranges(ep)
6640 END IF
6650 total = total+term
6660 NEXT ep
6670 sum = total-term
6680 epvv (1) = sum
6690 mean = ((n%-1)*term/2)
6700 epvv (4) = mean
6710 sd = SQR(((n%-1)*(term^2))/12)
6720 epvv (5) = sd
6730 con = 1.96*sd
6740 epvv (6) =con
6750 ucl = mean+con
6760 epvv (3) = ucl
6770 lcl = mean - con
6780 epvv (2) = lcl
6790 PRINT "Epstein's Test (dynamic survivorship) completed"
6795 PRINT
6800 END SUB
7000 REM CSS CALCULATIONS
7010 SUB CSS STATIC
7015 PRINT "calculating CSS"
7020 SHARED n%,slots,start,timestep,csss,cep,avre
7030 FOR taxon = 1 TO n%
7040 FOR sum = 1 TO slots
7050 fract = 0
7060 value = 0
7070 interval = start-timestep*c
7080 IF fad(taxon)=interval-timestep THEN
7090 IF lod(taxon)>interval-timestep THEN
7100 fract = fract+(fad(taxon)-lod(taxon))
7110 END IF
7120 END IF
7130 IF fad (taxon)=< interval AND fad(taxon)>interval-timestep THEN
7140 IF lod(taxon)=7150 fract = fract+(fad(taxon)-(interval-timestep))
7160 END IF
7170 END IF
7180 IF fad(taxon)>interval THEN
7190 IF lod(taxon)=< interval-timestep THEN
7200 fract = fract+(timestep)
7210 END IF
7220 END IF
7230 IF fad(taxon)> interval THEN
7240 IF lod (taxon) < interval AND lod(taxon)>interval-timestep THEN
7250 fract =fract + (interval-lod(taxon))
7260 END IF
7270 END IF
7280 value = fract*re(sum)
7290 score = score+value
7300 c = c+1
7310 NEXT sum
7320 range = ranges(taxon)
7330 extant = score/range
7340 corrected = range*(extant/avre)
7350 csss(taxon) = corrected
7360 cep(taxon) = corrected
7370 score = 0
7380 c =0
7390 NEXT taxon
7400 PRINT "CSS completed"
7405 PRINT
7410 END SUB
7420 REM CREATES LIFETABLE FOR CSS DATA
7430 SUB csstable STATIC
7435 PRINT "calculating CSS lifetable"
7440 SHARED n%,slots,ltc,timestep,cssf,accss,rcss
7450 REM calculates life table
7460 FOR class = 1 TO slots
7470 fails = 0
7480 accss(class) = (class*timestep)-timestep
7490 FOR taxa = 1 TO n%
7500 IF csss(taxa)>= (class*timestep)-timestep AND csss (taxa)<class*timestep then<br="">7510 fails = fails + 1
7520 totals = totals+1
7530 ELSE
7540 fails = fails
7550 totals = totals
7560 END IF
7570 NEXT taxa
7580 ltc(class) = (n%-totals)+fails
7590 cssf(class) = fails
7600 IF (n%-totals)+fails = 0 THEN
7610 rate = 0
7620 ELSE
7630 rate = fails /((n%- totals)+fails)
7640 END IF
7650 rcss(class) = rate
7660 NEXT class
7670 PRINT "CSS lifetable completed"
7675 PRINT
7680 END SUB
7690 REM epstein's test for CSS data
7700 SUB epsteincss STATIC
7705 PRINT "calculating Epstein's Test (CSS)"
7710 SHARED n%,epc
7720 REM try to remove line numbers
7730 unsort = 0
7740 FOR i = 1 TO (n%-1)
7750 x = cep(i)
7760 y = cep (i+1)
7770 IF y7780 cep(i+1) =x
7790 cep(i) = y
7800 END IF
7810 NEXT i
7820 FOR i = 1 TO (n%-1)
7830 x = cep(n%-i)
7840 y = cep(n%+1-i)
7850 IF y7860 cep(n%+1-i) = x
7870 cep(n%-i) = y
7890 unsort = unsort+1
7900 END IF
7910 NEXT i
7920 IF unsort >0 THEN
7930 GOTO 7730
7940 END IF
7950 total = 0
7960 FOR ep = 1 TO n%
7970 IF (ep) = 1 THEN
7980 term = n%*cep(1)
7990 END IF
8000 IF (ep) = 2 THEN
8010 term = cep(1)+(n%-1)*cep(2)
8020 END IF
8030 IF (ep) >2 THEN
8040 dsum = 0
8050 FOR j = 1 TO ep-1
8060 dsum = dsum + cep(j)
8070 NEXT j
8080 term = dsum + (n%-ep+1)*cep(ep)
8090 END IF
8100 total = total+term
8110 NEXT ep
8120 sum = total-term
8130 epc(1) =sum
8140 mean = ((n%-1)*term/2)
8150 epc(4) =mean
8160 sd = SQR(((n%-1)*(term^2))/12)
8170 epc(5) = sd
8180 con = 1.96*sd
8190 epc(6) = con
8200 ucl = mean+con
8210 epc(3) = ucl
8220 lcl = mean - con
8230 epc (2) = lcl
8240 PRINT "Epstein's Test (CSS) completed"
8245 PRINT
8250 END SUB
8300 REM calculates ESS
8310 SUB fss STATIC
8315 PRINT "calculating ESS"
8320 SHARED n%,fsss,fep,sur
8330 FOR taxon = 1 TO n%
8340 fad = fad(taxon)
8350 lod =lod(taxon)
8360 suma=0
8370 sumb=0
8380 sumc=0
8390 count = 0
8400 d=0
8410 ds=0
8420 w=0
8430 sur = 0
8440 FOR taxa = 1 TO n%
8450 div = 0
8460 IF lod(taxa)==lod THEN
8470 comp =lod(taxa)
8480 FOR tax = 1 TO n%
8490 IF fad(tax)>=comp AND lod(tax) =< comp THEN
8500 div = div +1
8510 END IF
8520 NEXT tax
8530 di = div
8540 IF lod(taxa) = comp THEN
8550 FOR ta = 1 TO n%
8560 IF lod(ta) = comp THEN
8570 c=c+1
8580 END IF
8590 NEXT ta
8600 IF div=c AND c>1 THEN
8610 div = div-ds
8620 ds=ds+1
8630 IF div =< 0 THEN
8640 even = 0
8650 ELSEIF ds>c THEN
8660 even = 0
8670 ELSE
8680 even = (1/div)*(c-ds)
8690 END IF
8700 count = count+even
8710 suma = count/di
8720 sur = sur+(1/c*.5)*(c-1)
8730 ELSEIF lod(taxon) = comp AND c>1 THEN
8740 div = div-w
8750 w=w+1
8760 IF div =<0 THEN
8770 even =0
8780 ELSEIF w>c THEN
8790 even = 0
8800 ELSE
8810 even = (1/div)*(c-w)
8820 END IF
8830 count = count+even
8840 suma = count /c
8850 sur = sur+(1/c*.5)*(c-1)
8860 END IF
8870 IF lod(taxon) < comp AND c=1 THEN
8880 IF div=<0 THEN
8890 score = 0
8900 ELSE
8910 score =1/div
8920 END IF
8930 sumb =sumb+score
8940 sur = sur+1
8950 ELSEIF lod(taxon) < comp AND c>1 THEN
8960 high =0
8970 FOR phena = 1 TO n%
8980 IF lod(phena) = comp THEN
8990 nu = number (phena)
9000 IF nu > high THEN
9010 high = nu
9020 ELSE
9030 high = high
9040 END IF
9050 END IF
9060 NEXT phena
9070 IF taxa < high THEN
9080 score =0
9090 ELSEIF taxa = high THEN
9100 FOR f = 1 TO c
9110 score = 1/(div-d)
9120 d = d+1
9130 total = total+score
9140 NEXT f
9150 d = 0
9160 sur = sur+c
9170 END IF
9180 sumc = sumc+total
9190 total = 0
9200 END IF
9210 END IF
9220 END IF
9230 score = 0
9240 c = 0
9250 sum = suma+sumb+sumc
9260 NEXT taxa
9270 fsss(taxon) = sum
9280 fep (taxon) = sum
9290 sur(taxon) = sur
9300 NEXT taxon
9310 PRINT "ESS completed"
9315 PRINT
9320 END SUB
9400 REM creates FSS lifetable
9410 SUB fsstable STATIC
9415 PRINT "calculating ESS lifetable"
9420 SHARED n%,o,ltf,timestep,fssf,cfss,rfss
9430 REM calculates life table
9440 FOR class = 1 TO o
9450 failures = 0
9460 cfss(class) = (class*.1)-.1
9470 FOR taxa = 1 TO n%
9480 IF fsss(taxa)*10 >= class -1 AND fsss(taxa)*10< class THEN
9490 failures = failures + 1
9500 totals = totals+1
9510 ELSE
9520 failures = failures
9530 totals = totals
9540 END IF
9550 NEXT taxa
9560 fssf(class) = failures
9570 ltf(class) = (n%-totals)+failures
9580 IF (n%-totals)+failures = 0 THEN
9590 rate = 0
9600 ELSE
9610 rate = failures/((n%-totals)+failures)
9620 END IF
9630 rfss (class) = rate
9640 NEXT class
9650 PRINT"ESS lifetable completed"
9655 PRINT
9660 END SUB
9670 REM epstein's test for ESS data
9680 SUB epsteinfss STATIC
9685 PRINT "calculating Epstein's Test (ESS)"
9690 SHARED n%,epf
9700 unsort = 0
9710 FOR i = 1 TO (n%-1)
9720 x = fep(i)
9730 y = fep (i+1)
9740 IF y9750 fep(i+1) =x
9760 fep(i) = y
9770 END IF
9780 NEXT i
9790 FOR i = 1 TO (n%-1)
9800 x = fep(n%-i)
9810 y = fep(n%+1-i)
9820 IF y9830 fep(n%+1-i) = x
9840 fep(n%-i) = y
9850 unsort = unsort+1
9860 END IF
9870 NEXT i
9880 IF unsort >0 THEN
9890 GOTO 9700
9900 END IF
9910 FOR ep = 1 TO n%
9920 IF (ep) = 1 THEN
9930 sum = n%*fep(1)
9940 END IF
9950 IF (ep) = 2 THEN
9960 sum = fep(1)+(n%-1)*fep(2)
9970 END IF
9980 IF (ep) >2 THEN
9990 dsum = 0
10000 FOR j = 1 TO ep-1
10010 dsum = dsum + fep(j)
10020 NEXT j
10030 term = dsum + (n%-ep+1)*fep(ep)
10040 END IF
10050 total = total+term
10060 NEXT ep
10070 sum = total-term
10080 epf (1) = sum
10090 mean = ((n%-1)*term/2)
10100 epf(4) = mean
10110 sd = SQR(((n%-1)*(term^2))/12)
10120 epf (5) = sd
10130 con = 1.96*sd
10140 epf (6) = con
10150 ucl = mean+con
10160 epf (3) = ucl
10170 lcl = mean - con
10180 epf (2) = lcl
10190 PRINT "Epstein's Test (ESS) completed"
10195 PRINT
10200 END SUB
10300 SUB adetest STATIC
10310 SHARED ade$,n%,csq
10315 PRINT "calculating A-D extinction test"
10320 FOR taxa = 1 TO n%
10330 value = 0
10340 an = ancestor (taxa)
10350 IF an = 0 THEN
10360 valid = valid
10370 ade$(taxa) = "I"
10380 ELSE
10390 value = lod(taxa)-lod(an)
10400 END IF
10410 IF value <> 0 THEN
10420 valid = valid +1
10430 ELSEIF value = 0 AND an>0 THEN
10440 i = i +1
10450 ade$(taxa) = "E"
10460 END IF
10470 IF value > 0 THEN
10480 a = a +1
10490 ade$(taxa) = "A"
10500 END IF
10510 IF value < 0 THEN
10520 d = d +1
10530 ade$(taxa) = "D"
10540 END IF
10550 NEXT taxa
10560 REM chi squared routine
10570 ex = valid/2
10580 csq = ((a-ex)^2)/ex + ((d-ex)^2)/ex
10590 chi(1) = a
10600 chi(2) = d
10610 chi(3) = csq
10620 PRINT "A-D extinction test completed"
10625 PRINT
10630 END SUB
10700 REM creates random dataset
10710 SUB random STATIC
10715 PRINT "assigning random ancestors"
10720 SHARED n%, comp
10730 FOR rand = 1 TO n%
10735 comp = 0
10740 fad = fad (rand)
10750 an = ancestor(rand)
10760 IF an = 0 THEN
10770 ran (rand) = 0
10780 GOTO 10900
10790 ELSEIF anc >0 THEN
10800 RANDOMIZE TIMER
10810 comp = INT (RND*(n%-1)+.5)+1
10820 END IF
10830 IF comp = rand AND an > 0 THEN
10840 GOTO 10800
10850 ELSEIF fad(comp)>= fad AND fad >=lod(comp) THEN
10860 ran(rand) = comp
10870 ELSE
10880 GOTO 10800
10890 END IF
10900 NEXT rand
10910 PRINT "operation completed"
10915 PRINT
10920 END SUB
11000 REM PERFORMS A-D EXTINCTION TEST ON RANDOM DATA
11110 SUB adertest STATIC
11115 PRINT "calculating survivorship control test"
11120 SHARED ader$,n%,csq
11130 FOR taxa = 1 TO n%
11140 value = 0
11150 rand = ran (taxa)
11160 IF rand = 0 THEN
11170 valid = valid
11180 ader$(taxa) = "I"
11190 ELSE
11200 value = lod(taxa)-lod(rand)
11210 END IF
11220 IF value <> 0 THEN
11230 valid = valid +1
11240 ELSEIF value = 0 AND rand>0 THEN
11250 i = i +1
11260 ader$ (taxa) = "E"
11270 END IF
11280 IF value > 0 THEN
11290 a = a +1
11300 ader$(taxa) = "A"
11310 END IF
11320 IF value < 0 THEN
11330 d = d +1
11440 ader$ (taxa) = "D"
11450 END IF
11470 NEXT taxa
11480 REM chi squared
11490 ex = valid/2
11500 csq = ((a-ex)^2)/ex + ((d-ex)^2)/ex
11510 chi(4) = a
11520 chi(5) =d
11530 chi(6) = csq
11540 PRINT "survivorship control test completed"
11545 PRINT
11550 END SUB
11600 REM perfroms A-D speciation test
11610 SUB adstest STATIC
11615 PRINT "calculating A-D speciation test"
11620 SHARED n%,ads$,csq
11630 FOR taxon = 1 TO n%
11640 fad = fad(taxon)
11650 anc = ancestor(taxon)
11660 aanc = ancestor(anc)
11670 c=0
11680 FOR taxa =1 TO n%
11690 IF anc =ancestor(taxa) AND anc>0 THEN
11700 c =c+1
11710 END IF
11720 NEXT taxa
11730 REM defines A-D status
11740 IF anc = 0 THEN
11750 i = i+1
11760 ads$(taxon) = "I"
11770 END IF
11780 IF c = 1 THEN
11790 IF aanc>0 THEN
11800 d=d+1
11810 valid = valid+1
11820 ads$ (taxon)= "D"
11830 ELSEIF aanc = 0 THEN
11840 i=i+1
11850 ads$(taxon)= "I"
11860 END IF
11870 END IF
11880 IF c>1 THEN
11890 comp = 0
11900 high = 0
11910 FOR tax = 1 TO n%
11920 IF fad(tax)>=comp THEN
11930 IF anc = ancestor(tax) AND anc>0 THEN
11940 comp = fad(tax)
11950 high = tax
11960 END IF
11970 END IF
11980 NEXT tax
11990 IF comp>fad THEN
12000 a=a+1
12010 valid = valid+1
12020 ads$(taxon) = "A"
12030 END IF
12040 IF comp = fad AND taxon < high THEN
12050 a=a+1
12060 valid = valid +1
12070 ads$(taxon) = "A"
12080 ELSEIF comp = fad AND taxon = high THEN
12090 IF aanc > 0 THEN
12100 d=d+1
12110 valid = valid +1
12120 ads$(taxon) = "D"
12130 ELSEIF aanc = 0 THEN
12140 i=i+1
12150 ads$(taxon) = "I"
12160 END IF
12170 END IF
12180 END IF
12190 NEXT taxon
12200 REM chi squared
12210 ex = valid/2
12220 csq = ((a-ex)^2)/ex + ((d - ex)^2)/ex
12230 chi(7) = a
12240 chi(8) = d
12250 chi (9) =csq
12260 PRINT "A-D speciation test completed"
12265 PRINT
12270 END SUB
13000 REM A-D speciation test (restricted)
13010 SUB adsrtest STATIC
13015 PRINT "calculating A-D speciation test (restricted)"
13020 SHARED n%, adsr$,csq
13030 FOR taxon = 1 TO n%
13040 num = number (taxon)
13050 fad =fad (taxon)
13060 anc = ancestor (taxon)
13070 aanc = ancestor (anc)
13080 c = 0
13090 FOR taxa = 1 TO n%
13100 IF anc = ancestor (taxa) AND anc>0 THEN
13110 c= c+1
13120 END IF
13130 NEXT taxa
13140 REM define relationships
13150 IF anc = 0 THEN
13160 i = i+1
13170 adsr$ (taxon) = "I"
13180 END IF
13190 IF c = 1 THEN
13200 IF lod (anc)>fad OR lod(aanc)>fad THEN
13210 i = i +1
13220 adsr$(taxon) = "IE"
13230 END IF
13240 IF lod (anc)=< fad AND lod (aanc) =< fad THEN
13250 IF aanc>0 THEN
13260 valid =valid+1
13270 d = d+1
13280 adsr$(taxon)= "D"
13290 END IF
13300 END IF
13310 IF lod(anc)=13320 IF aanc = 0 THEN
13330 i = i +1
13340 adsr$ (taxon)= "I"
13350 END IF
13360 END IF
13370 END IF
13380 IF c>1 THEN
13390 pot = 0
13400 panc = 0
13410 difft = 1
13420 high =0
13430 comp = 0
13440 FOR ta = 1 TO n%
13450 IF anc =ancestor(ta) AND anc>0 THEN
13460 IF fad(ta)>=fad AND ta<>num THEN
13470 pot = pot+1
13480 diff = fad - fad(ta)
13490 IF diff < difft AND diff <> 0 THEN
13500 difft=diff
13510 ELSEIF diff = 0 THEN
13520 difft = 0
13530 END IF
13540 END IF
13550 END IF
13560 NEXT ta
13570 IF pot = 0 THEN
13580 panc = 0
13590 END IF
13600 IF pot = 1 AND difft < 0 THEN
13610 FOR z = 1 TO n%
13620 gap = fad-fad(z)
13630 IF gap = difft THEN
13640 IF ancestor(z) = anc AND anc>0 THEN
13650 panc = z
13660 END IF
13670 END IF
13680 NEXT z
13690 END IF
14700 IF pot =1 AND difft = 0 THEN
14710 FOR y = 1 TO n%
14720 IF ancestor(y) = anc AND anc>0 THEN
14730 gap = fad-fad(y)
14740 END IF
14750 IF gap = difft THEN
14760 IF y>num THEN
14770 panc = y
14780 ELSEIF y=< num THEN
14790 panc = 0
14800 END IF
14810 END IF
14820 NEXT y
14830 END IF
14840 IF pot > 1 AND difft < 0 THEN
14850 small =difft
14860 FOR p = 1 TO n%
14870 IF ancestor(p)=anc AND anc>0 THEN
14880 gap = fad-fad(p)
14890 END IF
14900 IF gap > small AND gap < 0 THEN
14910 small=gap
14920 END IF
14930 NEXT p
14940 FOR ps = 1 TO n%
14950 IF fad-fad(ps) = small THEN
14960 panc = ps
14970 END IF
14980 NEXT ps
14990 END IF
15000 IF pot >1 AND difft = 0 THEN
15010 FOR q = 1 TO n%
15020 IF fad(q) = fad THEN
15030 IF q>num THEN
15040 IF ancestor(q)=anc AND anc>0 THEN
15050 top = q
15060 END IF
15070 END IF
15080 END IF
15090 NEXT q
15060 IF num < top THEN
15070 panc = top
15080 ELSE
15090 hit = 0
15100 FOR e = 1 TO n%
15110 IF anc =ancestor(e) AND anc>0 THEN
15120 IF fad(e)>fad THEN
15130 hit =hit+1
15140 dif = fad - fad(e)
15150 IF dif < dift THEN
15160 dift=dif
15170 END IF
15180 END IF
15190 END IF
15200 NEXT e
15210 IF hit = 0 THEN
15220 panc = 0
15230 ELSE
15240 small =dift
15250 FOR p = 1 TO n%
15260 IF ancestor(p) = anc AND anc>0 THEN
15270 gap = fad-fad(p)
15280 END IF
15290 IF gap > small AND gap < 0 THEN
15300 small=gap
15310 END IF
15320 NEXT p
15330 FOR ps = 1 TO n%
15340 IF fad-fad(ps) = small THEN
15350 IF ancestor(ps) = anc AND ancestor>0 THEN
15360 panc = ps
15370 END IF
15380 END IF
15390 NEXT ps
15400 END IF
15410 END IF
15420 END IF
15430 FOR tax = 1 TO n%
15440 IF fad(tax)>=comp THEN
15450 IF anc = ancestor (tax) AND anc>0 THEN
15460 comp = fad(tax)
15470 high =tax
15480 END IF
15490 END IF
15450 NEXT tax
15460 IF comp>fad THEN
15470 IF lod (anc) >fad OR lod (panc)>fad THEN
15480 i= i+1
15490 adsr$(taxon) = "IE"
15500 ELSEIF lod(anc)=15510 valid =valid+1
15520 a=a+1
15530 adsr$(taxon)= "A"
15540 END IF
15550 END IF
15560 IF comp = fad AND taxon15570 IF lod (anc) >fad OR lod (panc)>fad THEN
15580 i= i+1
15590 adsr$(taxon) = "IE"
15600 ELSEIF lod (anc)=15610 valid=valid+1
15620 a = a+1
15630 adsr$ (taxon) = "A"
15640 END IF
15650 END IF
15660 IF comp=fad AND taxon = high THEN
15670 IF aanc = 0 THEN
15680 i = i+1
15690 adsr$ (taxon) = "I"
16000 END IF
16010 IF aanc>0 THEN
16020 IF lod (anc)=16030 valid=valid+1
16040 d = d+1
16050 adsr$ (taxon) = "D"
16060 ELSEIF lod (anc) > fad OR lod(aanc)> fad THEN
16070 i = i +1
16080 adsr$ (taxon) = "IE"
16090 END IF
16000 END IF
16010 END IF
16020 END IF
16030 NEXT taxon
16040 REM chi square
16050 ex = valid/2
16060 csq = ((a-ex)^2)/ex+((d-ex)^2)/ex
16070 chi (10) = a
16080 chi (11) = d
16090 chi(12) = csq
16100 PRINT "A-D speciation test (restricted) completed"
16110 END SUB
1
37
APPENDIX II
LISTING OF THE TREE GROWTH PROGRAM CODE
This code should be copied into a QuickBasic program file and run from there.
CLS
backcolor 273
forecolor 38
TEXTFONT 8
TEXTSIZE 50
MOVETO 0,50
PRINT "TREE GROWTH"
TEXTSIZE 20
PRINT "This program grows random trees of specified size for export into ADAPTS."
try=0: PRINT
INPUT "input maximum size of tree that is acceptable:", size
INPUT "input minimum size of tree that is acceptable:", min
5 DIM info(size, 3)
ext=0
try=try+1
counter=1
time=1
info(1,1) =1
10 IF counter-ext<>0 THEN GOTO 100
FOR p = 1 TO counter
info(p,1)=time-info(p,1)
info(p,2)=time-info(p,2)
NEXT p
IF counter>=min THEN
OPEN "clip:" FOR OUTPUT AS #1
FOR q = 1 TO counter
WRITE#1, q, info(q,1)/10, info(q,2)/10, info(q,1)/10-info(q,2)/10, info(q,3)
NEXT q
CLOSE #1
ELSEIF counterERASE info
GOTO 5
END IF
PRINT:PRINT:PRINT "Tree number";try;"became extinct with";counter;"species after";time/10"time increments":PRINT "and was accepted."
PRINT
PRINT "Now quit TREE GROWTH and paste the data into a spreadsheet"
END
100 FOR y= 1 TO counter
IF info(y,1)>0 AND info(y,2)>0 THEN
GOTO 200
END IF
IF info(y,1)>0 AND info(y,2)=0 THEN
RANDOMIZE TIMER
IF RND*100>99 THEN
counter=counter+1
IF counter > size THEN
ERASE info
GOTO 5
END IF
info(counter,1)=time
info(counter,3)=y
END IF
END IF
IF info(y,1)>0 AND info(y,2)=0 THEN
IF RND*100>99 THEN
info(y,2)=time
ext=ext+1
END IF
END IF
200 NEXT y
time=time+1
MOVETO 0,250
PRINT "attempt no."; try, "diversity"; counter-ext, "size so far"; counter;" "
GOTO 10
1
2
