Yet Another COVID19 Projection

Last update 2020-04-18

Projection for the next X days in several countries using a SEIRQRDP model based on Peng et al. 2020. Code adapted (barely) from matlab E. Cheynet’s code

Source code at github

DISCLAIMER Dot not consider these projections seriously. I’m far from being an expert on this field. They were made just for testing and fun.

Argentina

LT <- 10    #1-14 days, latent time in days, incubation period, gamma^(-1)   
QT <- 7  #Quarantine time in days, recovery time, infectious period, delta^(-1)
alpha_guess <- 1.0
beta_guess <- 1.0
gamma_guess <- 1 / LT
delta_guess <- 1 / QT
kappa_guess <- 0.01 #dead rate
lambda_guess <- 0.5 # recover rate
region = "Argentina"
population =  40e6
data<-get_jhu_data(region=region,population = population )
#data$cumulative_incidence$infected_cases<-unlist(data$cumulative_incidence[,2] *5)
#data$cumulative_incidence$recovered_cases<-unlist(data$cumulative_incidence[,3] *5)
data_fit<-create_fit_data(data,fitted_date = fitted_date,start_date = start_date)
parameters<-c(alpha_guess,beta_guess,gamma_guess,delta_guess,kappa_guess,lambda_guess)
params<-SEIQRDP_fit(parameters,data_fit)
forecast <-61
forecast_data <- SEIQRDP_predict(forecast,params,data_fit,data)
plot_arg<-SEIQRDP_plot(forecast_data,region)
plot_arg 

Brazil

region="Brazil"
population=21e7
start_date<-(today()-15) 
fitted_date<-(start_date+14) 
start_date <- start_date %>% format('%m-%d-%Y')
fitted_date <- fitted_date %>% format('%m-%d-%Y')
data<-get_jhu_data(region=region,population = population )
data_fit<-create_fit_data(data,fitted_date = fitted_date,start_date = start_date)
parameters<-c(alpha_guess,beta_guess,gamma_guess,delta_guess,kappa_guess,lambda_guess)
params<-SEIQRDP_fit(parameters,data_fit)
forecast <-30
forecast_data <- SEIQRDP_predict(forecast,params,data_fit,data)
plot<-SEIQRDP_plot(forecast_data,region)
plot

Italy

start_date<-(today()-18) 
fitted_date<-(start_date+15) 
start_date <- start_date %>% format('%m-%d-%Y')
fitted_date <- fitted_date %>% format('%m-%d-%Y')
region ="Italy"
population=61e6
data<-get_jhu_data(region=region,population = population )
data_fit<-create_fit_data(data,fitted_date = fitted_date,start_date = start_date)
parameters<-c(alpha_guess,beta_guess,gamma_guess,delta_guess,kappa_guess,lambda_guess)
params<-SEIQRDP_fit(parameters,data_fit)
forecast <-30
forecast_data <- SEIQRDP_predict(forecast,params,data_fit,data)
plot<-SEIQRDP_plot(forecast_data,region)
plot

Spain

region = "Spain"
population = 46e6
data<-get_jhu_data(region=region,population = population )
data_fit<-create_fit_data(data,fitted_date = fitted_date,start_date = start_date)
parameters<-c(alpha_guess,beta_guess,gamma_guess,delta_guess,kappa_guess,lambda_guess)
params<-SEIQRDP_fit(parameters,data_fit)
forecast <-30
forecast_data <- SEIQRDP_predict(forecast,params,data_fit,data)
plot<-SEIQRDP_plot(forecast_data,region)
plot

Chile

region ="Chile"
population=18e6
data<-get_jhu_data(region=region,population = population )
data_fit<-create_fit_data(data,fitted_date = fitted_date,start_date = start_date)
parameters<-c(alpha_guess,beta_guess,gamma_guess,delta_guess,kappa_guess,lambda_guess)
params<-SEIQRDP_fit(parameters,data_fit)
forecast <-61
forecast_data <- SEIQRDP_predict(forecast,params,data_fit,data)
plot_chile<-SEIQRDP_plot(forecast_data,region)
plot_chile

Korea

region ="Korea, South"
population=60e6
data<-get_jhu_data(region=region,population = population )
data_fit<-create_fit_data(data,fitted_date = fitted_date,start_date = start_date)
parameters<-c(alpha_guess,beta_guess,gamma_guess,delta_guess,kappa_guess,lambda_guess)
params<-SEIQRDP_fit(parameters,data_fit)
forecast <-30
forecast_data <- SEIQRDP_predict(forecast,params,data_fit,data)
plot<-SEIQRDP_plot(forecast_data,region)
plot