knitr::opts_chunk$set(warning = F, message = F)##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Load packages ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if(!require(pacman)) install.packages("pacman")
pacman::p_load(tidyverse, countrycode, here, highcharter, scales, glue)
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Import datasets ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
all_disease <-
rio::import(here("data/dalys-rate-from-all-causes.csv")) %>% as_tibble() %>%
mutate(label = "all") %>%
rename(daly = 4)
ncd_disease <-
rio::import(here("data/burden-of-disease-rates-from-ncds.csv")) %>% as_tibble() %>%
mutate(label = "ncd") %>%
rename(daly = 4)
cd_disease <-
rio::import(here("data/burden-of-disease-rates-from-communicable-neonatal-maternal-nutritional-diseases.csv")) %>% as_tibble() %>%
mutate(label = "cd et al") %>%
rename(daly = 4)
disease <-
all_disease %>%
bind_rows(ncd_disease) %>%
bind_rows(cd_disease)
pop <-
tidyr::world_bank_pop %>%
filter(indicator == "SP.POP.TOTL") %>%
select(country, pop_2017 = "2017")
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Join to calculate absolute DALY ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
disease_pop <-
disease %>%
filter(Year == 2019) %>%
filter(nchar(Code) == 3) %>%
rename(country = Code) %>%
rename(dalys_per_100000 = 4) %>%
mutate(continent = countrycode(country, "iso3c", "continent")) %>%
left_join(pop) %>%
mutate(total_dalys = dalys_per_100000 * (pop_2017/100000))1 Absolute burden
custom_colors_blue <- c("#bad2e3", "#48708a")
disease_pop %>%
filter(label == "all") %>%
group_by(continent) %>%
summarise(`DALYs lost` = sum(total_dalys, na.rm = T)) %>%
mutate(continent = fct_reorder(continent, -`DALYs lost`)) %>%
arrange(continent) %>%
mutate(data_label = scales::comma(`DALYs lost`)) %>%
mutate(tooltip_label = glue::glue("{continent}: {scales::comma(`DALYs lost`)} ")) %>%
mutate(colors = colorize(`DALYs lost`, custom_colors_blue)) %>%
hchart(., "bar",
hcaes(x = continent, y = `DALYs lost`),
dataLabels = list(
enabled = TRUE,
formatter = JS("function(){return(this.point.data_label)}")
)) %>%
hc_colorAxis(stops= color_stops(colors = custom_colors_blue)) %>%
hc_title(text = "DALYs lost in 2019 to any cause, by continent") %>%
hc_tooltip(formatter = JS("function(){return(this.point.tooltip_label)}"))disease_pop %>%
filter(label == "all") %>%
arrange(-total_dalys) %>%
rename(Country = Entity) %>%
rename(`DALYs lost` = total_dalys) %>%
slice_head(n = 20) %>%
mutate(data_label = scales::comma(`DALYs lost`)) %>%
mutate(tooltip_label = glue::glue("{Country}: {scales::comma(`DALYs lost`)} ")) %>%
mutate(colors = colorize(`DALYs lost`, custom_colors_blue)) %>%
hchart("bar",
hcaes(x = Country, y = `DALYs lost`, color = colors),
color = "#f77c57",
dataLabels = list(
enabled = TRUE,
formatter = JS("function(){return(this.point.data_label)}")
)) %>%
hc_colorAxis(stops= color_stops(colors = custom_colors_blue)) %>%
hc_title(text = "DALYs lost in 2019 to any cause, by country") %>%
hc_subtitle(text = "20 highest-burden countries") %>%
hc_tooltip(formatter = JS("function(){return(this.point.tooltip_label)}")) %>%
hc_legend(enabled = F)2 Relative burden
custom_colors_red <- c("#e0b4c3", "#bd577a")
disease_pop %>%
filter(label == "all") %>%
group_by(continent) %>%
summarise(total_dalys = sum(total_dalys, na.rm = T),
total_pop = sum(pop_2017, na.rm = T)) %>%
mutate(`DALYs lost per 100,000` = 100000 * total_dalys/total_pop ) %>%
mutate(continent = fct_reorder(continent, -`DALYs lost per 100,000`)) %>%
arrange(continent) %>%
mutate(data_label = scales::comma(`DALYs lost per 100,000`)) %>%
mutate(tooltip_label = glue::glue("{continent}: {scales::comma(`DALYs lost per 100,000`)} ")) %>%
mutate(colors = colorize(`DALYs lost per 100,000`, custom_colors_red)) %>%
hchart(., "bar",
hcaes(x = continent, y = `DALYs lost per 100,000`),
dataLabels = list(
enabled = TRUE,
formatter = JS("function(){return(this.point.data_label)}")
)) %>%
hc_colorAxis(stops= color_stops(colors = custom_colors_red)) %>%
hc_title(text = "DALYs lost per 100,000 in 2019 to any cause, by continent") %>%
hc_tooltip(formatter = JS("function(){return(this.point.tooltip_label)}"))disease_pop %>%
filter(label == "all") %>%
rename(Country = Entity) %>%
mutate(`DALYs lost per 100,000` = 100000 * total_dalys/pop_2017 ) %>%
arrange(-`DALYs lost per 100,000`) %>%
slice_head(n = 20) %>%
mutate(data_label = scales::comma(`DALYs lost per 100,000`)) %>%
mutate(tooltip_label = glue::glue("{Country}: {scales::comma(`DALYs lost per 100,000`)} ")) %>%
mutate(colors = colorize(`DALYs lost per 100,000`, custom_colors_red)) %>%
hchart("bar",
hcaes(x = Country, y = `DALYs lost per 100,000`, color = colors),
color = "#f77c57",
dataLabels = list(
enabled = TRUE,
formatter = JS("function(){return(this.point.data_label)}")
)) %>%
hc_colorAxis(stops= color_stops(colors = custom_colors_red)) %>%
hc_title(text = "DALYs lost per 100,000 in 2019 to any cause, by country") %>%
hc_subtitle(text = "20 highest-burden countries") %>%
hc_tooltip(formatter = JS("function(){return(this.point.tooltip_label)}")) %>%
hc_legend(enabled = F)A work by The GRAPH Courses Team