Comparison of regional TB incidence and mortality rates

com_tb_inc_mort

# install.packages("getTBinR")
library(getTBinR)
# install.packages("tidyverse")
library(tidyverse)
# install.packages("viridis")
library(viridis)
# install.packages("hrbrthemes")
library(hrbrthemes)
# install.packages("scales")
library(scales)

# Get the TB data and it's data dictionary
tb_df <- get_tb_burden()
dict_df <- get_data_dict()


## Make function to plot rates in a given region
plot_rate_region <- function(df = NULL, metric = NULL, title = NULL, subtitle = NULL, 
                             y_lab = NULL, scales = NULL) {
  
  metric_vars <- c(metric, paste0(metric, "_lo"), paste0(metric, "_hi"))
    
  df <- df %>% 
    group_by(year, g_whoregion) %>% 
    summarise_at(.vars = c(metric_vars, "e_pop_num"),
                 .funs = funs(sum(as.numeric(.), na.rm = T))) %>% 
    ungroup() %>% 
    mutate_at(.vars = metric_vars,
              .funs = funs(. / e_pop_num * 1e5))
  
  df %>% 
    ggplot(aes_string(x = "year", y = metric, col = "g_whoregion", 
                      fill = "g_whoregion")) +
    geom_point(size = 1.3) +
    geom_ribbon(aes_string(ymin = metric_vars[2], ymax = metric_vars[3]), alpha = 0.3) +
    geom_line(size = 1.1) +
    scale_y_continuous(labels = comma) +
    scale_colour_viridis(discrete = TRUE, option = "E") +
    scale_fill_viridis(discrete = TRUE, option = "E") +
    labs(title = title, subtitle = subtitle, 
         x = "Year", y = y_lab,
         caption = "@seabbs Source: World Health Organisation") +
    theme_ipsum() +
    theme(legend.position = "none") +
    facet_wrap(~g_whoregion, scales = scales)
}


# Plot regional incidence rates
tb_df %>% 
  plot_rate_region(metric = "e_inc_num",
                   title = "Tuberculosis Incidence Rates",
                   subtitle = "By WHO region: 2000 to 2016",
                   scales = "fixed",
                   y_lab = "Tuberculosis Incidence Rates (per 100,000 population)")

ggsave("regional_tb_inc.png", width = 12, height = 8, dpi = 330)
# Plot regional mortality rate
tb_df %>% 
  plot_rate_region(metric = "e_mort_num",
                   title = "Tuberculosis Mortality Rates",
                   subtitle = "By WHO region: 2000 to 2016",
                   scales = "fixed",
                   y_lab = "Tuberculosis Mortality Rates (per 100,000 population)")

ggsave("regional_tb_mort.png", width = 12, height = 8, dpi = 330)

## Allow y axis to vary
# Plot regional incidence rates - free y
inc_plot <- tb_df %>% 
  plot_rate_region(metric = "e_inc_num",
                   title = "Tuberculosis Incidence Rates",
                   subtitle = "By WHO region: 2000 to 2016 (variable y axis)",
                   scales = "free_y",
                   y_lab = "Tuberculosis Incidence Rates (per 100,000 population)")


ggsave("regional_tb_inc_free_y.png", width = 12, height = 8, dpi = 330)

# Plot regional mortality rate - free y
mortality_plot <- tb_df %>% 
  plot_rate_region(metric = "e_mort_num",
                   title = "Tuberculosis Mortality Rates",
                   subtitle = "By WHO region: 2000 to 2016 (variable y axis)",
                   scales = "free_y",
                   y_lab = "Tuberculosis Mortality Rates (per 100,000 population)")

ggsave("regional_tb_mort_free_y.png", width = 12, height = 8, dpi = 330)