Skip to content

Commit de6f3e5

Browse files
s-mishras-mishra
authored
Merge pull request #101 from ImperialCollegeLondon/Italy
Italy
2 parents 02ab52f + 7307c52 commit de6f3e5

23 files changed

+287889
-0
lines changed

‎.gitignore‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,13 @@ figures/*.pdf
5151
Rplots.pdf
5252
web/*
5353
results/*.csv
54+
Italy/code/stan-models/*.rds
55+
Italy/results/*.Rdata
56+
Italy/results/*.pdf
57+
Italy/results/*.png
58+
Italy/figures/*.png
59+
Italy/figures/*.pdf
60+
Italy/results/*.RDS
5461

5562

5663

‎Italy/code/plotting/format-data-plotting.r‎

Lines changed: 85 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,85 @@
1+
library(ggplot2)
2+
library(tidyr)
3+
library(dplyr)
4+
library(rstan)
5+
library(data.table)
6+
library(lubridate)
7+
library(gdata)
8+
library(EnvStats)
9+
library(matrixStats)
10+
library(scales)
11+
library(gridExtra)
12+
library(bayesplot)
13+
library(cowplot)
14+
15+
16+
#---------------------------------------------------------------------------
17+
format_data <- function(i, dates, countries, estimated_cases_raw, estimated_deaths_raw,
18+
reported_cases, reported_deaths, out, forecast=0, SIM = FALSE){
19+
20+
N <- length(dates[[i]])
21+
if(forecast > 0) {
22+
dates[[i]] = c(dates[[i]], max(dates[[i]]) + 1:forecast)
23+
N = N + forecast
24+
reported_cases[[i]] = c(reported_cases[[i]],rep(NA,forecast))
25+
reported_deaths[[i]] = c(reported_deaths[[i]],rep(NA,forecast))
26+
}
27+
28+
country <- countries[[i]]
29+
30+
estimated_cases <- colMeans(estimated_cases_raw[,1:N,i])
31+
estimated_cases_li <- colQuantiles(estimated_cases_raw[,1:N,i], probs=.025)
32+
estimated_cases_ui <- colQuantiles(estimated_cases_raw[,1:N,i], probs=.975)
33+
estimated_cases_li2 <- colQuantiles(estimated_cases_raw[,1:N,i], probs=.25)
34+
estimated_cases_ui2 <- colQuantiles(estimated_cases_raw[,1:N,i], probs=.75)
35+
36+
estimated_deaths <- colMeans(estimated_deaths_raw[,1:N,i])
37+
estimated_deaths_li <- colQuantiles(estimated_deaths_raw[,1:N,i], probs=.025)
38+
estimated_deaths_ui <- colQuantiles(estimated_deaths_raw[,1:N,i], probs=.975)
39+
estimated_deaths_li2 <- colQuantiles(estimated_deaths_raw[,1:N,i], probs=.25)
40+
estimated_deaths_ui2 <- colQuantiles(estimated_deaths_raw[,1:N,i], probs=.75)
41+
42+
rt <- colMeans(out$Rt_adj[,1:N,i])
43+
rt_li <- colQuantiles(out$Rt_adj[,1:N,i],probs=.025)
44+
rt_ui <- colQuantiles(out$Rt_adj[,1:N,i],probs=.975)
45+
rt_li2 <- colQuantiles(out$Rt_adj[,1:N,i],probs=.25)
46+
rt_ui2 <- colQuantiles(out$Rt_adj[,1:N,i],probs=.75)
47+
48+
if (SIM == FALSE){
49+
mu <- mean(out$mu[,i])
50+
mu_li <- quantile(out$mu[,i], probs=.025)
51+
mu_ui <- quantile(out$mu[,i], probs=.975)
52+
}
53+
54+
55+
56+
data_state_plotting <- data.frame("date" = dates[[i]],
57+
"country" = rep(country, length(dates[[i]])),
58+
"reported_cases" = reported_cases[[i]],
59+
"predicted_cases" = estimated_cases,
60+
"cases_min" = estimated_cases_li,
61+
"cases_max" = estimated_cases_ui,
62+
"cases_min2" = estimated_cases_li2,
63+
"cases_max2" = estimated_cases_ui2,
64+
"reported_deaths" = reported_deaths[[i]],
65+
"estimated_deaths" = estimated_deaths,
66+
"deaths_min" = estimated_deaths_li,
67+
"deaths_max"= estimated_deaths_ui,
68+
"deaths_min2" = estimated_deaths_li2,
69+
"deaths_max2"= estimated_deaths_ui2,
70+
"rt" = rt,
71+
"rt_min" = rt_li,
72+
"rt_max" = rt_ui,
73+
"rt_min2" = rt_li2,
74+
"rt_max2" = rt_ui2)
75+
76+
if (SIM == FALSE){
77+
data_state_plotting$mu_rep = rep(mu, length(dates[[i]]))
78+
data_state_plotting$mu_li = rep(mu_li, length(dates[[i]]))
79+
data_state_plotting$mu_ui = rep(mu_ui, length(dates[[i]]))
80+
}
81+
82+
return(data_state_plotting)
83+
84+
}
85+

‎Italy/code/plotting/make-plots.r‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
library(lubridate)
2+
library(ggplot2)
3+
source("Italy/code/utils/read-data-subnational.r")
4+
source("Italy/code/plotting/format-data-plotting.r")
5+
source("Italy/code/plotting/make-three-panel-plots.r")
6+
source("Italy/code/plotting/make-rt-plot.r")
7+
8+
make_plots_all <- function(filename, SIM=FALSE, label = "", last_date_data, ext = ".png"){
9+
print("In subnational code")
10+
load(filename)
11+
countries <- states
12+
13+
out <- rstan::extract(fit)
14+
15+
rt_data_long <- NULL
16+
rt_data_wide <- NULL
17+
18+
interventions <- read_interventions()
19+
20+
covariates <- interventions
21+
covariates$Country <- as.factor(covariates$Country)
22+
for (i in 1:length(countries)){
23+
print(countries[i])
24+
25+
data_country_plot <- format_data(i = i, dates = dates, countries = countries,
26+
estimated_cases_raw = estimated_cases_raw,
27+
estimated_deaths_raw = estimated_deaths_raw,
28+
reported_cases = reported_cases,
29+
reported_deaths = reported_deaths,
30+
out = out, SIM = SIM)
31+
# Cuts data on last_data_date
32+
data_country_plot <- data_country_plot[which(data_country_plot$date <= last_date_data),]
33+
# Read in covariates
34+
35+
covariates_long <- gather(covariates[which(covariates$Country == countries[i]),
36+
2:ncol(covariates)],
37+
key = "key", value = "value")
38+
covariates_long$x <- rep(NA, length(covariates_long$key))
39+
un_dates <- unique(covariates_long$value)
40+
41+
for (k in 1:length(un_dates)){
42+
idxs <- which(covariates_long$value == un_dates[k])
43+
max_val <- ceiling(max(data_country_plot$rt_max) +0.3)
44+
for (k in idxs){
45+
covariates_long$x[k] <- max_val
46+
max_val <- max_val - 0.3
47+
}
48+
}
49+
50+
print(sprintf("Last line of data: %s", data_country_plot$date[length(data_country_plot$rt)]))
51+
52+
53+
len <- length(data_country_plot$rt)
54+
rt_data_state_long <- data.frame("state" = c(as.character(countries[i]), as.character(countries[i])),
55+
"x" = c("start", "end"),
56+
"rt" = c(data_country_plot$rt[1],
57+
mean(data_country_plot$rt[(len-6):len])),
58+
"rt_min" = c(data_country_plot$rt_min[1],
59+
mean(data_country_plot$rt_min[(len-6):len])),
60+
"rt_max" = c(data_country_plot$rt_max[1],
61+
mean(data_country_plot$rt_max[(len-6):len])))
62+
rt_data_long <- rbind(rt_data_long, rt_data_state_long)
63+
64+
# Make the three panel plot
65+
make_three_panel_plots(data_country_plot, jobid = JOBID, country = countries[i],
66+
covariates_long = covariates_long, label = label)
67+
}
68+
69+
print("Making rt plot")
70+
rt_data_long$x <- factor(rt_data_long$x, levels = c("start", "end"))
71+
72+
region_to_macro=rbind(
73+
data.frame(country= c("Aosta","Liguria","Lombardy","Piedmont"), macro="NorthWest"),
74+
data.frame(country=c("Emilia-Romagna","Friuli-Venezia_Giulia","Trento","Bolzano","Veneto"),macro="NorthEast"),
75+
data.frame(country=c("Lazio","Marche","Tuscany","Umbria"),macro="Centre"),
76+
data.frame(country=c("Abruzzo","Apulia","Basilicata","Calabria","Campania","Molise"),macro="South"),
77+
data.frame(country=c("Sardinia","Sicily"),macro="Islands")
78+
)
79+
names(region_to_macro) <- c("state", "macro")
80+
rt_data_long = rt_data_long %>%inner_join(region_to_macro,)
81+
82+
83+
make_rt_point_plot(rt_data_long, JOBID = JOBID, label = label)
84+
85+
86+
}

‎Italy/code/plotting/make-rt-plot.r‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
# Make arrow RT plot
2+
library(ggplot2)
3+
library(ggrepel)
4+
5+
make_rt_point_plot <- function(rt_data_long, JOBID, label= ""){
6+
# Only choose end
7+
rt_data_end <- rt_data_long[which(rt_data_long$x == "end"),]
8+
rt_data_end <- rt_data_end[order(-rt_data_end$rt),]
9+
rt_data_end$state <- factor(rt_data_end$state, levels = rt_data_end$state)
10+
11+
rt_data_long$state[which(rt_data_long$state=="Friuli-Venezia_Giulia")]<-"Friuli-Venezia Giulia"
12+
rt_data_end$state[which(rt_data_end$state=="Friuli-Venezia_Giulia")]<-"Friuli-Venezia Giulia"
13+
14+
p1 <- ggplot(rt_data_end) +
15+
geom_point(aes(x = state, y = rt, col=macro), stat="identity") +
16+
geom_errorbar(aes(x = state, ymin = rt_min, ymax = rt_max, col=macro), width=0) +
17+
geom_hline(aes(yintercept=1)) +
18+
xlab("Region") + ylab(expression(R[t])) +
19+
scale_y_continuous(expand = c(0, 0)) +
20+
scale_colour_discrete(name = "") +
21+
coord_flip() +
22+
theme(axis.line = element_line(colour = "black"),
23+
panel.grid.major = element_blank(),
24+
panel.grid.minor = element_blank(),
25+
panel.background = element_blank(),
26+
legend.key = element_blank(),legend.position = "bottom")+guides(colour = guide_legend(nrow = 2))
27+
#ggtitle("Final Rt")
28+
p1
29+
ggsave(paste0("Italy/figures/rt_point_final", "_", label, "_", JOBID, ".pdf"),
30+
p1, width = 5, height=10)
31+
32+
# Only choose start
33+
rt_data_start <- rt_data_long[which(rt_data_long$x == "start"),]
34+
rt_data_start <- rt_data_start[order(-rt_data_start$rt),]
35+
rt_data_start$state <- factor(rt_data_start$state, levels = rt_data_start$state)
36+
37+
rt_data_start$state[which(rt_data_start$state=="Friuli-Venezia_Giulia")]<-"Friuli-Venezia Giulia"
38+
39+
p2 <- ggplot(rt_data_start) +
40+
geom_point(aes(x = state, y = rt, col = macro), stat="identity") +
41+
geom_errorbar(aes(x = state, ymin = rt_min, ymax = rt_max, col=macro), width = 0) +
42+
geom_hline(aes(yintercept=1)) +
43+
xlab("Region") + ylab(expression(R[t])) +
44+
scale_y_continuous(expand = c(0, 0)) +
45+
scale_colour_discrete(name = "") +
46+
coord_flip() +
47+
theme(axis.line = element_line(colour = "black"),
48+
panel.grid.major = element_blank(),
49+
panel.grid.minor = element_blank(),
50+
panel.background = element_blank(),
51+
legend.key = element_blank(),legend.position = "bottom") +guides(colour = guide_legend(nrow = 2))
52+
#ggtitle("Inital Rt")
53+
ggsave(paste0("Italy/figures/rt_point_start_", label, "_", JOBID, ".png"), p2, width = 5, height=10)
54+
55+
}

‎Italy/code/plotting/make-scenario-plots-top7.r‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
library(dplyr)
2+
library(lubridate)
3+
library(grid)
4+
library(gtable)
5+
source("Italy/code/plotting/format-data-plotting.r")
6+
7+
make_scenario_comparison_plots_mobility <- function(JOBID, StanModel, len_forecast, last_date_data,
8+
baseline=FALSE, mobility_increase = 20,top=7){
9+
print(paste0("Making scenario comparision plots for ", mobility_increase , "%"))
10+
load(paste0('Italy/results/sim-constant-mob-', StanModel, '-', len_forecast, '-0-', JOBID, '-stanfit.Rdata'))
11+
12+
countries <- states
13+
14+
out <- rstan::extract(fit)
15+
16+
mob_data <- NULL
17+
for (i in 1:length(countries)){
18+
data_state_plot <- format_data(i = i, dates = dates, countries = countries,
19+
estimated_cases_raw = estimated_cases_raw,
20+
estimated_deaths_raw = estimated_deaths_raw,
21+
reported_cases = reported_cases,
22+
reported_deaths = reported_deaths,
23+
out = out, forecast = 0, SIM = TRUE)
24+
# Cuts data on last_data_date
25+
data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
26+
27+
subset_data <- select(data_state_plot, country, date, reported_deaths, estimated_deaths,
28+
deaths_min, deaths_max)
29+
subset_data$key <- rep("Constant mobility", length(subset_data$country))
30+
mob_data <- rbind(mob_data, subset_data)
31+
}
32+
33+
if (baseline == TRUE){
34+
load(paste0('Italy/results/sim-increase-mob-baseline-', StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID,
35+
'-stanfit.Rdata'))
36+
out <- rstan::extract(fit)
37+
} else {
38+
load(paste0('Italy/results/sim-increase-mob-current-', StanModel, '-', len_forecast, '-', mobility_increase, '-',
39+
JOBID, '-stanfit.Rdata'))
40+
out <- rstan::extract(fit)
41+
}
42+
for (i in 1:length(countries)){
43+
data_state_plot <- format_data(i = i, dates = dates, countries = countries,
44+
estimated_cases_raw = estimated_cases_raw,
45+
estimated_deaths_raw = estimated_deaths_raw,
46+
reported_cases = reported_cases,
47+
reported_deaths = reported_deaths,
48+
out = out, forecast = 0, SIM = TRUE)
49+
# Cuts data on last_data_date
50+
data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
51+
subset_data <- select(data_state_plot, country, date, reported_deaths, estimated_deaths,
52+
deaths_min, deaths_max)
53+
subset_data$key <- rep("Increased mobility", length(subset_data$country))
54+
mob_data <- rbind(mob_data, subset_data)
55+
}
56+
57+
data_half <- mob_data[which(mob_data$key == "Increased mobility"),]
58+
mob_data$key <- factor(mob_data$key)
59+
data_half$key <- factor(data_half$key)
60+
61+
#nametrans <- read.csv("Subnational_Analysis/Italy/province_name_translation.csv")
62+
63+
# To do top 7:
64+
if(top==7){
65+
mob_data <- mob_data %>% filter(country %in% c("Lombardy","Marche","Veneto","Tuscany","Piedmont","Emilia-Romagna","Liguria")) %>%
66+
droplevels()
67+
68+
data_half <- data_half %>% filter(country %in% c("Lombardy","Marche","Veneto","Tuscany","Piedmont","Emilia-Romagna","Liguria")) %>%
69+
droplevels()
70+
}
71+
if(top==8){
72+
# # To do all others"
73+
mob_data <- mob_data %>% filter((country %in% c("Abruzzo","Basilicata","Calabria","Campania","Friuli-Venezia_Giulia","Lazio","Molise"))) %>%
74+
droplevels()
75+
data_half <- data_half %>% filter((country %in% c("Abruzzo","Basilicata","Calabria","Campania","Friuli-Venezia_Giulia","Lazio","Molise"))) %>%
76+
droplevels()
77+
}
78+
if(top==9){
79+
# # To do all others"
80+
mob_data <- mob_data %>% filter((country %in% c("Bolzano","Trento","Apulia","Sardinia","Sicily","Umbria","Aosta"))) %>%
81+
droplevels()
82+
data_half <- data_half %>% filter((country %in% c("Bolzano","Trento","Apulia","Sardinia","Sicily","Umbria","Aosta"))) %>%
83+
droplevels()
84+
}
85+
86+
last_date_data<-mob_data$date[nrow(mob_data)]
87+
88+
#mob_data$label <- mob_data$key %>% str_replace_all(" ", "_") %>% recode( Constant_Mobility= "Mobility held constant", Increased_Mobility = "Increased mobility: ",mobility_increase,"% return to pre-lockdown level")
89+
90+
levels(mob_data$key)=c("Mobility held constant",paste0("Increased mobility: ",mobility_increase,"% return to pre-lockdown level"))
91+
92+
p <- ggplot(mob_data) +
93+
geom_bar(data = mob_data, aes(x = date, y = reported_deaths), stat='identity') +
94+
geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, group = key, fill = key), alpha = 0.5) +
95+
#geom_line(aes(date,deaths_max),color="black",size=0.2)+
96+
#geom_line(aes(date,deaths_min),color="black",size=0.2)+
97+
#geom_line(aes(date,estimated_deaths),group = key,size=0.5)+
98+
geom_line(aes(date,estimated_deaths, group = key, color = key),size = 1) +scale_colour_manual(values= c("skyblue","red"))+
99+
#geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, fill = "ICL"), alpha = 0.5) +
100+
scale_fill_manual(name = "", labels = c("Mobility held constant", paste0("Increased mobility: ",mobility_increase,"% return to pre-lockdown level")), values = c("skyblue","red")) +
101+
scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"), limits = c(as.Date("2020-03-02"), last_date_data)) +
102+
#facet_wrap(~country, scales = "free",nrow=7) +
103+
facet_grid(country ~key, scales = "free_y")+
104+
xlab("") + ylab("Daily number of deaths") +
105+
theme_minimal() +
106+
theme(axis.text.x = element_text(angle = 45, hjust = 1,size = 26), axis.title = element_text( size = 26 ),axis.text = element_text( size = 26),
107+
legend.position = "none",strip.text = element_text(size = 26),legend.text=element_text(size=26))
108+
ggsave(paste0("Italy/figures/scenarios_increase_baseline-", len_forecast, '-', mobility_increase, '-', JOBID, "top_",top,".png"), p, height = 30, width = 20)
109+
110+
}

0 commit comments

Comments
 (0)