2 Iterative estimation of parameters and outof sample prediction.
This is interesting to monitor the evolution of covid-19.
If model is reliable, then also parameter evolution is reliable.
Further we check its out-of-sample prediction of cases since beginning of march. This is more reliable than the above goodness of fit.
ndays=sum(cvirus$fecha>"2020-03-10")
evpars=data.frame(NULL)
windows=list(1:(n-ndays+1))
for(i in (n-ndays+2):n) windows=c(windows,list(1:i))
nw=length(windows)
for(i in 1:nw){
fit = sampling(m1,
data=list(y=cvirus$casos[windows[[i]]],
n=length(windows[[i]]),np=2),
iter=niter,chains = 4,
init = init_f(),
# control = list(adapt_delta = 0.99,max_treedepth=50),
seed = 11,refresh=0)
post.par=extract(fit,pars=c(int.par,"ypf"))
for(j in 1:length(int.par)){
evpars=rbind(evpars,data.frame(day=cvirus$fecha[max(windows[[i]])],
value=post.par[[j]],
param=int.par[j]))
}
evpars=rbind(evpars,data.frame(day=cvirus$fecha[max(windows[[i]])],
value=post.par[[j+1]][,1],
param="outpred"))
cat("i=",i,"/",nw," - ")
}
save(evpars,file="evpars.RData")
2.1 Evolution of parameters (using data since the beginning)
load(file="evpars.RData")
ggplotly(ggplot(evpars[evpars$param!="outpred",], aes(x=day, y=value, colour=param)) + geom_smooth()+
geom_vline(xintercept=as.Date("2020-03-10"),linetype="dashed",color = "red", size=2)+
geom_hline(yintercept=0)+
xlab("Days")+ ylab("Posterior mean and 95% C.I."))
Reaching a peak means \(\alpha_2<0\) and \(\beta_2<0\), while disappear of the covid means all parameters less than 0.
2.2 Out of sample prediction
outpred=evpars[evpars$param=="outpred",]
outpred=aggregate(value~day,outpred,
function(xx) c(quantile(xx,0.025),mean(xx),quantile(xx,0.975)))
outpred=data.frame(do.call(cbind,outpred))
colnames(outpred)=c("day","inf","mean","sup")
outpred$predday=sort(unique(evpars$day))+1
ggplot(outpred, aes(x=predday, y=mean)) + geom_line() +
geom_point(data=cvirus[cvirus$fecha%in%outpred$day,],
aes(x=fecha,y=casos),color="red")+
geom_errorbar(aes(ymin=inf, ymax=sup), width=.2,position=position_dodge(0.05))+
xlab("Days")+ ylab("Posterior outofsample mean and 95% C.I.")