# 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')