coverage_report_data.R

################################################################################
#
# Description: This script produces metadata, figurs and tables to go into the
#              mabs_and_antivirvals_coverage_report.rmd 
#
# Input: /output/data/data_processed.rds
#
# Output: /output/reports/coverage/tables/table_report_stats.csv
#         /output/reports/coverage/tables/table_elig_treat_redacted.csv
#         /output/reports/coverage/tables/table_demo_clinc_breakdown_redacted.csv
#         /output/reports/coverage/tables/table_high_risk_cohort_comparison.csv
#         /output/reports/coverage/figures/figure_cum_treatment_plot.png
#         /output/reports/coverage/figures/figure_cum_eligiblity_plot.png
#
# Author(s): M Green
# Date last updated: 07/02/2022
#
################################################################################


# Preliminaries ----

## Import libraries
library(tidyverse)
library(here)
library(glue)
library(gt)
library(gtsummary)
library(reshape2)
library(stringr)

## Import custom user functions
source(here("analysis", "lib", "custom_functions.R"))

## Create output directory
fs::dir_create(here::here("output", "reports", "coverage", "tables"))

## Import data
data_processed <- read_rds(here::here("output", "data", "data_processed.rds"))

## Redaction threshold
threshold = 5

# Format data ----

## Same end data
# end <- min(data_processed$elig_start, data_processed$treatment_date)
# data_processed_censored <- data_processed %>%
#   filter(elig_start <= end,
#          treatment_date <= end)

## Define high risk cohorts
data_processed_hrc_matched <- data_processed %>%
  mutate(
    # Sort naming conventions
    high_risk_cohort_covid_therapeutics = ifelse(high_risk_cohort_covid_therapeutics == "other", NA, high_risk_cohort_covid_therapeutics),
    high_risk_cohort_covid_therapeutics = str_replace(high_risk_cohort_covid_therapeutics, 
                                                      "haematological diseases,stem cell transplant recipients", 
                                                      "haematological diseases and stem cell transplant recipients"),
    high_risk_cohort_covid_therapeutics = str_replace(high_risk_cohort_covid_therapeutics, 
                                                      "stem cell transplant recipients,haematological diseases", 
                                                      "haematological diseases and stem cell transplant recipients"),
    high_risk_cohort_covid_therapeutics = str_replace(high_risk_cohort_covid_therapeutics, 
                                                      "stem cell transplant recipients,haematological diseases", 
                                                      "haematological diseases and stem cell transplant recipients"),
    high_risk_cohort_covid_therapeutics = str_replace(high_risk_cohort_covid_therapeutics, 
                                                      "haematological malignancies", 
                                                      "haematological diseases and stem cell transplant recipients"),
    
    # Find matches between elig and treated high risk cohorts
    ind_therapeutic_groups = map_chr(strsplit(high_risk_cohort_covid_therapeutics, ","), paste,collapse="|"),
    Match = str_detect(high_risk_group_nhsd_combined, ind_therapeutic_groups)
    ) %>%
  rowwise() %>%
  mutate(
    # Combined elig and treated high risk cohorts
    high_risk_group_combined = ifelse(Match == TRUE,
                                      paste(high_risk_group_nhsd_combined, high_risk_cohort_covid_therapeutics, sep = ","), ""),
    high_risk_group_combined = paste(unique(strsplit(high_risk_group_combined, ",|\\n")[[1]]), collapse = ","),
    high_risk_group_combined_count = ifelse(high_risk_group_combined != "", str_count(high_risk_group_combined,",") + 1, NA),
    
    ## Eligible high risk cohorts
    high_risk_group_elig = ifelse((Match == FALSE & !is.na(high_risk_group_nhsd_combined)), 
                                  high_risk_group_nhsd_combined, high_risk_group_combined),
    high_risk_group_elig = paste(unique(strsplit(high_risk_group_elig, ",|\\n")[[1]]), collapse = ","),
    high_risk_group_elig_count = ifelse(high_risk_group_elig != "", str_count(high_risk_group_elig,",") + 1, NA),
    
    ## Treated high risk cohorts
    high_risk_group_treated = ifelse((Match == FALSE & !is.na(high_risk_cohort_covid_therapeutics)), 
                                     high_risk_cohort_covid_therapeutics, high_risk_group_combined),
    high_risk_group_treated = paste(unique(strsplit(high_risk_group_treated, ",|\\n")[[1]]), collapse = ","),
    high_risk_group_treated_count = ifelse(high_risk_group_treated != "", str_count(high_risk_group_treated,",") + 1, NA)
    ) %>%
  select(-ind_therapeutic_groups)


## Apply eligibility and exclusion criteria
data_processed_eligible <- data_processed_hrc_matched %>%
   filter(
    # Alive and registered
    has_died == 0,
    registered_eligible == 1 | registered_treated == 1,
     
    # Apply eligibility criteria
    covid_test_positive == 1,
    covid_positive_previous_30_days != 1,
    (tb_postest_treat <= 5 & tb_postest_treat >= 0) | is.na(tb_postest_treat),
    !is.na(high_risk_group_combined),
    
    # Apply exclusion criteria
    is.na(covid_hospital_admission_date) | covid_hospital_admission_date < (elig_start - 30) & covid_hospital_admission_date > (elig_start),
    age >= 12,
    
    # Only eligible patients
    !is.na(elig_start),
  ) %>%
  mutate(eligibility_status = "Eligible") 

## Include treated patients not flagged as eligible
data_processed_treated <- data_processed_hrc_matched %>%
  filter(
    
    # Treat but non-eligible patients
    !(patient_id %in% unique(data_processed_eligible$patient_id)),
    !is.na(treatment_date),
    
    # Alive and registered
    has_died == 0,
    registered_eligible == 1 | registered_treated == 1
    ) %>%
  mutate(elig_start = as.Date(ifelse(is.na(elig_start), treatment_date, elig_start), origin = "1970-01-01"),
         eligibility_status = "Treated") 

data_processed_combined <- rbind(data_processed_eligible, data_processed_treated)

## Exclude patients issued more than one treatment within two weeks
dup_ids <- data_processed_combined %>%
  select(patient_id, treatment_date, sotrovimab_covid_therapeutics, molnupiravir_covid_therapeutics, casirivimab_covid_therapeutics) %>%
  filter(!is.na(treatment_date)) %>%
  mutate(sotrovimab_covid_therapeutics = as.Date(sotrovimab_covid_therapeutics, origin="1970-01-01"),
         molnupiravir_covid_therapeutics = as.Date(molnupiravir_covid_therapeutics, origin="1970-01-01"),
         casirivimab_covid_therapeutics = as.Date(casirivimab_covid_therapeutics, origin="1970-01-01"),
         sot_mol_diff = as.numeric(sotrovimab_covid_therapeutics - molnupiravir_covid_therapeutics),
         sot_cas_diff = as.numeric(sotrovimab_covid_therapeutics - casirivimab_covid_therapeutics),
         mol_cas_diff = as.numeric(molnupiravir_covid_therapeutics - casirivimab_covid_therapeutics)) %>%
  melt(id.var = "patient_id", measure.vars = c("sot_mol_diff", "sot_cas_diff", "mol_cas_diff")) %>%
  filter(!is.na(value),
         value <= 14 | value >= -14) %>%
  group_by(patient_id) %>%
  arrange(patient_id) 

data_processed_clean <- data_processed_combined %>%
  subset(!(patient_id %in% unique(dup_ids$patient_id)))

## Formatting variables
data_processed_clean <- data_processed_clean %>%
  mutate(
    
    # Age groups
    ageband = cut(
      age,
      breaks = c(12, 30, 40, 50, 60, 70, 80, Inf),
      labels = c("12-29", "30-39", "40-49", "50-59", "60-69", "70-79", "80+"),
      right = FALSE),
    
    #IMD
    imd = as.character(imd),
    imd = ifelse(imd %in% c("1 most deprived", 2:4, "5 least deprived"), imd, "Unknown"),
    imd = fct_case_when(
      imd == "1 most deprived" ~ "1 most deprived",
      imd == 2 ~ "2",
      imd == 3 ~ "3",
      imd == 4 ~ "4",
      imd == "5 least deprived" ~ "5 least deprived",
      imd == "Unknown" ~ "Unknown",
      #TRUE ~ "Unknown",
      TRUE ~ NA_character_
    ),
    
    # Region
    region = as.character(region_nhs),
    region = fct_case_when(
      region == "London" ~ "London",
      region == "East of England" ~ "East of England",
      region == "East Midlands" ~ "East Midlands",
      region == "North East" ~ "North East",
      region == "North West" ~ "North West",
      region == "South East" ~ "South East",
      region == "South West" ~ "South West",
      region == "West Midlands" ~ "West Midlands",
      region == "Yorkshire and the Humber" ~ "Yorkshire and the Humber",
      #TRUE ~ "Unknown"
      TRUE ~ NA_character_)
    
    # # High risk cohort
    # high_risk_group_nhsd = as.character(high_risk_group_nhsd),
    # high_risk_group_nhsd = fct_case_when(
    #   high_risk_group_nhsd == "Down's syndrome" ~ "Down's syndrome",
    #   high_risk_group_nhsd == "Sickle cell disease" ~ "Sickle cell disease",
    #   high_risk_group_nhsd == "Patients with a solid cancer" ~ "Solid cancer",
    #   high_risk_group_nhsd == "Patients with a haematological diseases and stem cell transplant recipients" ~ "Haematological diseases and stem cell transplant recipients",
    #   high_risk_group_nhsd == "Patients with renal disease" ~ "Renal disease",
    #   high_risk_group_nhsd == "Patients with liver disease" ~ "Liver disease",
    #   high_risk_group_nhsd == "Patients with immune-mediated inflammatory disorders (IMID)" ~ "Immune-mediated inflammatory disorders",
    #   high_risk_group_nhsd == "Primary immune deficiencies" ~ "Primary immune deficiencies",
    #   high_risk_group_nhsd == "HIV/AIDS" ~ "HIV or AIDS",
    #   high_risk_group_nhsd == "Solid organ transplant recipients" ~ "Solid organ transplant recipients",
    #   high_risk_group_nhsd == "Rare neurological conditions" ~ "Rare neurological conditions",
    #   high_risk_group_nhsd == "Not deemed eligible" ~ "Not deemed eligible",
    #   #TRUE ~ "Unknown"
    #   TRUE ~ NA_character_)

  )


# Numbers for text ----
study_start <- min(data_processed_clean$elig_start, na.rm = T)
study_end <- max(data_processed_clean$elig_start, na.rm = T)
eligible_patients <- plyr::round_any(data_processed_clean %>% filter(eligibility_status == "Eligible") %>% nrow(), 10)

eligible_treated_patients <- plyr::round_any(data_processed_clean %>% filter(!is.na(treatment_date), eligibility_status == "Eligible") %>% nrow(), 10)
eligible_sotrovimab <- plyr::round_any(data_processed_clean %>% filter(treatment_type == "Sotrovimab",  eligibility_status == "Eligible") %>% nrow(), 10)
eligible_molnupiravir <- plyr::round_any(data_processed_clean %>% filter(treatment_type == "Molnupiravir",  eligibility_status == "Eligible") %>% nrow(), 10)
eligible_casirivimab <- plyr::round_any(data_processed_clean %>% filter(treatment_type == "Casirivimab",  eligibility_status == "Eligible") %>% nrow(), 10)

noneligible_treated_patients <- plyr::round_any(data_processed_clean %>% filter(!is.na(treatment_date), eligibility_status == "Treated") %>% nrow(), 10)
noneligible_sotrovimab <- plyr::round_any(data_processed_clean %>% filter(treatment_type == "Sotrovimab",  eligibility_status == "Treated") %>% nrow(), 10)
noneligible_molnupiravir <- plyr::round_any(data_processed_clean %>% filter(treatment_type == "Molnupiravir",  eligibility_status == "Treated") %>% nrow(), 10)
noneligible_casirivimab <- plyr::round_any(data_processed_clean %>% filter(treatment_type == "Casirivimab",  eligibility_status == "Treated") %>% nrow(), 10)

hrc_groups <- data_processed_clean %>% 
  group_by(high_risk_group_combined_count) %>% 
  summarise(count = n()) %>%
  filter(count > 4)

high_risk_cohort_2plus <- plyr::round_any(sum(subset(hrc_groups, high_risk_group_combined_count > 1)$count), 10)
high_risk_cohort_lower <- min(hrc_groups$high_risk_group_combined_count)
high_risk_cohort_upper <- max(hrc_groups$high_risk_group_combined_count)

died_dereg <- data_processed_hrc_matched %>%
  filter(!(patient_id %in% unique(data_processed_eligible$patient_id)),
         !is.na(treatment_date),
         has_died == 1 | registered_eligible == 0 | registered_treated == 0) %>%
  nrow() %>%
  plyr::round_any(.,10)

died <- data_processed_hrc_matched %>%
  filter(!(patient_id %in% unique(data_processed_eligible$patient_id)),
         !is.na(treatment_date),
         has_died == 1) %>%
  nrow()  %>%
  plyr::round_any(.,10)

dereg <- data_processed_hrc_matched %>%
  filter(!(patient_id %in% unique(data_processed_eligible$patient_id)),
         !is.na(treatment_date),
         registered_eligible == 0 | registered_treated == 0) %>%
  nrow()  %>%
  plyr::round_any(.,10)

text <- data.frame(study_start, study_end, 
                   eligible_patients, eligible_treated_patients, eligible_sotrovimab, eligible_molnupiravir, eligible_casirivimab, 
                   noneligible_treated_patients, noneligible_sotrovimab, noneligible_molnupiravir, noneligible_casirivimab,
                   high_risk_cohort_2plus, high_risk_cohort_lower, high_risk_cohort_upper,
                   died_dereg, died, dereg)

write_csv(text, here::here("output", "reports", "coverage", "tables", "table_report_stats_redacted.csv"))


# Coverage ----

## Eligibility
plot_data_coverage <- data_processed_clean %>%
  mutate(patient_id = 1) %>%
  filter(eligibility_status == "Eligible") %>%
  group_by(elig_start) %>%
  summarise(count = sum(patient_id, na.rm  = T)) %>%
  arrange(elig_start) %>%
  ungroup() %>%
  arrange(elig_start) %>%
  complete(elig_start = seq.Date(min(elig_start, na.rm = T), max(elig_start, na.rm = T), by="day")) %>%
  group_by(elig_start) %>%
  summarise(count = sum(count, na.rm = T)) %>%
  ungroup() %>%
  mutate(count = ifelse(is.na(count), 0, count),
         cum_count = cumsum(count),
         cum_count_redacted =  plyr::round_any(cum_count, 10)) %>%
  mutate(high_risk_group_elig = "All")

plot_data_coverage_groups <- data_processed_clean %>%
  filter(eligibility_status == "Eligible") %>%
  select(patient_id, elig_start, high_risk_group_elig) %>%
  separate(high_risk_group_elig, 
           c(paste("Group_", 1:max(subset(data_processed_clean, eligibility_status == "Eligible")$high_risk_group_elig_count, na.rm = T), sep = "")),
           sep = ",") %>%
  reshape2::melt(id.var = c("patient_id", "elig_start")) %>%
  filter(!is.na(value)) %>%
  mutate(patient_id = 1) %>%
  select(patient_id, elig_start, high_risk_group_elig = value) %>%
  group_by(elig_start, high_risk_group_elig) %>%
  summarise(count = sum(patient_id, na.rm  = T)) %>%
  arrange(elig_start, high_risk_group_elig) %>%
  group_by(high_risk_group_elig) %>%
  complete(elig_start = seq.Date(min(elig_start, na.rm = T), max(elig_start, na.rm = T), by="day")) %>%
  mutate(count = ifelse(is.na(count), 0, count),
         cum_count = cumsum(count),
         cum_count_redacted =  plyr::round_any(cum_count, 10))

plot_order <- rbind(plot_data_coverage, plot_data_coverage_groups) %>%
  group_by(high_risk_group_elig) %>%
  mutate(order = max(cum_count_redacted, na.rm = T)) %>%
  arrange(desc(order)) %>%
  filter(cum_count_redacted == order) %>%
  select(high_risk_group_elig, order) %>%
  distinct()

coverage_plot_data <- rbind(plot_data_coverage, plot_data_coverage_groups) %>%
  mutate(high_risk_group_elig = factor(high_risk_group_elig, levels = plot_order$high_risk_group_elig))

write_csv(coverage_plot_data %>% select(elig_start, cum_count_redacted, high_risk_group_elig), here::here("output", "reports", "coverage", "tables", "table_cum_eligiblity_redacted.csv"))

## Treatment - eligible
plot_data_treatment <- data_processed_clean %>%
  mutate(patient_id = 1) %>%
  filter(eligibility_status == "Eligible",
         !is.na(treatment_date)) %>%
  group_by(treatment_date) %>%
  summarise(count = sum(patient_id, na.rm  = T)) %>%
  arrange(treatment_date) %>%
  ungroup() %>%
  arrange(treatment_date) %>%
  complete(treatment_date = seq.Date(min(treatment_date, na.rm = T), max(treatment_date, na.rm = T), by="day")) %>%
  group_by(treatment_date) %>%
  summarise(count = sum(count, na.rm = T)) %>%
  ungroup() %>%
  mutate(count = ifelse(is.na(count), 0, count),
         cum_count = cumsum(count),
         cum_count_redacted =  plyr::round_any(cum_count, 10)) %>%
  mutate(high_risk_group_treated = "All")

plot_data_treatment_groups <- data_processed_clean %>%
  filter(eligibility_status == "Eligible",
         !is.na(treatment_date)) %>%
  select(patient_id, treatment_date, high_risk_group_treated) %>%
  separate(high_risk_group_treated, 
           c(paste("Group_", 1:max(subset(data_processed_clean, eligibility_status == "Eligible")$high_risk_group_elig_count, na.rm = T), sep = "")),
           sep = ",") %>%
  reshape2::melt(id.var = c("patient_id", "treatment_date")) %>%
  filter(!is.na(value)) %>%
  mutate(patient_id = 1) %>%
  select(patient_id, treatment_date, high_risk_group_treated = value) %>%
  group_by(treatment_date, high_risk_group_treated) %>%
  summarise(count = sum(patient_id, na.rm  = T)) %>%
  arrange(treatment_date, high_risk_group_treated) %>%
  group_by(high_risk_group_treated) %>%
  complete(treatment_date = seq.Date(min(treatment_date, na.rm = T), max(treatment_date, na.rm = T), by="day")) %>%
  mutate(count = ifelse(is.na(count), 0, count),
         cum_count = cumsum(count),
         cum_count_redacted =  plyr::round_any(cum_count, 10))

plot_order <- rbind(plot_data_treatment, plot_data_treatment_groups) %>%
  group_by(high_risk_group_treated) %>%
  mutate(order = max(cum_count_redacted, na.rm = T)) %>%
  arrange(desc(order)) %>%
  filter(cum_count_redacted == order) %>%
  select(high_risk_group_treated, order) %>%
  distinct()

treatment_plot_data_therapeutics <- rbind(plot_data_treatment, plot_data_treatment_groups) %>%
  mutate(high_risk_group_treated = factor(high_risk_group_treated, levels = plot_order$high_risk_group_treated))

write_csv(treatment_plot_data_therapeutics %>% select(treatment_date, cum_count_redacted, high_risk_group_treated), here::here("output", "reports", "coverage", "tables", "table_cum_treatment_redacted.csv"))

## Treatment - non eligble
plot_data_treatment2 <- data_processed_clean %>%
  mutate(patient_id = 1) %>%
  filter(eligibility_status == "Treated",
         !is.na(treatment_date)) %>%
  group_by(treatment_date) %>%
  summarise(count = sum(patient_id, na.rm  = T)) %>%
  arrange(treatment_date) %>%
  ungroup() %>%
  arrange(treatment_date) %>%
  complete(treatment_date = seq.Date(min(treatment_date, na.rm = T), max(treatment_date, na.rm = T), by="day")) %>%
  group_by(treatment_date) %>%
  summarise(count = sum(count, na.rm = T)) %>%
  ungroup() %>%
  mutate(count = ifelse(is.na(count), 0, count),
         cum_count = cumsum(count),
         cum_count_redacted =  plyr::round_any(cum_count, 10)) %>%
  mutate(high_risk_group_treated = "All")

plot_data_treatment2_groups <- data_processed_clean %>%
  filter(eligibility_status == "Treated",
         !is.na(treatment_date)) %>%
  select(patient_id, treatment_date, high_risk_group_treated) %>%
  separate(high_risk_group_treated, 
           c(paste("Group_", 1:max(subset(data_processed_clean, eligibility_status == "Eligible")$high_risk_group_elig_count, na.rm = T), sep = "")),
           sep = ",") %>%
  reshape2::melt(id.var = c("patient_id", "treatment_date")) %>%
  filter(!is.na(value)) %>%
  mutate(patient_id = 1) %>%
  select(patient_id, treatment_date, high_risk_group_treated = value) %>%
  group_by(treatment_date, high_risk_group_treated) %>%
  summarise(count = sum(patient_id, na.rm  = T)) %>%
  arrange(treatment_date, high_risk_group_treated) %>%
  group_by(high_risk_group_treated) %>%
  complete(treatment_date = seq.Date(min(treatment_date, na.rm = T), max(treatment_date, na.rm = T), by="day")) %>%
  mutate(count = ifelse(is.na(count), 0, count),
         cum_count = cumsum(count),
         cum_count_redacted =  plyr::round_any(cum_count, 10))

plot_order <- rbind(plot_data_treatment2, plot_data_treatment2_groups) %>%
  group_by(high_risk_group_treated) %>%
  mutate(order = max(cum_count_redacted, na.rm = T)) %>%
  arrange(desc(order)) %>%
  filter(cum_count_redacted == order) %>%
  select(high_risk_group_treated, order) %>%
  distinct()

treatment_plot_data_therapeutics2 <- rbind(plot_data_treatment2, plot_data_treatment2_groups) %>%
  mutate(high_risk_group_treated = factor(high_risk_group_treated, levels = plot_order$high_risk_group_treated))

write_csv(treatment_plot_data_therapeutics2 %>% select(treatment_date, cum_count_redacted, high_risk_group_treated), here::here("output", "reports", "coverage", "tables", "table_cum_treatment2_redacted.csv"))


# Delivery ----

## Eligible and treated table
eligibility_table <- data_processed_clean %>%
  filter(eligibility_status == "Eligible") %>%
  select(patient_id, high_risk_group_elig) %>%
  separate(high_risk_group_elig, 
           c(paste("Group_", 1:max(subset(data_processed_clean, !is.na(treatment_date))$high_risk_group_elig_count, na.rm = T), sep = "")),
           sep = ",") %>%
  reshape2::melt(id.var = c("patient_id")) %>%
  mutate(value = as.character(value)) %>%
  filter(!is.na(value),
         value != "") %>%
  select(high_risk_group = value) %>%
  tbl_summary()

eligibility_table$inputs$data <- NULL

eligibility_table <- eligibility_table$table_body %>%
  separate(stat_0, c("stat_0","perc0"), sep = " ([(])") %>%
  select(`High risk cohort` = label, 
         `Number of eligible patients` = stat_0) %>%
  mutate(`Number of eligible patients` = as.numeric(gsub(",", "", `Number of eligible patients`))) %>%
  data.frame() %>%
  mutate(High.risk.cohort = ifelse(High.risk.cohort == "high_risk_group", "All", High.risk.cohort),
         Number.of.eligible.patients = ifelse(High.risk.cohort == "All", 
                                              length(unique(subset(data_processed_clean, eligibility_status == "Eligible")$patient_id)),
                                              Number.of.eligible.patients)) %>%
  arrange(desc(Number.of.eligible.patients))

treatment_table <- data_processed_clean %>%
  filter(eligibility_status == "Eligible") %>%
  select(patient_id, high_risk_group_treated, treatment_type) %>%
  separate(high_risk_group_treated, 
           c(paste("Group_", 1:max(subset(data_processed_clean, !is.na(treatment_date))$high_risk_group_treated_count, na.rm = T), sep = "")),
           sep = ",") %>%
  reshape2::melt(id.var = c("patient_id", "treatment_type")) %>%
  mutate(value = as.character(value)) %>%
  filter(!is.na(value),
         value != "") %>%
  select(high_risk_group = value, treatment_type) %>%
  tbl_summary(by = treatment_type) %>%
  add_overall()

treatment_table$inputs$data <- NULL

treatment_table <- treatment_table$table_body %>%
  separate(stat_0, c("stat_0","perc0"), sep = " ([(])") %>%
  separate(stat_1, c("stat_1","perc1"), sep = " ([(])") %>%
  separate(stat_2, c("stat_2","perc2"), sep = " ([(])") %>%
  separate(stat_3, c("stat_3","perc3"), sep = " ([(])") %>%
  select(`High risk cohort` = label, 
         `Number of treated patients` = stat_0,
         `Treated with Casirivimab` = stat_1,
         `Treated with Molnupiravir` = stat_2,
         `Treated with Sotrovimab` = stat_3) %>%
  mutate(`Number of treated patients` = as.numeric(gsub(",", "", `Number of treated patients`)),
         `Treated with Casirivimab` = as.numeric(gsub(",", "", `Treated with Casirivimab`)),
         `Treated with Molnupiravir` = as.numeric(gsub(",", "", `Treated with Molnupiravir`)),
         `Treated with Sotrovimab` = as.numeric(gsub(",", "", `Treated with Sotrovimab`))) %>%
  data.frame()  %>%
  mutate(High.risk.cohort = ifelse(High.risk.cohort == "high_risk_group", "All", High.risk.cohort),
         Number.of.treated.patients = ifelse(High.risk.cohort == "All", 
                                              length(unique(subset(data_processed_clean, eligibility_status == "Eligible" & !is.na(treatment_date))$patient_id)),
                                             Number.of.treated.patients),
         Treated.with.Casirivimab = ifelse(High.risk.cohort == "All", eligible_casirivimab, Treated.with.Casirivimab),
         Treated.with.Molnupiravir = ifelse(High.risk.cohort == "All", eligible_molnupiravir, Treated.with.Casirivimab),
         Treated.with.Sotrovimab = ifelse(High.risk.cohort == "All", eligible_sotrovimab, Treated.with.Casirivimab))

table_elig_treat_redacted <- left_join(eligibility_table, treatment_table, by = "High.risk.cohort") %>%
  # Redact values < 8
  mutate(Number.of.eligible.patients = ifelse(Number.of.eligible.patients < threshold, NA, as.numeric(Number.of.eligible.patients)),
         Number.of.treated.patients = ifelse(Number.of.treated.patients < threshold, NA, as.numeric(Number.of.treated.patients)),
         Treated.with.Casirivimab = ifelse(Treated.with.Casirivimab < threshold, NA, as.numeric(Treated.with.Casirivimab)),
         Treated.with.Molnupiravir = ifelse(Treated.with.Molnupiravir < threshold, NA, as.numeric(Treated.with.Molnupiravir)),
         Treated.with.Sotrovimab = ifelse(Treated.with.Sotrovimab < threshold, NA, as.numeric(Treated.with.Sotrovimab))
         ) %>%
  # Round to nearest 10
  mutate(Number.of.eligible.patients = plyr::round_any(Number.of.eligible.patients, 10),
         Number.of.treated.patients = plyr::round_any(Number.of.treated.patients, 10),
         Treated.with.Casirivimab = plyr::round_any(as.numeric(Treated.with.Casirivimab), 10),
         Treated.with.Molnupiravir = plyr::round_any(Treated.with.Molnupiravir, 10),
         Treated.with.Sotrovimab = plyr::round_any(Treated.with.Sotrovimab, 10))

write_csv(table_elig_treat_redacted, here::here("output", "reports", "coverage", "tables", "table_elig_treat_redacted.csv"))

## Non-eligible and treated table
treatment_table <- data_processed_clean %>%
  filter(eligibility_status == "Treated") %>%
  select(patient_id, high_risk_group_treated, treatment_type) %>%
  separate(high_risk_group_treated, 
           c(paste("Group_", 1:max(subset(data_processed_clean, !is.na(treatment_date))$high_risk_group_treated_count, na.rm = T), sep = "")),
           sep = ",") %>%
  reshape2::melt(id.var = c("patient_id", "treatment_type")) %>%
  mutate(value = as.character(value)) %>%
  filter(!is.na(value),
         value != "") %>%
  select(high_risk_group = value, treatment_type) %>%
  tbl_summary(by = treatment_type) %>%
  add_overall()

treatment_table$inputs$data <- NULL

treatment_table <- treatment_table$table_body %>%
  separate(stat_0, c("stat_0","perc0"), sep = " ([(])") %>%
  separate(stat_1, c("stat_1","perc1"), sep = " ([(])") %>%
  separate(stat_2, c("stat_2","perc2"), sep = " ([(])") %>%
  separate(stat_3, c("stat_3","perc3"), sep = " ([(])") %>%
  select(`High risk cohort` = label, 
         `Number of treated patients` = stat_0,
         `Treated with Casirivimab` = stat_1,
         `Treated with Molnupiravir` = stat_2,
         `Treated with Sotrovimab` = stat_3) %>%
  mutate(`Number of treated patients` = as.numeric(gsub(",", "", `Number of treated patients`)),
         `Treated with Casirivimab` = as.numeric(gsub(",", "", `Treated with Casirivimab`)),
         `Treated with Molnupiravir` = as.numeric(gsub(",", "", `Treated with Molnupiravir`)),
         `Treated with Sotrovimab` = as.numeric(gsub(",", "", `Treated with Sotrovimab`))) %>%
  data.frame()  %>%
  mutate(High.risk.cohort = ifelse(High.risk.cohort == "high_risk_group", "All", High.risk.cohort),
         Number.of.treated.patients = ifelse(High.risk.cohort == "All", 
                                             length(unique(subset(data_processed_clean, eligibility_status == "Treated" & !is.na(treatment_date))$patient_id)),
                                             Number.of.treated.patients),
         Treated.with.Casirivimab = ifelse(High.risk.cohort == "All", noneligible_casirivimab, Treated.with.Casirivimab),
         Treated.with.Molnupiravir = ifelse(High.risk.cohort == "All", noneligible_molnupiravir, Treated.with.Casirivimab),
         Treated.with.Sotrovimab = ifelse(High.risk.cohort == "All", noneligible_sotrovimab, Treated.with.Casirivimab)) %>%
  # Redact values < 8
  mutate(Number.of.treated.patients = ifelse(Number.of.treated.patients < threshold, NA, as.numeric(Number.of.treated.patients)),
         Treated.with.Casirivimab = ifelse(Treated.with.Casirivimab < threshold, NA, as.numeric(Treated.with.Casirivimab)),
         Treated.with.Molnupiravir = ifelse(Treated.with.Molnupiravir < threshold, NA, as.numeric(Treated.with.Molnupiravir)),
         Treated.with.Sotrovimab = ifelse(Treated.with.Sotrovimab < threshold, NA, as.numeric(Treated.with.Sotrovimab))
  ) %>%
  # Round to nearest 10
  mutate(Number.of.treated.patients = plyr::round_any(Number.of.treated.patients, 10),
         Treated.with.Casirivimab = plyr::round_any(as.numeric(Treated.with.Casirivimab), 10),
         Treated.with.Molnupiravir = plyr::round_any(Treated.with.Molnupiravir, 10),
         Treated.with.Sotrovimab = plyr::round_any(Treated.with.Sotrovimab, 10))

write_csv(treatment_table, here::here("output", "reports", "coverage", "tables", "table_elig_treat_redacted2.csv"))

## Clinical and demographics table
variables <- c("ageband", "sex", "ethnicity", "imd", "region")

table_demo_clinc_breakdown_base <- data_processed_clean %>%
  filter(eligibility_status == "Eligible") %>%
  select(all_of(variables)) %>%
  tbl_summary()

table_demo_clinc_breakdown_base$inputs$data <- NULL

table_demo_clinc_breakdown_base <- table_demo_clinc_breakdown_base$table_body %>%
  separate(stat_0, c("stat_0","perc0"), sep = " ([(])") %>%
  select(Group = variable, Variable = label, 
         All = stat_0) %>%
  mutate(All = as.numeric(gsub(",", "", All))) %>%
  data.frame() %>%
  arrange(Group, Variable)

table_demo_clinc_breakdown <- data_processed_clean %>%
  filter(eligibility_status == "Eligible",
         !is.na(treatment_type)) %>%
  select(treatment_type, all_of(variables)) %>%
  tbl_summary(by = treatment_type) %>%
  add_overall() %>%
  modify_header(label ~ "**Demographic/clinical characteristics**") %>%
  modify_spanning_header(c("stat_0", "stat_1", "stat_2") ~ "**Treatment Received**") %>%
  modify_footnote(
    all_stat_cols() ~ "Median (IQR) or Frequency (%)"
  ) %>%
  bold_labels()

table_demo_clinc_breakdown$inputs$data <- NULL

table_demo_clinc_breakdown <- table_demo_clinc_breakdown$table_body %>%
  separate(stat_0, c("stat_0","perc0"), sep = " ([(])") %>%
  separate(stat_1, c("stat_1","perc1"), sep = " ([(])") %>%
  separate(stat_2, c("stat_2","perc2"), sep = " ([(])") %>%
  separate(stat_3, c("stat_3","perc3"), sep = " ([(])") %>%
  select(Group = variable,
         Variable = label, 
         Treated = stat_0,
         Casirivimab = stat_1,
         Molnupiravir = stat_2,
         Sotrovimab = stat_3) %>%
  mutate(Treated = as.numeric(gsub(",", "", Treated)),
         Casirivimab = as.numeric(gsub(",", "", Casirivimab)),
         Molnupiravir = as.numeric(gsub(",", "", Molnupiravir)),
         Sotrovimab = as.numeric(gsub(",", "", Sotrovimab))) %>%
  data.frame() %>%
  arrange(Group, Variable)

table_demo_clinc_breakdown_redacted <- left_join(table_demo_clinc_breakdown_base, table_demo_clinc_breakdown, by = c("Group", "Variable")) %>%
  # Redact values < 8
  mutate(All = ifelse(All < threshold, NA, as.numeric(All)),
         Treated = ifelse(Treated < threshold, NA, as.numeric(Treated)),
         Casirivimab = ifelse(Casirivimab < threshold, NA, as.numeric(Casirivimab)),
         Molnupiravir = ifelse(Molnupiravir < threshold, NA, as.numeric(Molnupiravir)),
         Sotrovimab = ifelse(Sotrovimab < threshold, NA, as.numeric(Sotrovimab))
  ) %>%
  # Round to nearest 10
  mutate(All = plyr::round_any(All, 10),
         Treated = plyr::round_any(Treated, 10),
         Casirivimab = plyr::round_any(as.numeric(Casirivimab), 10),
         Molnupiravir = plyr::round_any(Molnupiravir, 10),
         Sotrovimab = plyr::round_any(Sotrovimab, 10))

write_csv(table_demo_clinc_breakdown_redacted, here::here("output", "reports", "coverage", "tables", "table_demo_clinc_breakdown_redacted.csv"))


# Concordance with guidance ----
non_elig_treated <-  data_processed_clean %>%
  filter(!is.na(treatment_date),
         eligibility_status == "Treated") %>%
  mutate(
    patient_id,
    alive = (has_died == 0),
    registered = (registered_eligible == 1 | registered_treated == 1),
    has_positive_covid_test = (covid_test_positive == 1),
    no_positive_covid_test_previous_30_days = (covid_positive_previous_30_days != 1),
    high_risk_group_nhsd = !is.na(high_risk_group_nhsd),
    no_covid_hospital_admission_last_30_days = (is.na(covid_hospital_admission_date) | 
                                                  covid_hospital_admission_date < (elig_start - 30) & 
                                                  covid_hospital_admission_date > (elig_start)),
    aged_over_12 = (age >= 12),
    treated_within_5_days = ((tb_postest_treat <= 5 & tb_postest_treat >= 0) | is.na(tb_postest_treat)),
    not_duplicated_entries = !(patient_id %in% dup_ids$patient_id),
    high_risk_group = !is.na(high_risk_cohort_covid_therapeutics),
    
    include = (
      alive &
        registered & 
        has_positive_covid_test & 
        no_positive_covid_test_previous_30_days & 
        treated_within_5_days & 
        high_risk_group_nhsd & 
        no_covid_hospital_admission_last_30_days &
        aged_over_12 &
        not_duplicated_entries &
        high_risk_group)
  )

data_flowchart <- non_elig_treated %>%
  ungroup() %>%
  transmute(
    c0_all = TRUE,
    c1_alive_and_registered = c0_all & alive & registered,
    c2_has_positive_covid_test = c0_all & alive & registered & has_positive_covid_test,
    c3_no_positive_covid_test_previous_30_days = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days,
    c4_high_risk_group_nhsd = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days & high_risk_group_nhsd,
    c5_no_covid_hospital_admission_last_30_days = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days & 
      high_risk_group_nhsd & no_covid_hospital_admission_last_30_days,
    c6_aged_over_12 = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days & 
      high_risk_group_nhsd & no_covid_hospital_admission_last_30_days & aged_over_12,
    c7_treated_within_5_days = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days & 
      high_risk_group_nhsd & no_covid_hospital_admission_last_30_days & aged_over_12 & treated_within_5_days,
    c8_not_duplicated_entries = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days & 
      high_risk_group_nhsd & no_covid_hospital_admission_last_30_days & aged_over_12 & 
      treated_within_5_days & not_duplicated_entries,
    c9_high_risk_group = c0_all & alive & registered & has_positive_covid_test & no_positive_covid_test_previous_30_days & 
      high_risk_group_nhsd & no_covid_hospital_admission_last_30_days & aged_over_12 & 
      treated_within_5_days & not_duplicated_entries & high_risk_group
  )  %>%
  summarise(
    across(.fns=sum, na.rm = T)
  ) %>%
  pivot_longer(
    cols=everything(),
    names_to="criteria",
    values_to="n"
  )  %>%
  mutate(n = ifelse(n < 5, NA, n),
         n = plyr::round_any(as.numeric(n), 5)) %>%
  mutate(
    n_exclude = lag(n) - n,
    pct_exclude = n_exclude/lag(n),
    pct_all = n / first(n),
    pct_step = n / lag(n),
  )

write_csv(data_flowchart, here("output", "reports", "coverage", "tables", "table_non_elig_flowchart_redacted.csv"))

data_flowchart2 <- non_elig_treated %>%
  ungroup() %>%
  transmute(
    c0_all = TRUE,
    c1_alive_and_registered = c0_all & alive & registered,
    c2_has_positive_covid_test = c0_all & has_positive_covid_test,
    c3_no_positive_covid_test_previous_30_days = c0_all & no_positive_covid_test_previous_30_days,
    c4_high_risk_group_nhsd = c0_all & high_risk_group_nhsd,
    c5_no_covid_hospital_admission_last_30_days = c0_all & no_covid_hospital_admission_last_30_days,
    c6_aged_over_12 = c0_all & aged_over_12,
    c7_treated_within_5_days = c0_all & treated_within_5_days,
    c8_not_duplicated_entries = c0_all & not_duplicated_entries,
    c9_high_risk_group = c0_all & high_risk_group
  )  %>%
  summarise(
    across(.fns=sum, na.rm = T)
  ) %>%
  pivot_longer(
    cols=everything(),
    names_to="criteria",
    values_to="n"
  )  %>%
  mutate(n = ifelse(n < 5, NA, n),
         n = plyr::round_any(as.numeric(n), 5))

write_csv(data_flowchart2, here("output", "reports", "coverage", "tables", "table_non_elig_flowchart2_redacted.csv"))

high_risk_cohort_comparison_redacted <- data_processed_clean %>%
  filter(!is.na(treatment_date),
         eligibility_status == "Treated") %>%
  filter(Match == FALSE) %>%
  select(high_risk_group_nhsd_combined, high_risk_cohort_covid_therapeutics) %>%
  group_by(high_risk_group_nhsd_combined, high_risk_cohort_covid_therapeutics) %>%
  tally() %>%
  arrange(desc(n)) %>%
  mutate(n = ifelse(n < 5, NA, n),
         n = plyr::round_any(as.numeric(n), 5))

write_csv(high_risk_cohort_comparison_redacted, here::here("output", "reports", "coverage", "tables", "table_non_elig_high_risk_cohort_comparison_redacted.csv"))


# High risk patient cohorts ----

# Time to treatment ----
all <- data_processed_clean %>%
  filter(eligibility_status == "Eligible") %>%
  group_by(tb_postest_treat, treatment_type) %>%
  tally() %>%
  mutate(high_risk_group_combined = "All",
         n = ifelse(n < 5, NA, n),
         n = plyr::round_any(as.numeric(n), 5))

groups <- data_processed_clean %>%
  filter(eligibility_status == "Eligible") %>%
  group_by(high_risk_group_combined, tb_postest_treat, treatment_type = "Any") %>%
  tally() %>%
  mutate(n = ifelse(n < 5, NA, n),
         n = plyr::round_any(as.numeric(n), 5))

write_csv(rbind(all, groups), here("output", "reports", "coverage", "tables", "table_time_to_treat_redacted.csv"))