#########################################################################################################

## Graydon McKee
## 2018
## Back Calculated Length at Age Acoustic Walleye

## TLEN=total length (mm), spine measurements (Yr1, Yr2, etc; um), BCL (mm)

#########################################################################################################

rm(list = ls())

## Reshape data

library(reshape2)

SpineR<-melt(Spine_Bio, id=c("Floy","Fish","Age","TLEN","SEX"))

## Rename annulus column, and Si column

colnames(SpineR)[colnames(SpineR)=="variable"] <- "annulus"

colnames(SpineR)[colnames(SpineR)=="value"] <- "Si"

## Set NA to NULL

SpineR<-na.omit(SpineR)

## Spine Radius column (Sc)

Sc<-tapply(SpineR$Si,SpineR$Floy,max)
Floy<-unique(SpineR$Floy)
Floy<-sort(Floy)

ScDf<-data.frame(Floy,Sc)

SpineR<-merge(SpineR,ScDf,on="Floy")

## Create new column to back calculate for each fish for each age (Fraser-Lee)

SpineR$BCL<-55+(SpineR$TLEN-55)*(SpineR$Si/SpineR$Sc)

## Create Migratory/Resident Column

Repeat_Offenders<-Repeat_Offenders[-c(19,40,49), ]

SpineR<-merge(SpineR,Repeat_Offenders,on="Fish")

SpineR$Migratory<-ifelse(SpineR$G16>2,"Y","N")

##

index<-sort(unique(SpineR$annulus))

values<-c(1:15)

SpineR$annulus<-values[match(SpineR$annulus,index)]

## Subset migrators and residents

Migratory<-subset(SpineR,Migratory=="Y")
Resident<-subset(SpineR,Migratory=="N")

## Set Von Bert Curves

## Resident
ResSt<-c(L = 750, k = 0.1) #starting values for parameter estimate
Res.fm<-nls(BCL~L*(1-exp(-k*(annulus-0))), data = Resident, start = ResSt, trace = T)

summary(Res.fm)

coef(Res.fm) #returns the coefficients
summary(Res.fm)$coeff[,2] #returns the standard errors

## Migratory
MigSt<-c(L = 750, k = 0.1) #starting values for parameter estimate
Mig.fm<-nls(BCL~L*(1-exp(-k*(annulus-0))), data = Migratory, start = MigSt, trace = T)

summary(Mig.fm)

coef(Mig.fm) #returns the coefficients
summary(Mig.fm)$coeff[,2] #returns the standard errors

## Means for Resident and Migratory

mean<-tapply(SpineR$BCL,SpineR[,c(6,13)],mean)
mean

m2<-as.data.frame(mean)

x1<-as.numeric(rownames(m2)) #gets numeric equivalent

forplot2<-data.frame(age=x1, m2[,1:2]) 

#define range for functions to be fit
ages<-c(0:15)
ages
length(ages)
options(graphics.record = TRUE) 

#define "migratory" field for predictions from nls fits
Resm<-rep('N', length(ages))
length(Resm)
Migm<-rep('Y', length(ages))
length(Migm)

## Plot side by side with the same y axis 

#Resident plot

par(mfrow = c(1, 2), mar = c(5, 4.4, 4, 0))

plot(forplot2[,1], forplot2[,2], pch=NA, ylab = "Back Calculated Total length (mm)", xlab = "",
     ylim = c(0, 750), yaxs = "i", xlim = c(0,16), xaxs = "i", main = "Resident", cex.main=1.5, cex.lab=1.5, cex.axis=1.4, xaxt='n', las=1)
points(Resident$BCL ~ Resident$annulus, col="blue", cex=1.5)
lines(ages, predict(Res.fm, list (annulus = ages, Migratory = Resm)), lwd =2, lty=1, col ="blue")
lines(ages, predict(Mig.fm, list (annulus = ages, Migratory = Migm)), lwd =2, lty=2, col ="red")

axis(side=1, at=c(0,3,6,9,12), cex.axis=1.4)

#Migratory plot 

par(mar = c(5, 0, 4, 4.4))

plot(forplot2[,1], forplot2[,3], pch=NA, ylab = "", xlab = "",
     ylim = c(0, 750), yaxs = "i", xlim = c(0,16), xaxs = "i", main = "Migratory", cex.main=1.5, cex.lab=1.5, cex.axis=1.4, yaxt='n', xaxt='n', las=1)
points(Migratory$BCL ~ Migratory$annulus, col="red", cex=1.5)
lines(ages, predict(Mig.fm, list (annulus = ages, Migratory = Migm)), lwd =2, lty=1, col ="red")
lines(ages, predict(Res.fm, list (annulus = ages, Migratory = Resm)), lwd =2, lty=2, col ="blue")

axis(side=1, at=c(0,3,6,9,12,15), cex.axis=1.4)

mtext("Age (years)", side=1, at=0, line=2.5, cex=1.5)

## Bootstrap curves

summary(Res.fm)
summary(Mig.fm)

coef(Mig.fm)[[2]]
coef(Res.fm)[[2]]

## Resident

Rk<-coef(Res.fm)[[2]]
RL<-coef(Res.fm)[[1]]

BOOT<-4999

for (i in 1:BOOT){
  RandR<-Resident[sample(1:length(Resident$BCL),replace=TRUE),]
  ResSt.R<-c(L = 750, k = 0.1) #starting values for parameter estimate
  Res.fm.R<-nls(BCL~L*(1-exp(-k*(annulus-0))), data = RandR, start = ResSt.R, trace = T)
  Randk<-coef(Res.fm.R)[[2]]
  RandL<-coef(Res.fm.R)[[1]]
  Rk<-c(Rk,Randk)
  RL<-c(RL,RandL)
}

hist(Rk)

hist(RL)

## Mean k for residents

mean(Rk)

stdiff.Rk<-sort(Rk) 

# Now get lower and upper limits of 95% CI
low.Rk <- stdiff.Rk[.025*BOOT+1] ; up.Rk <- stdiff.Rk[.975*BOOT+1]
low.Rk ; up.Rk

## Mean L for residents

mean(RL)

stdiff.RL<-sort(RL) 

# Now get lower and upper limits of 95% CI
low.RL <- stdiff.RL[.025*BOOT+1] ; up.RL <- stdiff.RL[.975*BOOT+1]
low.RL ; up.RL

## Migratory


Mk<-coef(Mig.fm)[[2]]
ML<-coef(Mig.fm)[[1]]

BOOT<-4999

for (i in 1:BOOT){
  RandM<-Migratory[sample(1:length(Migratory$BCL),replace=TRUE),]
  MigSt.R<-c(L = 750, k = 0.1) #starting values for parameter estimate
  Mig.fm.R<-nls(BCL~L*(1-exp(-k*(annulus-0))), data = RandM, start =MigSt.R, trace = T)
  Randk<-coef(Mig.fm.R)[[2]]
  RandL<-coef(Mig.fm.R)[[1]]
  Mk<-c(Mk,Randk)
  ML<-c(ML,RandL)
}

hist(Mk)

hist(ML)

## Mean k for residents

mean(Mk)

stdiff.Mk<-sort(Mk) 

# Now get lower and upper limits of 95% CI
low.Mk <- stdiff.Mk[.025*BOOT+1] ; up.Mk <- stdiff.Mk[.975*BOOT+1]
low.Mk ; up.Mk

## Mean L for residents

mean(ML)

stdiff.ML<-sort(ML) 

# Now get lower and upper limits of 95% CI
low.ML <- stdiff.ML[.025*BOOT+1] ; up.ML <- stdiff.ML[.975*BOOT+1]
low.ML ; up.ML

hist(Rk)

hist(RL)

## Mean k for residents

mean(Rk)

stdiff.Rk<-sort(Rk) 

# Now get lower and upper limits of 95% CI
low.Rk <- stdiff.Rk[.025*BOOT+1] ; up.Rk <- stdiff.Rk[.975*BOOT+1]
low.Rk ; up.Rk

## Mean L for residents

mean(RL)

stdiff.RL<-sort(RL) 

# Now get lower and upper limits of 95% CI
low.RL <- stdiff.RL[.025*BOOT+1] ; up.RL <- stdiff.RL[.975*BOOT+1]
low.RL ; up.RL

################################################################################################################

## Fraser-Lee assumption of proportionality
## Test to see if total length at capture is proportional to spine radius at capture

SAC<-SpineR[!duplicated(SpineR$Fish), ] 

plot(SAC$TLEN~SAC$Sc)

SAC.lm<-lm(SAC$TLEN~SAC$Sc)
summary(SAC.lm)

abline(SAC.lm$coefficients[[1]],SAC.lm$coefficients[[2]])

par(mfrow=c(2,2))
plot(SAC.lm)
par(mfrow=c(1,1))