Simulating Age-Period-Cohort Data
Volker Schmid
2018-10-08
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,] 4 10 20 55 87 121 176 432 1180 3011
## [2,] 0 4 18 37 69 93 131 305 915 2135
## [3,] 0 4 15 33 66 82 107 204 627 1599
## [4,] 2 6 10 25 62 90 94 160 490 1282
## [5,] 1 4 10 27 36 74 86 114 335 905
## [6,] 0 4 11 22 42 67 70 107 272 670
## [7,] 1 3 3 8 38 65 70 88 197 495
## [8,] 1 2 7 15 16 36 57 77 147 390
## [9,] 0 2 7 14 34 59 78 93 136 419
## [10,] 1 1 11 20 42 54 92 125 161 421
## [11,] 1 2 7 24 32 98 128 171 228 505
## [12,] 1 5 15 31 59 101 163 208 299 545
## [13,] 0 6 17 31 52 128 179 248 365 636
## [14,] 0 5 15 38 78 157 259 368 463 680
## [15,] 1 7 25 57 112 171 367 457 569 745
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: 132.68
## pD: 48.62
## DIC: 181.30
##
##
## Hyper parameters: 5% 50% 95%
## age 0.664 1.521 3.081
## period 12.291 24.237 43.104
## cohort 84.066 130.857 195.230
## [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)))
## [1] 20 10 1000
## [1] 20 10 1000
## [1] 20 10 1000
## [1] 20 10 1000
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,])

simmodrw2 <- bamp(cases = simdata$cases, population = simdata$population, age = "rw2",
period = "rw2", cohort = "rw2", periods_per_agegroup =periods_per_agegroup)
##
## Model:
## age (rw2) - period (rw2) - cohort (rw2) model
## Deviance: 138.27
## pD: 30.23
## DIC: 168.50
##
##
## Hyper parameters: 5% 50% 95%
## age 33.988 110.200 321.768
## period 52.464 125.245 260.451
## cohort 652.847 1393.957 2746.287
checkConvergence(simmodrw2)
## Warning: MCMC chains did not converge!
## [1] FALSE



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)