# Models written by Brice X. Semmens, 4-13-11
# Intro...
## This model generates probabilies of sharks being in 3 major ocean regions (CAL, PEL, HAW) by date
# based on tagging data, and ties these probabilities to trophic information based on a stable
# isotope mixing model that estimates regional diet composition resulting from movements among these regions
# using isotope tissue half life estimates.
# For halflife (tissue turn over) this model uses the allometrically scaled estimates from birds
# --> Allometrically scaled bird rate (Carleton and Martinez del Rio 2005): 258 d (46.4 SD, 10.4 SE)
# so HL (50%) is 258 days, and 5% (95% turnover) is 1115 days
# first let's bring in the white shark tag data ######################################################
# the file whiteshark_tag_data.txt contains the following format...
#shark date CA PEL HI
#tag 1 305 1 0 0
#tag 1 306 1 0 0
#tag 1 307 1 0 0
#tag 1 308 1 0 0
#tag 1 309 1 0 0
# etc.
# where shark indicates a unique tag id, date indicates the julian day of year
#starting at date of tagging (and increasing from that date, so a tag with 100 days of data
# deployed on julian date 305 would end on date 405), and the CA
# PEL and HI columns indicate the location (in which region) the tag was in on a given day.
SharkDat<- read.table("whiteshark_tag_data.txt", header = TRUE, sep = "\t")
SharkNames<-unique(SharkDat$shark) #list of all sharks
# make the days 365, and no more
SharkDat$date[which(SharkDat$date>365)]<-SharkDat$date[which(SharkDat$date>365)] - 365
#now make the first day 320 (Nov 16th) -- this just done for the sake of smoothness in polynomial fit later.
Dattemp<-SharkDat$date
Dattemp[which(SharkDat$date<320)]<-SharkDat$date[which(SharkDat$date<320)]+46
Dattemp[which(SharkDat$date>319)]<-SharkDat$date[which(SharkDat$date>319)]-319
SharkDat$date<-Dattemp
dates<-sort(unique(SharkDat$date)) #list of all dates (NOTE: not all sharks were heard on all days!!)
N.sharks<-length(SharkNames)
N.days<- length(dates) #all days in year
#set up tissue loading stuff
t.tot.days<-1115 #total days to calc tissue loading (when 5% of tissue is left)
# note that the above value should equal the number of rows in the s.days matrix (imported below)
#now let's specify the isotope data ##################################################################
HL<- 258 # Shark isotope tissue half life
num.iso<-2 #number of isotopes we have data for
num.prey<-3 #how many prey regions do we have (CAL, PEL, HAW)
prey.mean<-matrix(c(-15.81,-18.58,-17.08,17.27,12.26,11.89),nrow=3)
prey.sd<-matrix(c(0.585,0.368,0.440,1.444,1.946,0.628),nrow=3)
sigma2<-prey.sd^2 #prey variance
frac.mean<-matrix(c(1.70,3.70),nrow=2)
frac.sd<-matrix(c(0.50,0.40),nrow=2)
fracSig2<-frac.sd^2
#let's add in fractionation now, so don't have to deal with in the model
prey.mean[,1]=prey.mean[,1]+frac.mean[1]
prey.mean[,2]=prey.mean[,2]+frac.mean[2]
sigma2[,1]=sigma2[,1]+fracSig2[1]
sigma2[,2]=sigma2[,2]+fracSig2[2]
#Following data are example data
pred<-matrix(c(-15.6,-16.1,-15.8,-15.4,-14.9,-15.4,-15.2,-15.6,-15.2,-15.1,
-15.6,-15.3,-15.0,-15.5,-14.3,-14.4,-15.3,-16.2,-16.7,-15.0,-15.4, 17.9,17.8,
18.2,18.8,18.1,17.5,17.6,18.3,18.4,17.6,19.1,17.2,17.4,18.0,20.9,21.8,17.8,
18.3,17.9,19.3,17.9),nrow=21)
# Now bring in the adjusted dates for the iso sharks (Nov 16 =1, etc), these start at the date of tissue sample, and walk backward for
# the number of days it takes to reach 95% turnover (1115 days as rows, sharks as cols). These days
# are used to mesh the shark iso signatures with those expected based on the polynomial describing shark location
#probabilities by date. FYI - This is clunky and could be done better, but it works.
# This information is in the file s.days.bird.allo.txt which is in the following format: rows are modified julian days
#(see above, we used a modfied start date of Nov. 16 but this is not necessary) starting at date of tissue sampling
#and extending back from that date, and columns are sharks for which you have tissue samples...
#shark1 shark2 shark 3 .... etc...
#305 318 4
#306 317 3
#307 316 2
#308 315 1
#309 314 365
# etc...
# number of rows equals the desired length of time or number of tissue half-lives to which you wish to backcalculate
#(e.g. 4 half-lives or ~94% turnover, we used 1115 days), note that unlike whiteshark_tag_data.txt (which start
#at date of tagging and extend forward in time for the length of the tag deployment, e.g. a switch from one year to the next results
#in julian dates going from 365 to 366) the julian dates in this file are all between 1 and 365 so walking back from
#one year to the previous results in the julian date going from 1 to 365
s.days<- as.matrix(read.table("s.days.bird.allo.txt", header = FALSE, sep = "\t"))
n.pred<-dim(s.days)[2] #how many fish do we have iso data for?
#now we want to bin shark locations (CAL,PEL,HAW) by date:
locations<-array(0,dim=c(N.days,4))#first make matrix to fill
locations[,1]<-dates #fill days into the first column
for (i in 1:N.sharks){
d<-SharkDat[which(SharkDat$shark==SharkNames[i]),] #pull out each shark's data in turn
d<-d[sort.list(d$date), ] #put the data in order of date
for (j in 1:(dim(d)[1])){
for (z in 2:4){ #how many fish are in each location on each day?
locations[which(locations[,1]==d$date[j]),z] = locations[which(locations[,1]==d$date[j]),z] + d[j,(z+1)]
}
}
#count all sharks at sea on each day
n.obs<-rowSums(locations[,2:4])
}
###################################################################
# prior for the Dirichlet
alpha<-c(1,1,1)
###################################################################
# below builds the JAGS model file:
###################################################################
cat("
model{
#PARAMS FOR LOCATION BY DATE######
# priors - fix the values for the first outcome variable to be zero to establish a baseline
B[1,1] <- 0
B[1,2] <- 0
B[1,3] <- 0
B[1,4] <- 0
# all other parameters influence the probability of an outcome relative to the baseline
for (j in 2:3) {
B[j,1] ~ dnorm(0, .01);
B[j,2] ~ dnorm(0, .01);
B[j,3] ~ dnorm(0, .01);
B[j,4] ~ dnorm(0, .01);
}
#Below does the multinomial logit calcs for the p[i]'s (probs of a fish being in a particular location given date t)
for (i in 1:N.days) {
#LIKELIHOOD OF LOCATION BY DATE#############################################################################
for (j in 1:3) {
log(phi[i,j]) <- max(min(B[j,1] + B[j,2]*dates[i] + B[j,3]*pow(dates[i],2)+ B[j,4]*pow(dates[i],3),10),-10);
}
sumphi[i] <- sum(phi[i,]);
for (j in 1:3) {
p[i,j] <- phi[i,j] / sumphi[i]
}
locations[i,2:4] ~ dmulti( p[i,1:3] , n.obs[i]) #prob of sharks in locations at date
}
#NOW SET UP MIXING MODEL#####################################################################################
# For now, we assume feeding is constant across regions (so not estimating proportions at all...)
# How to calculate half life:
# y = 1/ (2^halflife)
# where
# y = fraction of orignial material
# halflife =the number of half lives
# example:
# how much is left after 1 half life?
# 1/ (2^1) = 1/2
p.diet[1] ~ dnorm(0,.001) T(0,) #diet adjustment for PEL (cant be less than 0%, so us T to truncate distribution)
p.diet[2] ~ dnorm(0,.001) T(0,) #diet adjustment for HAW (cant be less than 0%, so us T to truncate distribution)
for (i in 1:t.tot.days) {
contrib[i]<-1/(2^(i/HL)) # proportion of isotopes from day i remaining in shark tissue
for (f in 1:n.pred){
daily[i,f,1] <- p[s.days[i,f],1] * contrib[i] # turns presence absence matrix into prop of iso matrix
daily[i,f,2] <- p[s.days[i,f],2] * contrib[i] * p.diet[1] # turns presence absence matrix into prop of iso matrix
daily[i,f,3] <- p[s.days[i,f],3] * contrib[i] * p.diet[2]# turns presence absence matrix into prop of iso matrix
}
}
# now sum up to get predicted contributions of each location to isotopes in tissue of each shark (n.pred)
for (f in 1:n.pred){
for (loc in 1:3){
locP[f,loc]<-sum(daily[,f,loc])/sum(daily[,f,])
locP2[f,loc]<-locP[f,loc]*locP[f,loc] # these are the weights for the variances
}
}
for (i in 1:n.pred){
for (iso in 1:2){
sharkSigM[i,iso]<- inprod(prey.mean[,iso],locP[i,]); #sum up the products of mean * proportions
sharkSigPrcsn[i,iso]<- 1 / (inprod(sigma2[,iso],locP2[i,])); #ditto with variances
}
}
# This section does the likelihood / posterior, N data points
for(i in 1:n.pred) {
for(iso in 1:2) {
pred[i,iso] ~ dnorm(sharkSigM[i,iso], sharkSigPrcsn[i,iso]);
}
}
#end model
}",file="shark_loc.txt")
###################################################################
# now send the data and code to JAGS:
###################################################################
dat = list("N.days", "t.tot.days", "dates", "locations","n.obs","HL","prey.mean","sigma2","n.pred","s.days","pred")
parameters <- c("B","p","p.diet")
model = "shark_loc.txt"
library(runjags)
library(R2jags)
library(gtools)
library(gdata)
# run the model in JAGS, using default settings
ptm <- proc.time()
shark_loc1_birdAllo <- jags(data=dat, inits=NULL, parameters.to.save=parameters, model.file=model, n.chains = 1, n.iter = 100000, n.burnin = 10000,n.thin=1, DIC = FALSE, progress.bar="text")
proc.time() - ptm #returns the CPU time used
attach.jags(shark_loc1_birdAllo)
#PLOT OF PROBS OF BEING IN LOCATION BY DATE
p.mean<-array(0,dim=c(365,3))
for (i in 1:365){
p.mean[i,1]<-mean(p[,i,1])
p.mean[i,2]<-mean(p[,i,2])
p.mean[i,3]<-mean(p[,i,3])
}
plot(locations[,1],locations[,2]/rowSums(locations[,2:4]),col='red')
lines(rep(1:365),p.mean[,1],col='red')
lines(rep(1:365),p.mean[,2],col='blue')
lines(rep(1:365),p.mean[,3],col='green')
points(locations[,1],locations[,4]/rowSums(locations[,2:4]),col='green')
points(locations[,1],locations[,3]/rowSums(locations[,2:4]),col='blue')