In the context of coronavirus, let's revisit this post about risk accumulation. https://twitter.com/statwonk/status/1160542394544267265?s=20

risk_adds_up2.R

library(tidyverse)
library(ggthemes)
expand.grid(
  risk = seq(0.1/5e3, 1/5e3, 1e-05), # average daily risk e.g. - 1,000 infected per day in Alabama / 5,000,000 AL population
  units_of_exposure = seq_len(31) # days of exposure (up to 31 days)
) %>% as_tibble() %>%
  mutate(total_risk = map2_dbl(risk, units_of_exposure, ~ 1 - (1 - .x)^(.y)),
         total_odds = 1/total_risk,
         risk_threshold = case_when(total_odds <= 5e2 ~ "Worse than 1 in 500",
                                    total_odds <= 1e3 ~ "Worse than 1 in 1k chance",
                                    TRUE ~ "Better than 1 in 1k chance"),
         risk_threshold = factor(risk_threshold, levels = c(
           "Worse than 1 in 100", "Worse than 1 in 500", "Worse than 1 in 1k chance", "Better than 1 in 1k chance"
         ))) %>%
  ggplot(aes(x = risk*5e6, y = units_of_exposure)) +
  geom_raster(aes(fill = risk_threshold), alpha = 0.6) +
  theme(panel.grid.major = element_line(color = "black")) +
  geom_vline(xintercept = 1e3) +
  labs(y = "Units of exposure",
       x = "Risk per unit",
       title = "Risk accumulates w/ exposure, but how (fast) slowly?") +
  scale_fill_colorblind(name = "Risk threshold") +
  scale_x_continuous(labels = scales::comma) +
  xlab("Alabama daily case rate") +
  theme_bw(20) + theme(legend.position = "top")