In EpiNow2: Estimate Real-Time Case Counts and Time-Varying Epidemiological Parameters

knitr::opts_chunk$set(echo = FALSE, eval = TRUE,
                      fig.width = 12, fig.height = 12,
                      message = FALSE,
                      warning = FALSE,
                      dpi = 400)

require(knitr)
require(kableExtra)
require(here)

if (standalone) {
  fig_start <- 1
  tab_start <- 1
  }else{
    if (!exists("fig_start")) {
      fig_start <- 3
      }

    if (!exists("tab_start")) {
      tab_start <- 2
    }
  }

if (!exists("case_def")) {
  case_def <- "case"
}

if (!exists("interactive")) {
  interactive <- FALSE
}

if (interactive) {
  require(DT)
}

r paste0("### Summary of latest reproduction number and confirmed ", case_def, " count estimates by date of infection")

knitr::include_graphics(here::here(file.path(summary_path, "summary_plot.png")))

r paste0("*Figure ", fig_start, ": Confirmed ", case_def, "s with date of infection on the ", latest_date, " and the time-varying estimate of the effective reproduction number (lightest ribbon = 90% credible interval; darker ribbon = the 50% credible interval, darkest ribbon = 20% credible interval). Regions are ordered by the number of expected daily confirmed ", case_def, "s and shaded based on the expected change in daily confirmed " , case_def, "s. The horizontal dotted line indicates the target value of 1 for the effective reproduction no. required for control and a single case required for elimination. Uncertainty has been curtailed to a maximum of ten times the maximum number of reported cases for plotting purposes.*")

r paste0("### Reproduction numbers over time in the six regions expected to have the most new confirmed ", case_def, "s")

knitr::include_graphics(here::here(file.path(summary_path, "high_rt_plot.png")))

r paste0("*Figure ", fig_start + 1, ": Time-varying estimate of the effective reproduction number (lightest ribbon = 90% credible interval; darker ribbon = the 50% credible interval, darkest ribbon = 20% credible interval) in the regions expected to have the highest number of new confirmed ", case_def, "s. Estimates from existing data are shown up to the ", latest_date, ifelse(report_forecast, " from when forecasts are shown. These should be considered indicative only", ""), ". Estimates based on partial data have been adjusted for right truncation of infections. The vertical dashed line indicates the date of report generation.*")

r paste0("### Confirmed ", case_def, "s and their estimated date of infection in the six regions expected to have the most new confirmed ", case_def, "s")

knitr::include_graphics(here::here(file.path(summary_path, "high_infections_plot.png")))

r paste0("*Figure ", fig_start + 2, ": Confirmed ", case_def, "s by date of report (bars) and their estimated date of infection (lightest ribbon = 90% credible interval; darker ribbon = the 50% credible interval, darkest ribbon = 20% credible interval) in the regions expected to have the highest number of new confirmed ", case_def, "s. Estimates from existing data are shown up to the ", latest_date, ifelse(report_forecast, " from when forecasts are shown. These should be considered indicative only", ""), ". Estimates based on partial data have been adjusted for right truncation of infections. The vertical dashed line indicates the date of report generation. Uncertainty has been curtailed to a maximum of ten times the maximum number of reported cases for plotting purposes.*")

r paste0("### Confirmed ", case_def, "s and their estimated date of report in the six regions expected to have the most new confirmed ", case_def, "s")

knitr::include_graphics(here::here(file.path(summary_path, "high_reported_cases_plot.png")))

r paste0("*Figure ", fig_start + 3, ": Confirmed ", case_def, "s by date of report (bars) and their estimated date of report (lightest ribbon = 90% credible interval; darker ribbon = the 50% credible interval, darkest ribbon = 20% credible interval) in the regions expected to have the highest number of new confirmed ", case_def, "s. Estimates from existing data are shown up to the ", latest_date, ifelse(report_forecast, " from when forecasts are shown. These should be considered indicative only", ""), ". Estimates based on partial data have been adjusted for right truncation of infections. The vertical dashed line indicates the date of report generation. Uncertainty has been curtailed to a maximum of ten times the maximum number of reported cases for plotting purposes.*")

if (!exists("all_regions")) {
  all_regions <- TRUE
}

if (!file.exists((here::here(summary_path, "rt_plot.png")))) {
  all_regions <- FALSE
}

r paste0("### Latest estimates (as of the ", latest_date, ")")

r paste0("*Table ", tab_start, ": Latest estimates (as of the ", latest_date, ") of the number of confirmed ", case_def, "s by date of infection, the effective reproduction number, the rate of growth, and the doubling time (when negative this corresponds to the halving time) in each region. The median and 90% credible interval is shown.*")

if (!interactive) {
  data.table::fread(here::here(summary_path, "summary_table.csv")) %>% 
   knitr::kable(booktabs = TRUE, longtable = TRUE) %>% 
   kableExtra::landscape()
}else{
  summary_table <- data.table::fread(here::here(summary_path, "summary_table.csv")) 
  numeric_cols <-
    unname(which(apply(summary_table, 2,
                       function(x) all(grepl("^[0-9e.() -]+$", x)))))
  sort_table <- apply(summary_table[, numeric_cols, with = FALSE], 2,
                      function(x) as.numeric(sub(" \\(.*\\)$", "", x)))
  sort_cols <- ncol(summary_table) + seq_len(ncol(sort_table))
  columnDefs <-
    c(lapply(seq_along(sort_cols), function(x) {
      list(orderData = sort_cols[x] - 1L,
           targets = numeric_cols[x] - 1L)
    }),
    list(list(visible = FALSE, targets = sort_cols - 1L)))
  summary_table %>%
    cbind(sort_table) %>%
    DT::datatable(rownames = FALSE,
                  extensions = c("Buttons"),
                  options = list(dom = "Bfrtip", buttons = c("csv"),
                                 columnDefs = columnDefs))
}

summary_tables <- tab_start
summary_figures <- fig_start + 6

EpiNow2 documentation built on Sept. 26, 2023, 5:11 p.m.