dynamic-summary.Rmd

### Key results on transmissibility and forecasting


```{r}

ens_rt_both <- drake::readd("ensemble_model_rt")
ens_rt <- ens_rt_both[ens_rt_both$si == "si_2", ]
ens_rt$model <- as.Date(ens_rt$model)
ens_rt <- ens_rt[ens_rt$model == max(ens_rt$model), ]
ens_rt_tall <- tidyr::spread(ens_rt, quantile, out2)
ens_rt_tall$country <- snakecase::to_any_case(ens_rt_tall$country, case = "title")
top2_rt <- dplyr::top_n(ens_rt_tall, n = 2, wt = `50%`) %>%
    dplyr::mutate_if(is.numeric, ~ format(round(., 2), nsmall = 1))
bottom2_rt <- dplyr::top_n(ens_rt_tall, n = -2, wt = `50%`) %>%
        dplyr::mutate_if(is.numeric, ~ format(round(., 2), nsmall = 1))


ensemble_weekly_qntls <- drake::readd("ensemble_weekly_qntls")
ensemble_weekly_qntls_si1 <- ensemble_weekly_qntls[ensemble_weekly_qntls$si == "si_2", ]
ensemble_weekly_qntls_si1 <- ensemble_weekly_qntls_si1[ensemble_weekly_qntls_si1$proj == date_week_finishing, ]
top2_deaths <- dplyr::top_n(x = ensemble_weekly_qntls_si1, n = 2, wt = `50%`) %>%
    dplyr::mutate_if(is.numeric, ~signif(., 3)) %>%
    dplyr::mutate_if(is.numeric, ~prettyNum(., big.mark = ",")) %>%
    dplyr::mutate_at(vars("country"), ~ snakecase::to_any_case(., case = "title"))

bottom2_deaths <- dplyr::top_n(x = ensemble_weekly_qntls_si1, n = -2, wt = `50%`) %>%
    dplyr::mutate_if(is.numeric, ~signif(., 3)) %>%
    dplyr::mutate_if(is.numeric, ~prettyNum(., big.mark = ",")) %>%
    dplyr::mutate_at(vars("country"), ~ snakecase::to_any_case(., case = "title"))

model_rt <- drake::readd("model_rt_qntls")
model_rt <- model_rt[grep(
    pattern = max(ens_rt$model), names(model_rt)
)]
model_rt <- dplyr::bind_rows(model_rt, .id = "model")
model_rt <- model_rt[model_rt$si == "si_2", ]
## re-arrange columns so that we can rbind.
model_rt <- model_rt[ , colnames(ens_rt)]
ens_rt <- rbind(model_rt, ens_rt)
ens_rt <- tidyr::spread(ens_rt, quantile, out2)

```
Key results below are based on an ensemble forecast of two models.

Transmissibility is characterised by the reproduction number $R_t$, i.e. the 
average number of cases that one infected individual is likely to
infect. Analysis of transmissibility indicates that the reproduction 
numbers last week (week starting 
`r format(as.Date(date_week_finishing, format = "%d-%m-%Y"), format = "%d-%m-%Y")`) were highest in:
  
* `r top2_rt$country[1]` with an estimated median $R_t$ of 
`r top2_rt[["50%"]][1]` (95% CrI - `r top2_rt[["2.5%"]][1]` - `r top2_rt[["97.5%"]][1]`), and
* `r top2_rt$country[2]` with an estimated median $R_t$ of 
`r top2_rt[["50%"]][2]` (95% CrI `r top2_rt[["2.5%"]][2]` - `r top2_rt[["97.5%"]][2]`).

and were lowest in:
  
* `r bottom2_rt$country[1]` with an estimated median $R_t$ of 
`r bottom2_rt[["50%"]][1]` (95% CrI `r bottom2_rt[["2.5%"]][1]` - `r bottom2_rt[["97.5%"]][1]`), and
* `r bottom2_rt$country[2]` with an estimated median $R_t$ of 
`r bottom2_rt[["50%"]][2]` (95% CrI `r bottom2_rt[["2.5%"]][2]` - `r bottom2_rt[["97.5%"]][2]`).

Forecasts of predicted deaths in the coming week (week starting `r format(as.Date(date_week_finishing, format = "%d-%m-%Y"), format = "%d-%m-%Y")`) are highest in:
  
* `r top2_deaths$country[1]` with an estimated median
`r top2_deaths[["50%"]][1]` deaths 
 (95% CrI `r top2_deaths[["2.5%"]][1]` - 
 `r top2_deaths[["97.5%"]][1]`), and
* the `r top2_deaths$country[2]` with an estimated median 
`r top2_deaths[["50%"]][2]` deaths
(95% CrI `r top2_deaths[["2.5%"]][2]` - `r top2_deaths[["97.5%"]][2]`).

and are lowest in:
  
* `r bottom2_deaths$country[1]` with an estimated median
`r bottom2_deaths[["50%"]][1]` deaths (95% CrI `r bottom2_deaths[["2.5%"]][1]` - `r bottom2_deaths[["97.5%"]][1]`), and
* `r bottom2_deaths$country[2]` with an estimated median 
`r bottom2_deaths[["50%"]][2]` deaths (95% CrI `r bottom2_deaths[["2.5%"]][2]` - `r bottom2_deaths[["97.5%"]][2]`).