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)

print(simmod)

## 
##  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

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)))

## [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)

print(simmodrw2)

## 
##  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

plot(simmodrw2)

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)