Simulating Age-Period-Cohort Data
Volker Schmid
2021-06-10
age=2*sqrt(seq(1,20,length=10))
age<- age-mean(age)
plot(age, type="l")
period=15:1
period[8:15]<-8:15
period<-period/5
period<-period-mean(period)
plot(period, type="l")
periods_per_agegroup=5
number_of_cohorts <- periods_per_agegroup*(10-1)+15
cohort<-rep(0,60)
cohort[1:15]<-(14:0)
cohort[16:30]<- (1:15)/2
cohort[31:60]<- 8
cohort<-cohort/10
cohort<-cohort-mean(cohort)
plot(cohort, type="l")
simdata<-apcSimulate(-10, age, period, cohort, periods_per_agegroup, 1e6)
print(simdata$cases)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 7 26 50 95 134 146 402 1174 2972
## [2,] 0 4 16 55 71 89 152 307 799 2215
## [3,] 0 6 13 32 50 76 110 235 621 1668
## [4,] 0 3 14 28 42 69 118 160 445 1255
## [5,] 0 2 10 15 41 64 93 126 382 925
## [6,] 0 3 7 17 43 46 79 103 281 704
## [7,] 0 1 8 14 42 49 68 70 196 488
## [8,] 0 0 1 10 21 44 64 76 149 402
## [9,] 0 2 5 12 33 55 73 106 155 438
## [10,] 0 0 9 18 25 80 107 145 195 446
## [11,] 0 5 18 17 50 91 119 137 246 494
## [12,] 0 5 5 17 54 111 159 230 264 551
## [13,] 0 3 12 38 77 120 180 271 341 604
## [14,] 0 5 11 54 94 161 271 361 472 741
## [15,] 1 6 13 46 112 193 335 486 543 792
simmod <- bamp(cases = simdata$cases, population = simdata$population, age = "rw1",
period = "rw1", cohort = "rw1", periods_per_agegroup =periods_per_agegroup)
##
## Model:
## age (rw1) - period (rw1) - cohort (rw1) model
## Deviance: 161.63
## pD: 49.49
## DIC: 211.12
##
##
## Hyper parameters: 5% 50% 95%
## age 0.341 0.838 1.829
## period 13.415 26.273 46.126
## cohort 76.988 123.593 190.995
##
##
## Markov Chains convergence checked succesfully using Gelman's R (potential scale reduction factor).
## [1] TRUE
effects<-effects(simmod)
effects2<-effects(simmod, mean=TRUE)
#par(mfrow=c(3,1))
plot(age, type="l")
lines(effects$age, col="blue")
lines(effects2$age, col="green")
plot(period, type="l")
lines(effects$period, col="blue")
lines(effects2$period, col="green")
plot(cohort, type="l")
lines(effects$cohort, col="blue")
lines(effects2$cohort, col="green")
prediction<-predict_apc(simmod, periods=5, population=array(1e6,c(20,10)))
plot(prediction$cases_period[2,], ylim=range(prediction$cases_period),ylab="",pch=19)
points(prediction$cases_period[1,],pch="–",cex=2)
points(prediction$cases_period[3,],pch="–",cex=2)
for (i in 1:20)lines(rep(i,3),prediction$cases_period[,i])
plot(prediction$period[2,])
cov_p<-rnorm(15,period,.1)
simmod2 <- bamp(cases = simdata$cases, population = simdata$population, age = "rw1",
period = "rw1", cohort = "rw1", periods_per_agegroup =periods_per_agegroup,
period_covariate = cov_p)
## Warning: MCMC chains did not converge!
##
## WARNING! Markov Chains have apparently not converged! DO NOT TRUST THIS MODEL!
##
## Model:
## age (rw1) - period (rw1) - cohort (rw1) model
## Deviance: 161.56
## pD: 49.55
## DIC: 211.11
##
##
## Hyper parameters: 5% 50% 95%
## age 0.350 0.860 1.792
## period 13.703 26.525 45.960
## cohort 76.888 123.938 191.253
checkConvergence(simmod2)
## Warning: MCMC chains did not converge!
## [1] FALSE
