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