# codeAbigeye1.r - Standard Likelihood and Akaike weight
# calculations for analysis of bigeye tuna data. In the
# comments and printed out to the console are direct chunks
# of text from our manusript, followed by the printout of the
# corresponding calculation from the code. So to check a
# calculation reported in the code, find the corresponding
# text in this file. To do analyses on other data sets, adapt
# this code. Includes R code for producing final .tiff
# file for PLoS ONE for Figure 1.
#
# Provided in the spirit of Barnes, N. (2010), Publish your computer
# code - it is good enough, Nature 467:753.
#
# Andrew Edwards, Andrew.Edwards@dfo-mpo.gc.ca .
# 25th June 2012.
# To see the code echoed in your console, run
# source("codeAbigeye1.r", echo=TRUE)
# R code extracted from my original Sweave file bigeyemle.Snw
# that was started on 13th October 2009.
rm(list=ls())
# require(xtable)
### R function definitions ###
# Negative log-likelihood function for power law distribution over
# infinite range (PL model). From equation (5) in Edwards et al.
# (2007), Nature 449:1044-1048. Note here using the negative
# log-likelihood to be minimised. [The 'raw' in the function name
# corresponds to using the raw data - earlier studies have required
# explicit likelihood functions that took into account the data
# collection methods (e.g. albatross data in 2007 paper), or
# analysing data that were already binned and not available 'raw'
# (e.g. bees data in 2007 paper)].
negloglpowlawrawinf = function(mu)
{
if(mu <= 1)
{stop("WARNING: Cannot have mu less than or equal to 1 for pow law over inf range")} # So change starting value
else # Negative log-likelihood is just:
{ -n * log(mu - 1) - n *(mu - 1) * log(a) + mu * sumlogx}
}
# Negative log-likelihood function for exponential distribution
# over infinite range (Exp model). From equation (6) in Edwards
# et al. (2007).
negloglexprawinf = function(lambda)
{ # Negative log-likelihood is just:
- n * log(lambda) - n * lambda * a + lambda * sumx
}
# Negative log-likelihood function for bounded power law
# distribution (PLB model). From equation (A.23) in Edwards (2011),
# Ecology 92:1247-1257.
negloglpowlawrawballmu = function(mu)
{ # Negative log-likelihood is:
if(mu == 1) # See equation (A.25) in Ecology paper.
{ n * log( log( b/a)) + sumlogx}
else
{ -n * log( (mu - 1) / (a^(1 - mu) - b^(1 - mu))) + mu * sumlogx}
# This works for mu<1 as well as mu>1
}
# Negative log-likelihood function for bounded exponential
# distribution (ExpB model). From equation (A.27) in
# Edwards (2011).
negloglexprawb = function(lambda)
{ # Negative log-likelihood is just:
- n * log(abs(lambda)) + n * log( abs( exp(- lambda * a) - exp( -lambda * b) ) ) + lambda * sumx # abs allows lambda < 0
}
# For printing output to screen (I normally use Sweave and it
# would go straight into a LaTeX file, but am sticking with R
# for simplicity to make this code available):
catPaste = function(x)
cat(paste(as.character(substitute(x)), "=", x), "\n")
### End R function definitions ###
### R parameter definitions ###
a = NA # Minimum of range of data over
# which to test model. Either
# predefine a here or use NA to
# test the full data set. For
# bigeye data, using minimum value
# as that's what was originally
# done.
if( is.na(a) ) {numparinf = 2} else
{numparinf = 1} # if a is min of data then
# estimating a and mu/lambda for
# unbounded models; numparinf is
# number of parameters estimated
# for unbounded (inf) models.
# Else if prescribing a then just
# mu is estimated.
numpar = numparinf + 1 # num of pars for bounded models
bround = TRUE # Whether to round b up. If TRUE
# then b=ceiling(max(rawvalsall))
# FALSE b= max(rawvalsall) [below].
# For bigeye data it doesn't matter
# as values are all integers.
# These are for numerical optimizations.
monthind = 1 # this was a monthly index for some previously
# analysed data for which some of the code
# was vectorised and loopable. Keep it in
# but it's just set to 1 for bigeye analysis.
# Similarly, these are vectors for generality.
# They are the starting value for optimisation
# and the start, end, and increments to use
# to generate values to calculate 95%
# confidence intervals.
mu.startinfvec = vector() # inf corresponds to unbounded
lambda.startinfvec = vector() # (infinite) models.
muvecinfstartvec = vector()
muvecinfendvec = vector()
muvecinfincvec = vector()
muvecstartvec = vector()
muvecendvec = vector()
muvecincvec = vector()
lambdaincvec = vector()
mu.start2vec = vector()
lambda.start2vec = vector()
xrankfreqinfmaxvec = vector()
# Initial starting values for finding MLE using nlm. Setting to
# close to what it eventually finds to avoid NA/Inf warnings, which
# can occur when initial gradient is too steep.
mu.startinfvec[1] = c(1.40)
lambda.startinfvec[1] = c(0.05)
mu.start2vec[1] = c(1.55)
# lambda.start2vec[1] - see below
# To define range of mu to try for inf, must be >1
muvecinfstartvec[1] = c(1.6)
muvecinfendvec[1] = c(1.8)
muvecinfincvec[1] = c(0.0001)
# for mu bounded.
muvecstartvec[1] = c(0.9)
muvecendvec[1] = c(1.7)
muvecincvec[1] = c(0.001)
# increment for lambda (0.5 and 2* mle)
lambdaincvec[1] = c(10^(-5))
xrankfreqinfmaxvec[1] = c(500) # must go to edge of rankfreq plot
### End of R parameter definitions ###
# bigeyeFigS2h.csv is the original data file from David Sims of
# 29,900 steps. It contains two columns: logstep and logrank.
# logstep is the log10 of the step size,
# logrank is the log10 of the rank of each step size.
# The steps were already sorted into descending order,
# with the largest step having a rank of 1 (logrank of 0)
# and the smallest step having a rank of 29,900
# (logrank of 4.475671).
# pseudoData.txt is the pseudo data file (that was obtained by
# sampling from the original step sizes with replacement to obtain a
# pseudo data set of the same size with similar properties, that
# can be made publicly available).
original.data = 0 # switch: 1 for original, 0 for pseudo
if(original.data)
{ bigeye = read.table(file="bigeyeFigS2h.csv", header=TRUE,
sep=",") } else
{ bigeye = read.table(file="pseudoBigeye.txt", header=TRUE,
sep=",")}
if(original.data)
{ print("Using original data") } else
{ print("**Note: using pseudo data so numbers will not exactly match published results**")}
if(original.data) { lambda.start2vec[1] = c(0.055600) } else
{ lambda.start2vec[1] = c(0.0557300) } # To avoid NA/Inf warnings
# dim(bigeye) # should be 29900 2
log10step = bigeye$logstep # step sizes between depths on log10
# scale
rawvalsall = 10^log10step # Raw unlogged data are step sizes
rawvalsall = rawvalsall[!is.na(rawvalsall)]
# include < a, remove NA's
rawvalsall = rawvalsall[rawvalsall > 0] # and remove zeros
# Doesn't affect bigeye values
if(bround) { b = ceiling(max(rawvalsall)) } else
{ b = max(rawvalsall) }
if( is.na(a) ) a = min(rawvalsall)
# else it's the value prescribed above
x = rawvalsall[rawvalsall >= a]
n = length(x)
if(n != 29900) stop("***Error here***")
# check sample size is correct
log10rank = bigeye$logrank # ranks on log10 scale
rank = 10^log10rank # ranks (data set is already sorted)
# Re-analysis using standard likelihood methods and Akaike weights
# Likelihood calculations.
# Range of mu to try for PL model, can't be <=1
muvecinf = seq(muvecinfstartvec[monthind], muvecinfendvec[monthind], muvecinfincvec[monthind])
# Range of mu to try for PLB model, can't be <=1
muvec = seq(muvecstartvec[monthind], muvecendvec[monthind], muvecincvec[monthind])
sumx = sum(x) # for negloglexprawb function
sumlogx = sum( log( x) ) # for negloglpowlawrawb function
# Need to use AIC or AICc consistently across all models,
# so decide here.
if(n/numparinf < 40 | n/numpar < 40)
# Then use AICc - p66 Burnham and Anderson (2002).
{ use.AICc = TRUE } else
{ use.AICc = FALSE} # Or stick with AIC
# PL model:
# Analytically (Box 1 of Edwards et al. 2007):
mumleinfanal = 1/( - log(a) + sumlogx/n) + 1
# maximum likelihood estimate for mu
# Numerically:
outpowlawinf = nlm(negloglpowlawrawinf, mu.startinfvec[monthind])
# , print.level=2)
mumleinf = outpowlawinf$estimate
negloglikmlepowlawinf = outpowlawinf$minimum
# negative log likelihood
# Check that analytical and numerical agree:
if( abs(mumleinf - mumleinfanal) >10^(-5))
{stop("Analytical and numerical disagree for PL model")}
# Normalisation constant:
Cpowlawinf = (mumleinf - 1) * a^(mumleinf - 1)
AICpowlawinf = 2 * negloglikmlepowlawinf + 2*numparinf
# will be +4 if est mu and a
if(use.AICc) # Small sample-size correction.
{ AICpowlawinf = AICpowlawinf + 2*numparinf*(numparinf+1)/( n - numparinf - 1)
print(paste("Using AICc for PL model, index ", monthind))
}
# From B&A p286:
BICpowlawinf = 2 * negloglikmlepowlawinf + numparinf * log(n)
# Now for 95% CI of MLE:
muvarynegloglikinf = vector() # negative log lik for each mu value
for(i in 1:length(muvecinf))
{
muvarynegloglikinf[i] = negloglpowlawrawinf(muvecinf[i])
}
critval1inf = negloglikmlepowlawinf + qchisq(0.95,1)/2
# 1 dof. Hilborn and Mangel (1997) p163.
muin95inf = muvecinf[ muvarynegloglikinf < critval1inf]
# mu values definitely in 95% confidence interval
minmuin95inf = min(muin95inf)
maxmuin95inf = max(muin95inf)
if(minmuin95inf == min(muvecinf) | maxmuin95inf == max(muvecinf))
{ windows()
plot(muvecinf, muvarynegloglikinf)
abline(h = critval1inf, col="red")
stop("WARNING: Need to make muvecinf larger, (but can't make min value <=1) - see R window")
}
# Now for Exp model.
# Analytically (Box 1, Edwards et al. 2007):
lambdamleinfanal = 1 / ( sumx/n - a) # MLE for lambda
outexpinf = nlm(negloglexprawinf, lambda.startinfvec[monthind])
# , print.level=2)
lambdamleinf = outexpinf$estimate
if( abs(lambdamleinf - lambdamleinfanal) >10^(-5))
{stop("Analytical and numerical disagree for Exp model")}
negloglikmleexpinf = outexpinf$minimum
Cexpinf = lambdamleinf * exp(lambdamleinf * a)
AICexpinf = 2 * negloglikmleexpinf + 2*numparinf
if(use.AICc) # Small sample-size correction.
{ AICexpinf = AICexpinf + 2*numparinf*(numparinf+1)/( n - numparinf - 1)
print(paste("Using AICc for Exp model, index ", monthind))
}
BICmleexpinf = 2 * negloglikmleexpinf + numparinf * log(n)
# B&A p286
# Now for 95% CI of MLE:
lambdavecinf = seq(round(0.5*lambdamleinf, digits=5), 2*lambdamleinf,lambdaincvec[monthind])
lambdavarynegloglikinf = vector()
# negative log lik for each lambda value
for(i in 1:length(lambdavecinf))
{
lambdavarynegloglikinf[i] = negloglexprawinf(lambdavecinf[i])
}
critval2inf = negloglikmleexpinf + qchisq(0.95,1)/2
# 1 dof. Hilborn and Mangel (1997) p163.
lambdain95inf = lambdavecinf[ lambdavarynegloglikinf < critval2inf]
#lambda values definitely in 95% confidence interval
if(min(lambdain95inf) == min(lambdavecinf) | max(lambdain95inf) == max(lambdavecinf))
{ windows()
plot(lambdavecinf, lambdavarynegloglikinf)
abline(h = critval2inf, col="red")
stop("WARNING: Need to make lambdavecinf larger -- see R window")
}
# Now for PLB model (bounded power law - denoted powlaw here):
outpowlaw = nlm(negloglpowlawrawballmu, mu.start2vec[monthind])
#, print.level=2)
mumle = outpowlaw$estimate
negloglikmlepowlaw = outpowlaw$minimum
Cpowlaw = (mumle - 1) / (a^(1-mumle) - b^(1-mumle))
AICpowlaw = 2 * negloglikmlepowlaw + 2*numpar
if(use.AICc) # Small sample-size correction.
{ AICpowlaw = AICpowlaw + 2*numpar*(numpar+1)/( n - numpar - 1)
print(paste("Using AICc for PLB, index ", monthind))
}
BICpowlaw = 2 * negloglikmlepowlaw + numpar * log(n) # B&A p286
# Now for 95% CI of MLE:
muvarynegloglik = vector() # negative log lik for each mu value
for(i in 1:length(muvec))
{
muvarynegloglik[i] = negloglpowlawrawballmu(muvec[i])
}
critval1 = negloglikmlepowlaw + qchisq(0.95,1)/2
# 1 dof. Hilborn and Mangel (1997) p163.
muin95 = muvec[ muvarynegloglik < critval1]
# mu values definitely in 95% confidence interval
minmuin95 = min(muin95)
maxmuin95 = max(muin95)
if(minmuin95 == min(muvec) | maxmuin95 == max(muvec))
{ windows()
plot(muvec, muvarynegloglik)
abline(h = critval1, col="red")
stop("WARNING: Need to make muvec larger - see R window")
}
# Now for ExpB model:
outexp = nlm(negloglexprawb, lambda.start2vec[monthind])
#, print.level=2)
lambdamle = outexp$estimate
negloglikmleexp = outexp$minimum
Cexp = lambdamle / (exp(- lambdamle * a) - exp( -lambdamle * b))
AICexp = 2 * negloglikmleexp + 2*numpar
if(use.AICc) # Small sample-size correction.
{ AICexp = AICexp + 2*numpar*(numpar+1)/( n - numpar - 1)
print(paste("Using AICc for ExpB, index ", monthind))
}
# From B&A p286
BICmleexp = 2 * negloglikmleexp + numpar * log(n)
# Now for 95% CI of MLE:
lambdavec = seq(round(0.5*lambdamle, digits=5), 2*lambdamle, lambdaincvec[monthind])
lambdavarynegloglik = vector()
# negative log lik for each lambda value
for(i in 1:length(lambdavec))
{
lambdavarynegloglik[i] = negloglexprawb(lambdavec[i])
}
critval2 = negloglikmleexp + qchisq(0.95,1)/2
# 1 dof. Hilborn and Mangel (1997) p163.
lambdain95 = lambdavec[ lambdavarynegloglik < critval2]
# lambda values definitely in 95% confidence interval
if(min(lambdain95, na.rm=TRUE) == min(lambdavec, na.rm=TRUE) | max(lambdain95, na.rm=TRUE) == max(lambdavec, na.rm=TRUE))
{ windows()
plot(lambdavec, lambdavarynegloglik)
abline(h = critval2, col="red")
stop("WARNING: Need to make lambdavec larger -- see R window")
}
# Akaike weights, from Burnham and Anderson (2002), summarised in
# Box 1 of Edwards et al. (2007).
AICall = c(AICpowlawinf, AICexpinf, AICpowlaw, AICexp)
AICmin = min(AICall)
Delta = AICall - AICmin
like = exp( - 0.5 * Delta)
Aweights = like/sum(like)
# Evidence ratio (I'd thought not so useful when just two
# models, but for four then worthwhile, as in Ecology paper, and
# values don't change with number of models).
evidenceratio = max(Aweights) / Aweights
xseq = seq(a, b, 0.01) # Plot higher resolution
xseqinf = seq(a, 1.2*b, 0.01) # Extra range to plot unbounded
xrankfreqinf = seq(a, xrankfreqinfmaxvec[monthind], length=1000*1.1)
yrankfreqpowinf = (a / xrankfreqinf)^(mumleinf - 1) *n
# Doing [a,infty)
yrankfreqexpinf = exp( lambdamleinf * a) * exp( - lambdamleinf * xrankfreqinf) * n
# For bounded:
xrankfreq = seq(a, b, length=1000)
yrankfreqpow = (xrankfreq^( 1 - mumle) - b^(1 - mumle)) / (a^(1 - mumle) - b^(1 - mumle) ) * n
yrankfreqexp = ( exp( - lambdamle * xrankfreq) - exp( - lambdamle * b) ) / ( exp( - lambdamle * a) - exp( - lambdamle * b) ) * n
# Figure 1. Rank/fequency plots in two panels. First on logarithmic
# axes, and second on linear. Same colour scheme as Ecology
# paper - blue/red and dashed/solid
if(original.data) {fig.name = "figure1orig"} else
{fig.name= "figure1pseudo"}
# postscript, for inclusion in LaTeX for submission.
postscript(paste(fig.name, ".eps", sep=""), horizontal=FALSE, paper="special", height = 8, width = 4+0.4)
# + 0.4 otherwise it cuts off 500 when printing
par(mfrow=c(2,1))
oldmai = par("mai") # 1.02 0.82 0.82 0.42 for two figs
# think may be indpt of fig size
par(mai = c(0.65 - 0.1, 0.82, 0.1 + 0.5, 0.42+0.4))
# so keep left and right the same, then 0.1 is taken off bottom here (as no x label) and taken off top of second figure. Adding 0.5 to top of this and bottom of second one and 1 inch to toal height so it prints out okay. + 0.4 for final one is so it doesn't cut off 100 when printing.
plot(sort(x, decreasing=TRUE), 1:n, log="xy", ylab=expression( paste("Number of ", moves >= x)), xlab="", xlim=c(2, 500), ylim=c(0.8, 40000), axes=FALSE, xaxs="i", yaxs="i", mgp=c(2.0,0.5,0))
# Add tick marks correctly:
ll = 1:9
log10ll = log10(ll)
axis(1, at=c(1, 10, 100, 1000, 10000), labels = c(1, 10, 100, 1000, 10000), mgp=c(1.7,0.7,0))
axis(1, at=2, labels=2, mgp=c(1.7,0.7,0))
axis(1, at=c( ll*0.1, ll, ll*10, ll*100), labels=rep("",36), tcl=-0.2)
axis(2, at=c(1, 10, 100, 1000, 10000), labels=c(1, 10, 100, 1000, 10000), mgp=c(1.7,0.7,0))
axis(2, at=c(ll*0.1, ll, ll*10, ll*100, ll*1000, ll*10000), labels=rep("",54), tcl=-0.2)
# text( 10^( log10(100) * figlabpos + log10(1) ), 90, "(b)") # - fill in these numbers. 10^( log10(120/0.8) * figlabpos + log10(0.8)) was y value = 93.4
box()
lines(xrankfreqinf, yrankfreqpowinf, col="blue")
lines(xrankfreq, yrankfreqexp, col="red", lty=5)
# put here to get covered up by red solid
lines(xrankfreqinf, yrankfreqexpinf, col="red")
lines(xrankfreq, yrankfreqpow, col="blue", lty=5)
figlabpos = 0.95 # proportion of x and y axis lengths to put (a)
# etc. in the corner of
text(380, 25000, "A", font=2) # text(figlabpos*2, 1.1, "(a)")
par(mai = c(0.65 + 0.5, 0.82, 0.1 - 0.1, 0.42+0.4))
# shifting up for this figure
plot(sort(x, decreasing=TRUE), 1:n, ylab=expression( paste("Number of ", moves >= x)), xlab="Movement length, x (m)", xlim=c(-5, 500), ylim=c(-500, 32500), axes=FALSE, xaxs="i", yaxs="i", mgp=c(2.0,0.5,0))
axis(1, at=c(0, 100, 200, 300, 400, 500), labels =c(0, 100, 200, 300, 400, 500), mgp=c(1.7,0.7,0))
axis(1, seq(0, 500, 25), labels=rep("",21), tcl=-0.2)
axis(2, at=c(0, 10000, 20000, 30000), labels=c(0, 10000, 20000, 30000), mgp=c(1.7,0.7,0))
axis(2, at=seq(0, 32500, 2500), labels=rep("",14), tcl=-0.2)
box()
lines(xrankfreqinf, yrankfreqpowinf, col="blue")
lines(xrankfreq, yrankfreqexp, col="red", lty=5)
# put here to get covered up by red
lines(xrankfreqinf, yrankfreqexpinf, col="red")
lines(xrankfreq, yrankfreqpow, col="blue", lty=5)
text(figlabpos*500, 0.95*32500, "B", font=2)
dev.off()
# Figure 1 again.
# R code for tiff file for PLoS ONE publication (resized to
# PLoS ONE guidelines, and compressed tiff).
tiff(paste(fig.name, ".tiff", sep=""), height = 6.1, width = 3.25,
units="in", res=400, compression="lzw") # think res is dpi
par(mfrow=c(2,1))
# These were for original postscript submission:
oldmai = par("mai") # 1.02 0.82 0.82 0.42 for two figs
# think may be indpt of fig size
# par(mai = c(0.65 - 0.1, 0.82, 0.1 + 0.5, 0.42+0.4))
# so keep left and right the same, then 0.1 is taken off bottom here (as no x label) and taken off top of second figure. Adding 0.5 to top of this and bottom of second one and 1 inch to toal height so it prints out okay. + 0.4 for final one is so it doesn't cut off 100 when printing.
maivalsA = c(0.5, 0.6, 0.12, 0.18)
par(mai = maivalsA)
plot(sort(x, decreasing=TRUE), 1:n, log="xy", ylab=expression( paste("Number of ", moves >= x)), xlab="", xlim=c(2, 500), ylim=c(0.8, 40000), axes=FALSE, xaxs="i", yaxs="i", mgp=c(2.0,0.5,0))
# Add tick marks correctly:
ll = 1:9
log10ll = log10(ll)
axis(1, at=c(1, 10, 100, 1000, 10000), labels = c(1, 10, 100, 1000, 10000), mgp=c(1.7,0.7,0))
axis(1, at=2, labels=2, mgp=c(1.7,0.7,0))
axis(1, at=c( ll*0.1, ll, ll*10, ll*100), labels=rep("",36), tcl=-0.2)
axis(2, at=c(1, 10, 100, 1000, 10000), labels=c(1, 10, 100, 1000, 10000), mgp=c(1.7,0.7,0))
axis(2, at=c(ll*0.1, ll, ll*10, ll*100, ll*1000, ll*10000), labels=rep("",54), tcl=-0.2)
# text( 10^( log10(100) * figlabpos + log10(1) ), 90, "(b)") # - fill in these numbers. 10^( log10(120/0.8) * figlabpos + log10(0.8)) was y value = 93.4
box()
lines(xrankfreqinf, yrankfreqpowinf, col="blue")
lines(xrankfreq, yrankfreqexp, col="red", lty=5)
# put here to get covered up by red solid
lines(xrankfreqinf, yrankfreqexpinf, col="red")
lines(xrankfreq, yrankfreqpow, col="blue", lty=5)
figlabpos = 0.95 # proportion of x and y axis lengths to put (a)
# etc. in the corner of
text(380, 25000, "A", font=2) # text(figlabpos*2, 1.1, "(a)")
# par(mai = c(0.65 + 0.5, 0.82, 0.1 - 0.1, 0.42+0.4))
# shifting up for this figure
vertshift = maivalsA[3] # shift top and margin by the same
maivalsB = maivalsA + c(vertshift, 0, -vertshift, 0)
par(mai = maivalsB)
plot(sort(x, decreasing=TRUE), 1:n, ylab=expression( paste("Number of ", moves >= x)), xlab="Movement length, x (m)", xlim=c(-5, 500), ylim=c(-500, 32500), axes=FALSE, xaxs="i", yaxs="i", mgp=c(2.0,0.5,0))
axis(1, at=c(0, 100, 200, 300, 400, 500), labels =c(0, 100, 200, 300, 400, 500), mgp=c(1.7,0.7,0))
axis(1, seq(0, 500, 25), labels=rep("",21), tcl=-0.2)
axis(2, at=c(0, 10000, 20000, 30000), labels=c(0, 10000, 20000, 30000), mgp=c(1.7,0.7,0))
axis(2, at=seq(0, 32500, 2500), labels=rep("",14), tcl=-0.2)
box()
lines(xrankfreqinf, yrankfreqpowinf, col="blue")
lines(xrankfreq, yrankfreqexp, col="red", lty=5)
# put here to get covered up by red
lines(xrankfreqinf, yrankfreqexpinf, col="red")
lines(xrankfreq, yrankfreqpow, col="blue", lty=5)
text(figlabpos*500, 0.95*32500, "B", font=2)
dev.off()
# End Figure 1
# For Table 1, just comparing PL and Exp, so calculate here to get
# precisely:
# Table 1a: Properly defined Akaike weights \cite{ba02}, calculated here from the raw data (all individuals pooled together) using the equations in Box 1 of \cite{edwa07}. Respective log-likelihoods are $-118,126$ and $-116,297$, giving Akaike Information Criteria of 236,256 and 232,599.
print("Table 1a caption - for PL and Exp models, log-likelihoods and AIC values are:")
print(c(-negloglikmlepowlawinf, -negloglikmleexpinf))
AIC2all = c(AICpowlawinf, AICexpinf)
print(AIC2all)
AIC2min = min(AIC2all)
Delta2 = AIC2all - AIC2min
like2 = exp( - 0.5 * Delta2)
Aweights2 = like2/sum(like2)
print("with resulting Akaike weights of 0 and 1 as in the Table:")
print(Aweights2)
# Main text: For ease of comparison with the results of \cite{sims08}, that did not consider bounded models, in Table 1 we only present our calculated Akaike weights for the unbounded models; when comparing all four models in the order listed in (\ref{PLeqn})-(\ref{ExpBeqn}), the Akaike weights are 0, 0.73, 10$^{-189}$ and 0.27, such that bounded power law also has no support (Akaike weight of 10$^{-189}$).
print("From main text, the Akaike weights for all four models (PL, Exp, PLB, ExpB) considered together:")
print(Aweights)
# Not printing these out, but gives full details:
# The log-likelihood values for the four models are:
# loglikall = -c(negloglikmlepowlawinf, negloglikmleexpinf, negloglikmlepowlaw, negloglikmleexp)
# print(loglikall)
# The AIC values for the four models are:
# print(AICall)
# giving AIC differences $\Delta_i = AIC_i - AIC_{min}$
# print(Delta)
# and relative likelihoods e$^{-\Delta_i / 2}$
# print(like )
# giving Akaike weights
# print(Aweights)
# and evidence ratios
# print(evidenceratio)
print("**From the Methods: Full calculations of Bayesian weights**")
# For method {\bf e} in Table 1, Bayesian, rather than Akaike, weights were calculated in \cite{sims08}. Bayesian weights are calculated similarly to Akaike weights (e.g.~page 290 of \cite{ba02}), but use the Bayesian Information Criterion (BIC) in place of AIC. The BIC is calculated from the log-likelihood of a model as
# \mbox{BIC} = - 2 \log( \mbox{likelihood}) + K \log{n},
# where $n$ is the sample size and $K$ is the number of parameters being estimated \cite{ba02}. Whereas AIC is calculated as
# \mbox{AIC} = - 2 \log( \mbox{likelihood}) + 2 K.
# Using the log-likelihood values given in Table 1 for the PL and Exp models, we calculate respective BIC values of 236,272 and 232,615, giving Bayesian weights of 0 and 1, the same as the Akaike weights in Table 1. Thus, Bayesian and Akaike weights give the same results, and so we used Akaike weights (as were mostly used in \cite{sims08}).
# Comparing correct BIC values and Bayesian weights for
# all four models (not printing results)
# Need ..mle everywhere as later use BICmin etc. for the original
# regression based calculations.
BICmleall = c(BICpowlawinf, BICmleexpinf, BICpowlaw, BICmleexp)
BICmlemin = min(BICmleall)
DeltaBICmle = BICmleall - BICmlemin
likeBICmle = exp( - 0.5 * DeltaBICmle)
Bmleweights = likeBICmle/sum(likeBICmle)
# Comparing BIC values and Bayesian weights for just PL and Exp models:
BIC2mleall = c(BICpowlawinf, BICmleexpinf)
BIC2mlemin = min(BIC2mleall)
DeltaBIC2mle = BIC2mleall - BIC2mlemin
likeBIC2mle = exp( - 0.5 * DeltaBIC2mle)
B2mleweights = likeBIC2mle/sum(likeBIC2mle)
print("Using the log-likelihood values given in Table 1 for the PL and Exp models, we calculate respective BIC values of 236,272 and 232,615, giving Bayesian weights of 0 and 1, the same as the Akaike weights in Table 1.")
print(BIC2mleall)
print(B2mleweights)
# End of Figure 1 caption:
print("Our Akaike weight analysis found the exponential distribution to be the most supported model, but goodness-of-fit tests, using the two alternative binning methods described in Edwards (2011), both yield $P=0$ (with respective degrees of freedom of 82 and 6 and goodness-of-fit values of 41,532 and 4,589). Thus the data are not consistent with the exponential distribution:")
print("**Goodness-of-fit binning method 1**")
# Binning method 1, as described in Edwards (2011), Appendix page 3:
# For goodness-of-fit tests, we used the G-test with Williams's correction (Sokal and Rohlf 1995), as in Edwards et al. (2007). This requires binning of data (unless the data were only available in binned form). The consistent approach taken here was to start binning data from the smallest value using a bin width of 1. The G-test requires each bin to have >= 5 data points. Thus once a bin was reached that had < 5 data points, the bin width was doubled to 2. Bin widths of 2 were used until a bin had < 5 data points, and then the bin width doubled to 4. This doubling of bin widths was continued until all data were included. If the final bin had < 5 data points, then the penultimate bin was expanded to include the final bin.
# Have to determine the bins manually (I haven't tried to automate,
# though it's actually useful to look so carefully at the data).
# So do this by stopping the program here, and doing the following
# commands on the command the line, and iteratively adjust the
# bin breaks (starting from smallest bin) in accordance with the
# above procedure.
# breaksgood1 will be the breakpoints for goodness-of-fit test using
# method 1. Start with:
# Start with:
# breaksgood1 = c(a, a+1:50, b); hist(x, breaks=breaksgood1, right=FALSE)$counts
# Using right=FALSE, so bins are [xx,xx) for bigeye, as the data
# are integer valued. Otherwise bins would be (xx,xx] and you'd
# get all the 3's and 4's in first bin [3,4], as a=3.
# That command gives:
# [1] 1737 2974 1089 1184 773 5668 481 551 296 875 213 287 168 3627 142
# [16] 226 101 358 88 166 61 2131 53 107 45 249 30 84 22 1233
# [31] 15 50 18 97 10 31 11 750 5 25 2 69 8 14 2
# [46] 702 0 13 1 67 2991
# Can see that we get some bins towards the end with counts <5. So
# find the first one and double the subsequent bin widths. Keep
# doing this results in the following intermediate calculations:
# > hist(x[x>=241], breaks=a+seq(238, b+16, 16), right=FALSE)$counts
# [1] 1 3 1 0 0 2 0 1 0 0 2 2
#
# > hist(x[x>=241], breaks=a+seq(238, b+16, 32), right=FALSE)$counts
# [1] 4 1 2 1 0 4
# > hist(x[x>=241], breaks=a+seq(238, b+64, 64), right=FALSE)$counts
# [1] 5 3 4 so one bin of 64 and lump last two together
#
# End up with:
# breaksgood1 = c(a, a+1:40, a+seq(42, 78, 2), a+seq(82, 126, 4), a+seq(134, 206, 8), a+seq(222, 238, 16), a+238+64, b); ww = hist(x, breaks=breaksgood1, right=FALSE)$counts; print(ww); min(ww)
# [1] 1737 2974 1089 1184 773 5668 481 551 296 875 213 287 168 3627 142
#[16] 226 101 358 88 166 61 2131 53 107 45 249 30 84 22 1233
#[31] 15 50 18 97 10 31 11 750 5 25 71 22 704 13 68
#[46] 12 589 12 52 8 559 13 39 9 379 6 15 8 298 19
#[61] 218 21 165 14 142 14 79 12 44 5 64 40 47 18 18
#[76] 7 9 10 7 8 7 7 5 5 7
# [1] 5
# End up needing
breaksgood1 = c(a, a+1:40, a+seq(42, 78, 2), a+seq(82, 126, 4), a+seq(134, 206, 8), a+seq(222, 238, 16), a+238+64, b)
# diff(breaksgood1)
# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
# 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
# 2 2 4 4 4 4 4 4 4 4 4 4 4 4 8 8 8 8 8
# 8 8 8 8 8 16 16 64 118
# Note that some of these will get overwritten for the second
# binning algorithm.
hgoodness = hist(x, breaks=breaksgood1, right=FALSE, plot=FALSE)
observed = hgoodness$counts # observations in each bin
if(sum(observed) != n) { stop("Something wrong with hgoodness")}
numbins = length(breaksgood1) - 1 # number of bins
breaksgood = breaksgood1
source("codeCgoodness.r") # Should really make this a function,
# and not have variables like observed
# overwritten for different bin width
# specification (I usually have a
# separate file for goodness-of-fit
# calculations and do it all in Sweave).
print("**Goodness-of-fit binning method 2**")
# Binning method 2 (from Edwards 2011, Appendix page 3):
# Our main interest is in questioning support for power-law distributions. For the eight data sets for which a bounded power-law distribution was the most supported model, only one passed the goodness-of-fit test (grey seal 6124, Table 3). To see whether the choice of bin width affected the rejection of the bounded power law, we performed an additional goodness-of-fit test on all eight data sets. Instead of the procedure described above, we defined bins as follows: start the first bin from the smallest value using a bin width of one, then double the width of each successive bin. Thus the bin widths were 1, 2, 4, 8, ... . If a bin had < 5 data points then its width was doubled. The doubling of bin widths was continued until all data were included. As above, if the final bin had < 5 data points, then the penultimate bin was expanded to include the final bin.
# Again using right=FALSE, so bins are [xx,xx) for bigeye data.
# Use when working out:
# breaksgood = c(a, a + cumsum(2^(0:7)), b); ww = hist(rawvals, breaks=breaksgood, right=FALSE)$counts; print(ww); min(ww)
# Started with 0:8 but that overshoots, but end up with 0:7
# being fine, and giving:
# [1] 1737 4063 8106 6159 4969 3108 1563 184 11
# [1] 11
# > breaksgood
# [1] 3 4 6 10 18 34 66 130 258 423
# > diff(breaksgood)
# [1] 1 2 4 8 16 32 64 128 165
breaksgood2 = c(a, a + cumsum(2^(0:7)), b)
hgoodness = hist(x, breaks=breaksgood2, right=FALSE, plot=FALSE)
observed = hgoodness$counts # observations in each bin
if(sum(observed) != n) { stop("Something wrong with hgoodness")}
numbins = length(breaksgood1) - 1 # number of bins
breaksgood = breaksgood2
source("codeCgoodness.r")
# Save workspace
if(original.data) {save.image(file = "codeAbigeye1orig.RData")} else
{save.image(file = "codeAbigeye1pseudo.RData")}