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

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/"
)
options(digits = 4, width = 160)

covidestim

An R package for estimating population-level covid19 outcome probabilities (e.g. hospitalization|infection, death|hospitalization, etc.), given the age-distribution of a population of interest and severity estimates (by age, sex, etc.) from various research groups.

Includes functions to extract country-level age distributions from the UN World Population Prospects 2019 dataset, and age-severity estimates from:

Salje et al. 2020 (based on data from France)
Neher Lab (China)
Bi et al. 2020 (Schenzhen, China)
Davies et al. 2020 and van Zandvoort et al. 2020 (China, Diamond Princess)
O'Driscoll et al. 2020 ensemble IFR (Infection Fatality Risk) estimates based on data from 45 countries (published on 2 November 2020)
Levin et al. 2020 meta regression IFR estimates based on data from 34 studies (published on 8 October 2020).
Brazeau et al. 2020 IFR estimates based on data from 10 studies (published on 29 October 2020).

Installation

Install from GitHub with:

# install.packages("remotes")
remotes::install_github("epicentre-msf/covidestim")

Usage

Extract population age-distributions from UN World Population Prospects 2019

library(covidestim)

covidestim::get_age_pop(iso = "AFG", format = "long") # AFG = Afghanistan

Derive population-wide covid19 outcome probability estimates

# mean probability of death|infection in Afghanistan, based on age-severity
# estimates from different research groups
covidestim::get_p_Salje("AFG", p_type = "p_dead_inf")
covidestim::get_p_Neher("AFG", p_type = "p_dead_inf")
covidestim::get_p_LSHTM("AFG", p_type = "p_dead_inf")

Compare estimates of Pr(hospitalization|infection) from various research groups

library(ggplot2)

p_hosp <- covidestim::compare_age_severity()

ggplot(p_hosp, aes(x = age_group, y = mean, color = group)) +
  geom_point(size = 3, position = position_dodge(width = 0.6)) +
  geom_linerange(aes(ymin = low95, ymax = upp95), position = position_dodge(width = 0.6)) +
  labs(x = "Age group", y = "Pr(hospitalization|infection)", col = "Group") +
  theme_bw()

Compare Infection Fatality Risk (IFR) of different countries

Get age-adjusted IFR estimates for countries according to estimates by O'Driscoll et al. 2020, Levin et al. 2020 and Brazeau et al. 2020.

#get list of all countries with available population
cntrys <- c("AFG", "SSD", "COD", "CHN", "USA", "FRA", "CHE", "JPN", "PER")

#compute IFRs, sort ascending, add continent
ifr <- compare_IFR(cntrys)
ifr$iso <- factor(ifr$iso, levels = unique(ifr$iso[order(ifr$mn)]))

#plot
ggplot(ifr) +
  geom_point(aes(x = iso, y = 100*mn, color = method), position = position_dodge(width = .3), size = 2) +
  geom_linerange(aes(x = iso, ymin = 100*low, ymax = 100*up, color = method), position = position_dodge(width = .3)) +
  labs(
    x = "Country",
    y = "IFR estimate [%]",
    color = "Method"
  ) +
  theme_bw() +
  theme(legend.position = "bottom")

Plotting the same figure on a log-scale we can see the differences in countries with younger populations too:

ggplot(ifr) +
  geom_point(aes(x = iso, y = 100*mn, color = method), position = position_dodge(width = .3), size = 2) +
  geom_linerange(aes(x = iso, ymin = 100*low, ymax = 100*up, color = method), position = position_dodge(width = .3)) +
  labs(
    x = "Country",
    y = "IFR estimate [%] (log-scale)",
    color = "Method"
  ) +
  theme_bw() +
  theme(legend.position = "bottom") +
  scale_y_log10()

We can see that the differences in the estimated IFR come directly from the different age-specific IFR estimates by the two groups of authors:

library(magrittr)

est_levin <- get_est_levin() %>% dplyr::mutate(method = "levin")
est_odriscoll <- get_est_odriscoll(sex = "total") %>% dplyr::mutate(method = "odriscoll")
est_brazeau <- get_est_brazeau() %>% dplyr::mutate(method = "brazeau")

est <- dplyr::bind_rows(
    est_levin,
    est_odriscoll,
    est_brazeau
  ) %>%
  dplyr::select(-sex, -quantile) %>%
  tidyr::pivot_wider(names_from = stat, values_from = "p_dead_inf") %>%
  dplyr::mutate(
    method = factor(method, levels = c("odriscoll", "levin", "brazeau")),
    age_group = factor(age_group,
      levels = c("0-4", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39",
        "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79",
        "80-84", "85-89", "80+", "85+", "90+")),
    )

ggplot(est) +
  geom_point(aes(age_group, 100*mean, col = method), size = 2, position = position_dodge(width = 0.4)) +
  geom_linerange(aes(age_group, ymin = 100*low_95, ymax = 100*up_95, col = method), position = position_dodge(width = 0.4)) +
  labs(
    x = "Age-group",
    y = "IFR estimate [%] (log-scale)",
    color = "Method"
  ) +
  scale_y_log10() +
  theme_bw() +
  theme(legend.position = "bottom")