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)=<interval THEN

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

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 y<x THEN

6340        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 y<x THEN

6420        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 AND 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)=<interval-timestep THEN

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

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 y<x THEN

7780        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 y<x THEN

7860        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)=<fad AND 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 y<x THEN

9750            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 y<x THEN

9830            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)=<fad AND lod (aanc)=< fad THEN

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)=<fad AND lod (panc)=<fad THEN

15510            valid =valid+1

15520            a=a+1

15530            adsr$(taxon)= "A"

15540        END IF

15550    END IF

15560    IF comp = fad AND taxon<high THEN

15570        IF lod (anc) >fad OR lod (panc)>fad THEN

15580            i= i+1

15590            adsr$(taxon) = "IE"

15600        ELSEIF lod (anc)=<fad AND lod(panc)=<fad THEN

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)=<fad AND lod(aanc)=<fad THEN

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