In mrc-ide/gf: Global fund malaria modelling

knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
library(ggplot2)
library(patchwork)
library(tidyr)
library(gf)
iso <- unique(gf_optimised$ISO)
country <- unique(gf_optimised$NAME_0)

gf_optimised$pre = factor(gf_optimised$pre, levels = c("continueddisruption", "pastperformance", "targets", "gp"))

Global Fund country report for `r country` (`r iso`)

Date: `r format(Sys.time(), "%d/%m/%y")`

GTS comparions check

gf_global_plan <- gf_gp %>%
  select(year, cases) %>%
  mutate(run = "GF global plan")
gts_global_plan <- gts_gp %>%
  filter(Scenario == "Accelerate2as") %>%
  select(year, cases) %>%
  mutate(run = "GTS global plan")
gts_gf <- bind_rows(gf_global_plan, gts_global_plan)

ggplot(gts_gf, aes(x = year, y = cases, col = run)) +
  geom_line() +
  theme_bw()

\newpage

Budget check

bc <- gf_optimised %>%
  filter(year %in% 2024:2026) %>%
  group_by(pre, budget_prop, post) %>%
  summarise(cost = sum(total_cost)) %>%
  mutate(budget = budget_prop * global_plan_budget,
         p = cost / budget)

ggplot(bc, aes(x = 1:nrow(bc), y = p, col = factor(budget_prop))) +
  geom_point() +
  scale_colour_discrete(name = "") +
  xlab("")+
  ylim(0.8, 1.1) +
  ylab("Cost / Budget") +
  theme_bw()

gf_optimised$budget_prop = factor(gf_optimised$budget_prop)

\newpage

Interventions

interventions_budget_prop <- gf_optimised %>%
  select(year, pre, budget_prop, post, par,
         treatment_coverage, net_coverage, irs_coverage, smc_coverage, ipti_coverage, rtss_coverage) %>%
  filter(year %in% 2024:2026) %>%
  select(-year) %>%
  group_by(pre, budget_prop, post) %>%
  pivot_longer(-c(pre, budget_prop, post, par), names_to = "intervention", values_to = "coverage") %>%
  mutate(intervention = factor(intervention, 
                               levels = c("treatment_coverage",
                                          "net_coverage",
                                          "irs_coverage",
                                          "smc_coverage",
                                          "ipti_coverage",
                                          "rtss_coverage"),
                               labels = c("Treatment",
                                          "Nets",
                                          "IRS", 
                                          "SMC",
                                          "IPTi",
                                          "RTS,S"))) %>%
  group_by(pre, budget_prop, post, intervention) %>%
  summarise(coverage = weighted.mean(coverage, par)) %>%
  mutate(budget_prop = factor(budget_prop, levels = budget_levels))

interventions_replenishment <- ggplot(interventions_budget_prop, aes(x = budget_prop, y = coverage, fill = intervention)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_fill_discrete(name = "") +
  xlab("Proportion of global plan budget") +
  ylab("Effective coverage") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)

print(interventions_replenishment)

\newpage

Weighted sum cases and deaths

y_budget_prop <- gf_optimised %>%
  filter(year %in% 2024:2030) %>%
  group_by(pre, budget_prop, post) %>%
  summarise(y = sum(y))

y_replenishment <- ggplot(y_budget_prop, aes(x = budget_prop, y = y, fill = budget_prop)) +
  geom_bar(stat = "identity") +
  scale_fill_discrete(name = "Proportion of global plan budget") +
  xlab("Proportion of global plan budget") +
  ylab("Weighted sum cases deaths replenishment period") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
y_replenishment

\newpage

Cases

cumulative_case_data <- gf_optimised %>%
  filter(year >= 2019) %>%
  group_by(pre, budget_prop, post) %>%
  arrange(year, .by_group = TRUE) %>%
  mutate(cumulative_cases = cumsum(cases))

cumulative_cases <- ggplot(cumulative_case_data, aes(x = year, y = cumulative_cases / 1e6, col = budget_prop)) + 
  geom_line() +
  scale_colour_discrete(name = "Proportion of global plan budget") +
  xlab("Year") +
  ylab("Cumulative cases (millions, since 2019)") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
cumulative_cases

\newpage

case_data <- gf_optimised %>%
  filter(year >= 2016)

who <- who_burden %>%
  filter(ISO == iso, year %in% 2016:2018)

case_time_series <- ggplot() + 
  geom_line(data = case_data, aes(x = year, y = cases / 1e6, col = budget_prop)) +
  geom_point(data = who, aes(x = year, y = cases / 1e6), col = "red") +
  scale_colour_discrete(name = "Proportion of global plan budget") +
  xlab("Year") +
  ylab("Cases (millions)") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
case_time_series

\newpage

cases_budget_prop <- gf_optimised %>%
  filter(year %in% 2024:2026) %>%
  group_by(pre, budget_prop, post) %>%
  summarise(cases = sum(cases),
            cases_lower = sum(cases_lower),
            cases_upper = sum(cases_upper))

cases_replenishment <- ggplot(cases_budget_prop, aes(x = budget_prop, y = cases / 1e6, fill = budget_prop, ymin = cases_lower / 1e6, ymax = cases_upper / 1e6)) +
  geom_bar(stat = "identity") +
  geom_linerange() +
  scale_fill_discrete(name = "Proportion of global plan budget") +
  xlab("Proportion of global plan budget") +
  ylab("Total cases (millions) during replenishment period") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
cases_replenishment

\newpage

cases_increase_budget_prop <- cases_budget_prop %>%
  group_by(pre, post) %>%
  mutate(cases = cases - cases[budget_prop == 1],
         cases_lower = cases_lower - cases_lower[budget_prop == 1],
         cases_upper = cases_upper - cases_upper[budget_prop == 1])

cases_increase_replenishment <- ggplot(cases_increase_budget_prop, aes(x = budget_prop, y = cases / 1e6, fill = budget_prop, ymin = cases_lower / 1e6, ymax = cases_upper / 1e6)) +
  geom_bar(stat = "identity") +
  geom_linerange() +
  scale_fill_discrete(name = "Proportion of global plan budget") +
  xlab("Proportion of global plan budget") +
  ylab("Increase in cases (millions) vs budget_prop = 1") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
cases_increase_replenishment
#print(cases_increase_replenishment)

\newpage

Deaths

cumulative_death_data <- gf_optimised %>%
  filter(year >= 2019) %>%
  group_by(pre, budget_prop, post) %>%
  arrange(year, .by_group = TRUE) %>%
  mutate(cumulative_deaths = cumsum(deaths))

cumulative_deaths <- ggplot(cumulative_death_data, aes(x = year, y = cumulative_deaths / 1000, col = budget_prop)) + 
  geom_line() +
  scale_colour_discrete(name = "Proportion of global plan budget") +
  xlab("Year") +
  ylab("Cumulative deaths (thousands, since 2019)") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
cumulative_deaths

\newpage

death_data <- gf_optimised %>%
  filter(year >= 2016)

death_time_series <- ggplot() + 
  geom_line(data = death_data, aes(x = year, y = deaths / 1000, col = budget_prop)) +
  scale_colour_discrete(name = "Proportion of global plan budget") +
  xlab("Year") +
  ylab("deaths (thousands)") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
death_time_series

\newpage

deaths_budget_prop <- gf_optimised %>%
  filter(year %in% 2024:2026) %>%
  group_by(pre, budget_prop, post) %>%
  summarise(deaths = sum(deaths),
            deaths_lower = sum(deaths_lower),
            deaths_upper = sum(deaths_upper))

deaths_replenishment <- ggplot(deaths_budget_prop, aes(x = budget_prop, y = deaths / 1000, fill = budget_prop, ymin = deaths_lower / 1000, ymax = deaths_upper / 1000)) +
  geom_bar(stat = "identity") +
  geom_linerange() +
  scale_fill_discrete(name = "Proportion of global plan budget") +
  xlab("Proportion of global plan budget") +
  ylab("Total deaths (thousands) during replenishment period") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
deaths_replenishment

\newpage

DALYS

cumulative_daly_data <- gf_optimised %>%
  filter(year >= 2019) %>%
  group_by(pre, budget_prop, post) %>%
  arrange(year, .by_group = TRUE) %>%
  mutate(cumulative_dalys = cumsum(dalys))

cumulative_dalys <- ggplot(cumulative_daly_data, aes(x = year, y = cumulative_dalys, col = budget_prop)) + 
  geom_line() +
  scale_colour_discrete(name = "Proportion of global plan budget") +
  xlab("Year") +
  ylab("Cumulative dalys (millions, since 2019)") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
cumulative_dalys

\newpage

daly_data <- gf_optimised %>%
  filter(year >= 2016)

daly_time_series <- ggplot() + 
  geom_line(data = daly_data, aes(x = year, y = dalys / 1e6, col = budget_prop)) +
  scale_colour_discrete(name = "Proportion of global plan budget") +
  xlab("Year") +
  ylab("dalys (millions)") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
daly_time_series

\newpage

dalys_budget_prop <- gf_optimised %>%
  filter(year %in% 2024:2026) %>%
  group_by(pre, budget_prop, post) %>%
  summarise(dalys = sum(dalys),
            dalys_lower = sum(dalys_lower),
            dalys_upper = sum(dalys_upper))

dalys_replenishment <- ggplot(dalys_budget_prop, aes(x = budget_prop, y = dalys / 1e6, fill = budget_prop, ymin = dalys_lower / 1e6, ymax = dalys_upper / 1e6)) +
  geom_bar(stat = "identity") +
  geom_linerange() +
  scale_fill_discrete(name = "Proportion of global plan budget") +
  xlab("Proportion of global plan budget") +
  ylab("Total dalys (millions) during replenishment period") +
  theme_bw() +
  theme(legend.title = element_text(size = 10), 
        legend.text  = element_text(size = 10),
        legend.key.size = unit(0.5, "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  facet_grid(post ~ pre)
dalys_replenishment

\newpage

ggplot(gf_fixed, aes(x = year, y = cases, col = pre, linetype = post)) + 
  geom_line() +
  theme_bw()

\newpage

# LLINs
llins <- comp %>%
  select(ISO, year, pre, replenishment, post, net_n, llins_n) %>%
  rename(Out = net_n, In = llins_n) %>%
  pivot_longer(-c(ISO, year, pre, replenishment, post), names_to = "d", values_to = "llins") %>%
  filter(replenishment == 1)

ggplot(llins, aes(x = year, y = llins, fill = d)) + 
  geom_bar(stat = "identity", position = "dodge") +
  facet_grid(pre ~ ISO)

# IRS
irs <- comp %>%
  select(ISO, year, pre, replenishment, post, irs_people_protected, irs_n) %>%
  left_join(gf::hh, by = "ISO") %>%
  mutate(irs_hh = irs_people_protected / hh_size) %>%
  select(-irs_people_protected, -hh_size) %>%
  rename(Out = irs_hh, In = irs_n) %>%
  pivot_longer(-c(ISO, year, pre, replenishment, post), names_to = "d", values_to = "irs") %>%
  filter(replenishment == 1)

ggplot(irs, aes(x = year, y = irs, fill = d)) + 
  geom_bar(stat = "identity", position = "dodge") +
  facet_grid(pre ~ ISO) +
  ylab("IRS HHs")

# SMC
smc <- comp %>%
  mutate(smc_children = smc_coverage * par) %>%
  select(ISO, year, pre, replenishment, post, smc_children, smc_child_n) %>%
  rename(Out = smc_children, In = smc_child_n) %>%
  pivot_longer(-c(ISO, year, pre, replenishment, post), names_to = "d", values_to = "smc") %>%
  filter(replenishment == 1)

ggplot(smc, aes(x = year, y = smc, fill = d)) + 
  geom_bar(stat = "identity", position = "dodge") +
  facet_grid(pre ~ ISO)