R/get_p_LSHTM.R

In epicentre-msf/covidestim: Estimates Of Epidemiological Parameters For COVID19

#' Estimate Covid2019 outcome probabilities for a population given its age
#' distribution, and age-severity estimates used by LHSTM
#'
#' @description
#' Estimate Covid19 outcome probabilities including hospitalizion|infection,
#' ICU|hospitalization, death|hospitalization, and death|infection, using
#' age-specific outcomes estimates of Pr(Clinical|Infection) from Davies et al.
#' (2020) (with confidence intervals) and point estimates of
#' Pr(hospitalization|clinical), Pr(ICU|hospitalization), and
#' Pr(dead|hospitalization) from Van Zandvoort et al. (2020).
#'
#' Population age distributions can either be taken from the UN World
#' Population Prospects 2019 (WPP2019), or directly supplied by the user.
#'
#' @param x Either an ISO3 country code used to extract age-specific population
#'   estimates from the UN World Population Prospects 2019 dataset, \emph{or}, a
#'   data.frame containing age categories in the first column and population
#'   counts (or proportions) in the second column
#' @param p_type Outcome to estimate (either "p_hosp_inf", "p_icu_hosp",
#'   "p_dead_hosp", or "p_dead_inf")
#' @param p_stat Statistic of the severity estimates to use (either "mean",
#'   "median", "low_95", "up_95", "low_50", or "up_50")
#'
#' @return
#' Estimated outcome probability (scalar)
#'
#' @author Anton Camacho
#' @author Patrick Barks <patrick.barks@@epicentre.msf.org>
#'
#' @source
#' van Zandvoort, K., Jarvis, C.I., Pearson, C., Davies, N.G., CMMID COVID-19
#' Working Group, Russell, T.W., Kucharski, A.J., Jit, M.J., Flasche, S., Eggo,
#' R.M., and Checchi, F. (2020) Response strategies for COVID-19 epidemics in
#' African settings: a mathematical modelling study. medRxiv preprint.
#' \url{https://doi.org/10.1101/2020.04.27.20081711}
#'
#' Davies, N.G., Klepac, P., Liu, Y., Prem, K., Jit, M., CMMID COVID-19 Working
#' Group, and Eggo, R.M. (2020) Age-dependent effects in the transmission and
#' control of COVID-19 epidemics. medRxiv preprint.
#' \url{https://doi.org/10.1101/2020.03.24.20043018}
#'
#' @examples
#' # mean Pr(hospitalization|infection) for Canada (ISO3 code "CAN"), taking age
#' # distribution from WPP2019
#' get_p_LSHTM(x = "CAN", p_type = "p_hosp_inf", p_stat = "mean")
#'
#' # use custom age-distribution
#' age_df <- data.frame(
#'   age = c("0-9", "10-19", "20-29", "30-39", "40-49", "50-59", "60-69", "70-79", "80+"),
#'   pop = c(1023, 1720, 2422, 3456, 3866, 4104, 4003, 3576, 1210),
#'   stringsAsFactors = FALSE
#' )
#'
#' get_p_LSHTM(x = age_df, p_type = "p_hosp_inf", p_stat = "mean")
#'
#' @export get_p_LSHTM
get_p_LSHTM <- function(x,
                        p_type = c("p_hosp_inf", "p_icu_hosp", "p_dead_hosp", "p_dead_inf"),
                        p_stat = c("mean", "median", "low_95", "up_95", "low_50", "up_50")) {

  p_type <- match.arg(p_type)
  p_stat <- match.arg(p_stat)

  ## for testing only
  if (FALSE) {
    x <- "FRA"
    p_type <- "p_dead_inf"
    p_stat <- "mean"
  }

  # use P(Clinical|Infection) from Davies 2020 (with confidence intervals) and
  #  P(Hosp|Clinical) from VanZandvoort 2020 to compute P(Hosp|Infection)
  est_davies <- get_est_davies(stat = p_stat)
  est_vanzan <- get_est_vanzandvoort()

  est_merge <- merge(est_vanzan, est_davies, by.x = "age_group")
  est_merge$p_hosp_inf <- est_merge$p_hosp_clin * est_merge$p_clin_inf
  est_merge$p_dead_inf <- est_merge$p_dead_hosp * est_merge$p_hosp_inf

  # prepare age distribution
  age_distr <- prep_age_distib(x)

  # aggrate population age-classes to match estimate age-classes
  age_distr_agg <- aggregate_ages(age_distr, target = est_merge$age_group)

  # bind estimates to population data by age class
  est_full <- merge(est_merge, age_distr_agg, all.x = TRUE)

  # return overall population probability
  return(sum(est_full[["pop"]] * est_full[[p_type]]) / sum(est_full[["pop"]]))
}