Irregular Sampling
2025-09-24
This document explores the impact of irregular sampling on model estimates, in particular, the effect of a large window in which no surveys are undertaken.
As expected, the variance in the predictions for the unsurveyed period increases as the length of the unsurveyed period increases. The variance in the predictions from the simple constant growth model is smaller than that of the two more flexible models, and the simple model appears to linearly interpolate the population through the unsurveyed period. The more complex models display more complex behaviours through the unsurveyed period, but this flexibility leads to vastly increased variance in the predictions.
Regardless of the model adopted, the large uncertainty in predicted population size could lead to large uncertainty in the estimated trend if the period used to evaluate the trend overlaps the unsurveyed period.
library(ACAPT)
library(ggplot2)Set the prior mean and precision for the initial subpopulation sizes for both simulation and parameter estimation
x1.mu <- log(c(10000,3000,8000))
x1.tau <- c(0.01,0.01,0.01)Constant
Model 1
Assume the population consists of three subpopulations, each subpopulation is surveyed every three years and a survey occurs every year, and the survey precision is moderate
d.se2 <- data.frame(Year=1946:2025,S1=0,S2=0,S3=0)
d.se2$S1[seq(1,nrow(d.se2),3)] <- 0.05^2
d.se2$S2[seq(2,nrow(d.se2),3)] <- 0.05^2
d.se2$S3[seq(3,nrow(d.se2),3)] <- 0.05^2Simulate survey estimates where the log growth rate is constant over time
set.seed(23)
sim <- ACAPTsimulate1(d.se2,x1=x1.mu,q=0,y.sigma=0.01,r.sigma=0.02)
d.est <- sim$d.est
d <- mergeSurveyDF(d.est,d.se2)
ggplot(d,aes(x=Year,y=Est,group=Sub,colour=Sub)) +
geom_point()
Sample from the model and show the posterior mean and 95% credible intervals for the total population size (orange) together with the true value (grey)
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1845 986.5 6.976 13.253
## r.tau 1014 247.2 1.748 4.965
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 591.2 1144.2 1624.6 2309 4336
## r.tau 603.5 834.9 988.5 1165 1568d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 10 year window and repeat analysis
n <- 10
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1716.9 973.9 6.886 14.034
## r.tau 935.1 239.4 1.693 5.072
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 522.3 1019 1481.1 2158 4244
## r.tau 544.4 764 908.4 1077 1478d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 20 year window and repeat analysis
n <- 20
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1636.3 973.8 6.886 14.885
## r.tau 873.8 235.1 1.663 5.141
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 481.9 952.4 1397.1 2054 4166
## r.tau 485.8 707.7 847.3 1011 1414d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 30 year window and repeat analysis
n <- 30
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1558.6 960.6 6.793 15.965
## r.tau 784.9 219.2 1.550 5.039
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 432.2 894.1 1319.4 1971 4013
## r.tau 427.3 626.5 762.7 915 1282d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 40 year window and repeat analysis
n <- 40
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1319.2 880.2 6.224 13.87
## r.tau 667.4 212.3 1.501 5.08
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 318.3 703.0 1091.2 1679.2 3675
## r.tau 333.6 514.1 639.2 792.5 1157d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Model 2
Assume the population consists of three subpopulations, each subpopulation is surveyed every three years and a survey occurs every year, and the survey precision is moderate
d.se2 <- data.frame(Year=1946:2025,S1=0,S2=0,S3=0)
d.se2$S1[seq(1,nrow(d.se2),3)] <- 0.05^2
d.se2$S2[seq(2,nrow(d.se2),3)] <- 0.05^2
d.se2$S3[seq(3,nrow(d.se2),3)] <- 0.05^2Simulate survey estimates where the log growth rate is constant over time
set.seed(23)
sim <- ACAPTsimulate1(d.se2,x1=x1.mu,q=0,y.sigma=0.01,r.sigma=0.02)
d.est <- sim$d.est
d <- mergeSurveyDF(d.est,d.se2)
ggplot(d,aes(x=Year,y=Est,group=Sub,colour=Sub)) +
geom_point()
Sample from the model and show the posterior mean and 95% credible intervals for the total population size (orange) together with the true value (grey)
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1711 990.3 7.003 15.642
## r.tau 831 225.0 1.591 5.313
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 525.3 1024.0 1477.8 2130.7 4185
## r.tau 466.4 668.8 808.8 962.8 1341d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 10 year window and repeat analysis
n <- 10
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1491.2 872.9 6.172 12.840
## r.tau 776.7 218.6 1.546 5.283
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 430.5 867.8 1278.0 1893 3729
## r.tau 416.8 620.6 754.6 905 1272d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 20 year window and repeat analysis
n <- 20
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1388.4 907.9 6.420 15.036
## r.tau 698.6 210.1 1.486 5.307
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 363.7 758.1 1149.5 1748.2 3837
## r.tau 360.4 547.0 674.6 823.1 1179d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 30 year window and repeat analysis
n <- 30
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1296 870.4 6.155 15.132
## r.tau 628 200.5 1.418 5.091
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 311.6 693.3 1068.8 1651 3590
## r.tau 307.7 485.1 602.5 746 1084d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 40 year window and repeat analysis
n <- 40
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1086.9 789.5 5.582 14.062
## r.tau 529.5 186.7 1.320 5.115
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 230.0 545.1 864.2 1392 3224.4
## r.tau 243.8 393.4 502.6 638 962.3d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Model 3
Assume the population consists of three subpopulations, each subpopulation is surveyed every three years and a survey occurs every year, and the survey precision is moderate
d.se2 <- data.frame(Year=1946:2025,S1=0,S2=0,S3=0)
d.se2$S1[seq(1,nrow(d.se2),3)] <- 0.05^2
d.se2$S2[seq(2,nrow(d.se2),3)] <- 0.05^2
d.se2$S3[seq(3,nrow(d.se2),3)] <- 0.05^2Simulate survey estimates where the log growth rate is constant over time
set.seed(23)
sim <- ACAPTsimulate1(d.se2,x1=x1.mu,q=0,y.sigma=0.01,r.sigma=0.02)
d.est <- sim$d.est
d <- mergeSurveyDF(d.est,d.se2)
ggplot(d,aes(x=Year,y=Est,group=Sub,colour=Sub)) +
geom_point()
Sample from the model and show the posterior mean and 95% credible intervals for the total population size (orange) together with the true value (grey)
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1788.5 982.5 6.948 14.444
## r.tau 825.5 221.8 1.568 5.612
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 567.0 1085.0 1565.9 2249.3 4293
## r.tau 468.9 664.1 800.7 959.7 1326d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 10 year window and repeat analysis
n <- 10
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1613.8 948.8 6.709 14.894
## r.tau 773.3 214.0 1.513 5.803
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 475.8 948 1384.6 2020.5 4107
## r.tau 422.9 620 747.6 901.4 1262d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 20 year window and repeat analysis
n <- 20
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1489.1 899.8 6.362 13.398
## r.tau 710.7 203.0 1.435 5.694
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 425.2 850.4 1255.7 1884.6 3820
## r.tau 378.0 565.4 688.4 834.4 1173d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 30 year window and repeat analysis
n <- 30
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1383.2 864.0 6.110 13.015
## r.tau 650.3 202.6 1.433 6.404
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 356.3 767.2 1167.7 1771.1 3625
## r.tau 323.3 504.4 629.5 768.6 1113d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 40 year window and repeat analysis
n <- 40
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1104.2 767.5 5.427 12.819
## r.tau 539.2 187.0 1.322 6.403
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 246.6 569.4 900.6 1411.0 3175.5
## r.tau 244.9 406.0 515.4 641.8 974.5d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Cosine Profile
Model 1
Assume the population consists of three subpopulations, each subpopulation is surveyed every three years and a survey occurs every year, and the survey precision is moderate
d.se2 <- data.frame(Year=1946:2025,S1=0,S2=0,S3=0)
d.se2$S1[seq(1,nrow(d.se2),3)] <- 0.05^2
d.se2$S2[seq(2,nrow(d.se2),3)] <- 0.05^2
d.se2$S3[seq(3,nrow(d.se2),3)] <- 0.05^2Simulate survey estimates assuming a cosine profile in log growth rate over time
set.seed(27)
X <- cbind(1,cos(seq(0,pi,length.out=nrow(d.se2))))
beta <- c(0,0.02)
sim <- ACAPTsimulate4(d.se2,x1=x1.mu,X=X,beta=beta,y.sigma=0.0,r.sigma=0.001)
d.est <- sim$d.est
d <- mergeSurveyDF(d.est,d.se2)
ggplot(d,aes(x=Year,y=Est,group=Sub,colour=Sub)) +
geom_point()
Sample from the model and show the posterior mean and 95% credible intervals for the total population size (orange) together with the true value (grey)
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1869.3 1042.8 7.374 16.260
## r.tau 548.6 118.9 0.841 2.437
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 581.9 1148.5 1630.1 2336.9 4479.7
## r.tau 347.2 463.3 538.5 622.3 811.1d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 10 year window and repeat analysis
n <- 10
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1810.4 1042 7.3659 14.787
## r.tau 524.3 120 0.8489 2.572
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 533.1 1080.0 1568.9 2268.7 4527.7
## r.tau 320.0 439.7 513.9 597.1 790.6d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 20 year window and repeat analysis
n <- 20
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1627.7 1014.8 7.1760 18.922
## r.tau 468.2 112.9 0.7987 2.402
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 454.2 933.7 1392.4 2039.4 4181.5
## r.tau 281.6 386.6 456.3 536.6 721.3d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 30 year window and repeat analysis
n <- 30
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1428.7 883.8 6.2496 13.184
## r.tau 451.3 118.9 0.8405 2.597
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 371.8 802.2 1208.2 1816.8 3743.2
## r.tau 253.8 365.5 440.2 523.8 719.5d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 40 year window and repeat analysis
n <- 40
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel1(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1301.2 865.8 6.1219 13.174
## r.tau 441.1 132.7 0.9382 3.001
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 303.4 691.4 1071.5 1679.5 3616.3
## r.tau 228.5 345.6 425.4 518.8 744.9d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Model 2
Assume the population consists of three subpopulations, each subpopulation is surveyed every three years and a survey occurs every year, and the survey precision is moderate
d.se2 <- data.frame(Year=1946:2025,S1=0,S2=0,S3=0)
d.se2$S1[seq(1,nrow(d.se2),3)] <- 0.05^2
d.se2$S2[seq(2,nrow(d.se2),3)] <- 0.05^2
d.se2$S3[seq(3,nrow(d.se2),3)] <- 0.05^2Simulate survey estimates assuming a cosine profile in log growth rate over time
set.seed(27)
X <- cbind(1,cos(seq(0,pi,length.out=nrow(d.se2))))
beta <- c(0,0.02)
sim <- ACAPTsimulate4(d.se2,x1=x1.mu,X=X,beta=beta,y.sigma=0.0,r.sigma=0.001)
d.est <- sim$d.est
d <- mergeSurveyDF(d.est,d.se2)
ggplot(d,aes(x=Year,y=Est,group=Sub,colour=Sub)) +
geom_point()
Sample from the model and show the posterior mean and 95% credible intervals for the total population size (orange) together with the true value (grey)
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1852.6 1015.8 7.183 14.363
## r.tau 914.7 245.6 1.737 4.625
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 580.0 1129.5 1614.3 2331 4455
## r.tau 513.5 740.1 886.2 1061 1471d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 10 year window and repeat analysis
n <- 10
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1733 1013 7.162 15.189
## r.tau 866 244 1.725 4.778
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 523.4 1020.4 1495.9 2175 4376
## r.tau 472.6 692.1 837.9 1010 1416d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 20 year window and repeat analysis
n <- 20
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1555 913.1 6.456 12.882
## r.tau 773 231.6 1.638 4.757
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 431.7 901.6 1337.6 1976.1 3912
## r.tau 400.2 606.6 744.3 912.1 1300d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 30 year window and repeat analysis
n <- 30
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1403.6 903.7 6.390 14.068
## r.tau 690.9 224.6 1.588 4.763
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 348.9 768.6 1175.6 1793.6 3729
## r.tau 333.0 529.7 663.3 824.4 1205d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 40 year window and repeat analysis
n <- 40
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel2(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1280.3 856.4 6.055 13.47
## r.tau 616.7 207.6 1.468 4.63
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 290.7 676.5 1058 1648.3 3526
## r.tau 291.6 466.6 590 739.7 1091d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Model 3
Assume the population consists of three subpopulations, each subpopulation is surveyed every three years and a survey occurs every year, and the survey precision is moderate
d.se2 <- data.frame(Year=1946:2025,S1=0,S2=0,S3=0)
d.se2$S1[seq(1,nrow(d.se2),3)] <- 0.05^2
d.se2$S2[seq(2,nrow(d.se2),3)] <- 0.05^2
d.se2$S3[seq(3,nrow(d.se2),3)] <- 0.05^2Simulate survey estimates assuming a cosine profile in log growth rate over time
set.seed(27)
X <- cbind(1,cos(seq(0,pi,length.out=nrow(d.se2))))
beta <- c(0,0.02)
sim <- ACAPTsimulate4(d.se2,x1=x1.mu,X=X,beta=beta,y.sigma=0.0,r.sigma=0.001)
d.est <- sim$d.est
d <- mergeSurveyDF(d.est,d.se2)
ggplot(d,aes(x=Year,y=Est,group=Sub,colour=Sub)) +
geom_point()
Sample from the model and show the posterior mean and 95% credible intervals for the total population size (orange) together with the true value (grey)
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1883.4 1012.9 7.162 14.393
## r.tau 887.8 238.7 1.688 6.115
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 604.6 1159.5 1654.8 2357 4454
## r.tau 496.9 716.5 860.9 1032 1428d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 10 year window and repeat analysis
n <- 10
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1811.5 1032.9 7.304 15.620
## r.tau 864.9 235.8 1.667 6.141
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 561.9 1080.8 1560.3 2267 4454
## r.tau 473.2 698.2 839.3 1008 1392d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 20 year window and repeat analysis
n <- 20
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1653.8 975.8 6.900 14.525
## r.tau 760.7 225.5 1.594 6.532
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 475.8 968.1 1417.5 2086.6 4170
## r.tau 403.3 600.0 732.3 890.3 1283d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 30 year window and repeat analysis
n <- 30
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1414.9 905.5 6.403 13.959
## r.tau 692.4 218.9 1.548 6.966
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 361.0 779 1181.8 1802.8 3799
## r.tau 349.8 538 662.2 815.5 1204d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()
Delete surveys in a 40 year window and repeat analysis
n <- 40
win <- seq(1985-floor(n/2),length.out=n)
d.est[d.est$Year %in% win,-1] <- NA
d.se2[d.est$Year %in% win,-1] <- 0
model <- ACAPTmodel3(d.est,d.se2,x1.mu=x1.mu,x1.tau=x1.tau)
s <- JAGSsample(model)
summary(as.coda(s[c("y.tau","r.tau")]))##
## Iterations = 1:5000
## Thinning interval = 1
## Number of chains = 4
## Sample size per chain = 5000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## y.tau 1355.2 904.2 6.394 14.029
## r.tau 617.8 208.6 1.475 7.006
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## y.tau 302.5 714.6 1112 1758.0 3716
## r.tau 301.8 468.1 587 735.8 1110d.s <- cbind(annualSummary(s$N),Sim=sim$N)
ggplot(d.s,
aes(x=Year,y=Mean,ymin=`Q.2.5%`,ymax=`Q.97.5%`))+
geom_ribbon(alpha=0.2,color=NA,fill="sienna1")+
geom_line(mapping=aes(x=Year,y=Sim),color="grey50")+
geom_line(color="sienna1")+
geom_vline(xintercept=range(win),color="grey60")+
ylab("N")+
ggtitle("Total Population Size")+
theme_minimal()