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)
print(simmod)
## 
##  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).
checkConvergence(simmod)
## [1] TRUE
plot(simmod)

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!
print(simmod2)
## 
## 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
plot(simmod2)