R/get_metrics_tables.R

Defines functions get_metrics_tables

Documented in get_metrics_tables

#' Create metrics tables
#' @param seed set seed
#' @param top20 Vector of state abbreviations for top 20 table
#' @param corr_check Check for data corrections of X-times magnitude. Default is `TRUE`
#' @param inc_days Number of days from infection to symptoms
#' @return Creates metrics tables for use in covind19.org
#' @import gt
#' @import data.table
#' @import cli
#' @importFrom glue glue
#' @importFrom janitor clean_names
#' @importFrom scales col_bin
#' @export
#' @examples
#' \dontrun{
#' tabs   <- get_metrics_tables()
#'
#' tabs$full
#' }

get_metrics_tables <- function(seed = 46342, top20 = NULL, corr_check = FALSE, inc_days = c(7, 5, 3)) {

  cli::cli_alert_info("getting data...")

  set.seed(set_seed <- seed)
  today           <- Sys.Date()
  all_data        <- get_all_data(corr_check = corr_check, inc_days = inc_days)[date <= today]
  # dat             <- get_all_data(corr_check = corr_check)[date <= today]
  cfr1            <- unique(get_cfr(all_data))[place == "National estimate", place := "India"][]
  r_est           <- get_r_est(all_data[!is.na(r_est)])
  india_state_pop <- covid19india::pop

  cli::cli_alert_success("data load success!!")

  # pull abbrevs -----------
  use_abbrevs <- tolower(unique(all_data[abbrev != "la", abbrev]))

  # vax data ----------
  vax_dat <- get_state_vax()[date <= today]
  setnames(vax_dat, c("total_doses", "pct_one_dose", "pct_two_doses", "daily_doses"), c("total_vacc", "pct_at_least_one", "pct_second", "daily_vax_dose"))

  test_data = (((fread("https://raw.githubusercontent.com/umich-cphds/cov-ind-19-data/master/source_data/count_test_vax_latest.csv") %>%
    as.data.table())[
      , date := as.Date(date)
      ][
        order(date)
      ][,
      .SD[date >= max(date) - 8 & date < max(date)], by = "place"
      ][,
      .SD, .SDcols = c("state", "date", "confirmed", "tested")
      ][
      , daily_confirmed := confirmed - shift(confirmed), by = "state"
      ][
      , daily_tested := tested - shift(tested), by = "state"
      ][
      , daily_tested := ifelse(daily_tested == 0 , NA, daily_tested), by = "state"
      ] %>%
    na.omit(cols = c("daily_confirmed")))[
      , tpr7d := mean(daily_confirmed / daily_tested, na.rm = TRUE), by = "state"
      ][,
      .SD, .SDcols = c("state", "tpr7d", "tested", "daily_tested")
      ][
      , .SD[nrow(.SD)],by = "state"
      ][
      , tpr7d := ifelse(is.nan(tpr7d), NA, tpr7d)
      ]) %>%
    data.table::setnames(old = c("state"), new = c("place"))

  vax_dat <- vax_dat[!is.na(total_vacc)][, .SD[date == max(date)], by = "place"]

  all_data <- unique(all_data[, .SD[date > max(as.Date(date) - 7)], by = "place"][, dailyCFR7 := daily_deaths / daily_cases][, dailyCFR7d := mean(dailyCFR7, na.rm = T), by = "place"][, .SD[date == max(date)], by = "place"][])[, .(place, dailyCFR7d, daily_cases, daily_deaths, total_cases, total_deaths)]

  all_data <- data.table::merge.data.table(all_data, covid19india::pop[, .SD[1], by = "place"], by = "place", all.x = TRUE)

  all_data <- data.table::merge.data.table(all_data, vax_dat, by = "place", all.x = TRUE)

  all_data <- data.table::merge.data.table(all_data, test_data, by = "place")

  # table ----------
  tib <- cfr1[, .(place, cfr)]

  tib <- data.table::merge.data.table(tib, r_est[, .(place, r)], by = "place", all.x = TRUE)

  # tib <- data.table::merge.data.table(tib, extract_latest(tp, clmns = c("tpr")), by = "place", all.x = TRUE)
  tib <- data.table::merge.data.table(tib, all_data[, .(place, tpr7d, daily_tested)], by = "place", all.x = TRUE)

  tib <- data.table::merge.data.table(tib, all_data[, tpr7d := NULL][, daily_tested := NULL], by = "place", all.x = TRUE)[
    , `:=` (
      perc_vaccine   = pct_at_least_one,
      total_vacc     = format(total_vacc, big.mark = ","),
      daily_cases    = format(daily_cases, big.mark = ","),
      daily_deaths   = format(daily_deaths, big.mark = ","),
      daily_vax_dose = format(daily_vax_dose, big.mark = ","),
      daily_tests    = format(daily_tested, big.mark = ","),
      cases          = format(total_cases, big.mark = ","),
      deaths         = format(total_deaths, big.mark = ","),
      tested         = format(tested, big.mark = ",")
    )
  ][]

  setnames(tib,
           old = c( "daily_cases", "daily_deaths", "dailyCFR7d", "r", "tpr7d", "daily_vax_dose", "place", "cfr", "cases", "deaths", "perc_vaccine", "total_vacc", "pct_second", "pct_at_least_one", "tested", "daily_tests"),
           new = c("# daily new cases", "# daily new deaths",  "7-day average daily CFR", "R", "7-day average daily TPR", "daily vaccine doses", "Location", "CFR", "total cases","total deaths",  "Percent with at least one dose", "Total doses", "% pop. with two shots", "% pop. with at least one shot", "total tests", "# daily new tests"))

  tib <- tib[order(-`total_cases`)][
    , `:=` (
      `7-day average daily CFR`       = round(`7-day average daily CFR`, digits = 3),
      `7-day average daily TPR (%)`   = round(`7-day average daily TPR`, digits = 6)*100,
      `% pop. with two shots`         = round(`% pop. with two shots`, digits = 2),
      `% pop. with at least one shot` = round(`% pop. with at least one shot`, digits = 2)
    )
  ][
    , .(`# daily new cases`, `# daily new deaths`, `7-day average daily CFR`,
        `7-day average daily TPR (%)`, `# daily new tests`,
        Location, R, `daily vaccine doses`, CFR, `total tests`, `total cases`,
        `total deaths`, `Total doses`, `% pop. with two shots`,
        `% pop. with at least one shot`)
  ]

  tib <- unique(tib)[!grepl("\\*\\*", tib$Location),]

  source_note_text <- glue::glue(
    "**\uA9 COV-IND-19 Study Group**<br>**Source data:** Up to 10/17/2021: covid19india.org. After 10/17/2021: count data (mohfw.gov.in), vaccine data (cowin.gov.in)<br>
      **Notes:** Cells highlighted in green indicates good performance for given metric while red indicates need for improvement.
      Only states/union territories with the highest cumulative case counts as of {format(today, '%B %e')} are shown.
      States are omitted if they have missing case count data.
      <br>
      R values are not reliable when case counts are below 100.
      <br>
      **Abbrev:** CFR, Case-fatality rate."
  )

  tabl <- tib %>%
    gt() %>%
    # format table body text
    tab_style(
      style     = cell_text(size = px(14), font = "helvetica"),
      locations = cells_body()
    ) %>%
    tab_style(
      style     = cell_text(weight = "bold"),
      locations = cells_body((Location))
    ) %>%
    # format column names
    tab_style(
      style = cell_text(
        size      = px(12),
        color     = "#999999",
        font      = "helvetica",
        transform = "uppercase"
      ),
      locations = cells_column_labels(everything())
    ) %>%
    # format numbers
    fmt_number(
      columns  = c(CFR),
      decimals = 3
    ) %>%
    fmt_number(
      columns  = c(R),
      decimals = 2
    ) %>%
    fmt_number(
      columns  = c(`7-day average daily TPR (%)`),
      decimals = 3
    ) %>%
    # random formatting
    tab_options(
      column_labels.border.top.style    = "none",
      column_labels.border.bottom.width = 1,
      column_labels.border.bottom.color = "#334422",
      table_body.border.bottom.color    = "#0000001A",
      data_row.padding                  = px(4)
    ) %>%
    # column widths
    cols_width(
      Location ~ px(150),
      c(R, CFR) ~ px(75),
      everything() ~ px(100)
    ) %>%
    cols_align(
      align   = "center",
      columns = everything()
    ) %>%
    # title
    tab_header(
      title    = md("**Assessing COVID-19 in India**"),
      subtitle = glue("data through {format(today, '%B %e')}")
    ) %>%
    # caption
    tab_source_note(
      source_note = md(source_note_text)
    ) %>%
    # add and format column spanners
    tab_spanner(
      label   = "Point in time metrics",
      columns = c(`# daily new cases`, `# daily new deaths`,
                  `7-day average daily CFR`, R, `7-day average daily TPR (%)`, `# daily new tests`,
                  `daily vaccine doses`)
    ) %>%
    tab_spanner(
      label   = "Cumulative metrics",
      columns = c(`total cases`, `total deaths`, CFR, `total tests`,
                  `Total doses`, `% pop. with two shots`, `% pop. with at least one shot`)
    ) %>%
    cols_move_to_start((Location)) %>%
    tab_style(
      style = cell_text(
        size      = px(14),
        color     = "#999999",
        font      = "helvetica",
        transform = "uppercase"
      ),
      locations = cells_column_spanners(spanners = c("Point in time metrics", "Cumulative metrics"))
    ) %>%
    # adjust title font
    tab_style(
      style     = list(cell_text(font = "helvetica", size = px(24))),
      locations = list(cells_title(groups = "title"))
    ) %>%
    # adjust subtitle font
    tab_style(
      style     = list(cell_text(font = "helvetica", size = px(18))),
      locations = list(cells_title(groups = "subtitle"))
    ) %>%
    # color cells based on values
    data_color(
      columns = c(R),
      colors = scales::col_bin(c("#FFFFFF", "#fae0de"), domain = NULL, bins = c(0,1,1000), pretty = F)
    ) %>%
    # highlight national estimate
    tab_style(
      style = cell_fill(color = "#fcf8d4"),
      locations = cells_body(
        rows = Location == "India")
    ) %>%
    tab_style(
      style = cell_borders(sides = "left"),
      locations = cells_body(columns = (`total cases`))
    ) %>%
    tab_style(
      style = cell_borders(sides = "left"),
      locations = cells_column_labels(columns = (`total cases`))
    ) %>%
    tab_style(
      style = cell_borders(sides = "left"),
      locations = cells_column_spanners(("Cumulative metrics"))
    )

  cli::cli_alert_success("full table made")

  # new table
  point_in_time <- tib[, !c("total cases", "total deaths", "CFR",
                            "Total doses", "% pop. with two shots",
                            "% pop. with at least one shot")] %>%
    gt() %>%
    # format table body text
    tab_style(
      style     = cell_text(size = px(14), font = "helvetica"),
      locations = cells_body()
    ) %>%
    tab_style(
      style     = cell_text(weight = "bold"),
      locations = cells_body(c(Location))
    ) %>%
    # format column names
    tab_style(
      style = cell_text(
        size      = px(12),
        color     = "#999999",
        font      = "helvetica",
        transform = "uppercase"
      ),
      locations = cells_column_labels(everything())
    ) %>%
    # format numbers
    # fmt_number(
    #   # columns  = c(`7-day average daily TPR`),
    #   decimals = 3
    # ) %>%
    fmt_number(
      columns  = c(R),
      decimals = 2
    ) %>%
    # random formatting
    tab_options(
      column_labels.border.top.style    = "none",
      column_labels.border.bottom.width = 1,
      column_labels.border.bottom.color = "#334422",
      table_body.border.bottom.color    = "#0000001A",
      data_row.padding                  = px(4)
    ) %>%
    # column widths
    cols_width(
      Location ~ px(150),
      R ~ px(75),
      everything() ~ px(100)
    ) %>%
    cols_align(
      align   = "center",
      columns = everything()
    ) %>%
    # title
    tab_header(
      title    = md("**Assessing COVID-19 in India**"),
      subtitle = glue("data through {format(today, '%B %e')}")
    ) %>%
    # caption
    tab_source_note(
      source_note = md(source_note_text)
    ) %>%
    tab_spanner(
      label   = "Point in time metrics",
      columns = c(`# daily new cases`, `# daily new deaths`,
                  `7-day average daily CFR`, R, `daily vaccine doses`)
    ) %>%
    cols_move_to_start((Location)) %>%
    tab_style(
      style = cell_text(
        size      = px(14),
        color     = "#999999",
        font      = "helvetica",
        transform = "uppercase"
      ),
      locations = cells_column_spanners(spanners = c("Point in time metrics")) #, glue("Predictions on ({format(today + 21, '%m/%d')}) (No intervention)")
    ) %>%
    # adjust title font
    tab_style(
      style     = list(cell_text(font = "helvetica", size = px(24))),
      locations = list(cells_title(groups = "title"))
    ) %>%
    # adjust subtitle font
    tab_style(
      style     = list(cell_text(font = "helvetica", size = px(18))),
      locations = list(cells_title(groups = "subtitle"))
    ) %>%
    # color cells based on values
    data_color(
      columns = c(R),
      colors = scales::col_bin(c("#FFFFFF", "#fae0de"), domain = NULL, bins = c(0,1,1000), pretty = F)
    ) %>%
    # data_color(
    #   columns = c(`7-day average daily TPR`),
    #   colors = scales::col_bin(c("#FFFFFF", "#fae0de"), domain = NULL, bins = c(0, 0.05, 1), pretty = F, na.color = "#e8e8e8")
    # ) %>%
    # highlight national estimate
    tab_style(
      style = cell_fill(color = "#fcf8d4"),
      locations = cells_body(
        rows = Location == "India")
    )

  cli::cli_alert_success("point-in-time table made")

  cumulative <- tib[, !c("# daily new cases", "# daily new deaths",
                         "7-day average daily CFR", "R", "daily vaccine doses")] %>%
    gt() %>%
    # format table body text
    tab_style(
      style     = cell_text(size = px(14), font = "helvetica"),
      locations = cells_body()
    ) %>%
    tab_style(
      style     = cell_text(weight = "bold"),
      locations = cells_body(c(Location))
    ) %>%
    # format column names
    tab_style(
      style = cell_text(
        size      = px(12),
        color     = "#999999",
        font      = "helvetica",
        transform = "uppercase"
      ),
      locations = cells_column_labels(everything())
    ) %>%
    # format numbers
    fmt_number(
      columns  = c(CFR),
      decimals = 3
    ) %>%
    # random formatting
    tab_options(
      column_labels.border.top.style    = "none",
      column_labels.border.bottom.width = 1,
      column_labels.border.bottom.color = "#334422",
      table_body.border.bottom.color    = "#0000001A",
      data_row.padding                  = px(4)
    ) %>%
    # column widths
    cols_width(
      (Location) ~ px(150),
      (CFR) ~ px(75),
      everything() ~ px(100)
    ) %>%
    cols_align(
      align   = "center",
      columns = everything()
    ) %>%
    # title
    tab_header(
      title    = md("**Assessing COVID-19 in India**"),
      subtitle = glue("data through {format(today, '%B %e')}")
    ) %>%
    # caption
    tab_source_note(
      source_note = md(source_note_text)
    ) %>%
    tab_spanner(
      label   = "Cumulative metrics",
      columns = c(`total cases`, `total deaths`, CFR,
                  `Total doses`, `% pop. with two shots`, `% pop. with at least one shot`)
    ) %>%
    cols_move_to_start((Location)) %>%
    tab_style(
      style = cell_text(
        size      = px(14),
        color     = "#999999",
        font      = "helvetica",
        transform = "uppercase"
      ),
      locations = cells_column_spanners(spanners = c("Cumulative metrics"))
    ) %>%
    # adjust title font
    tab_style(
      style     = list(cell_text(font = "helvetica", size = px(24))),
      locations = list(cells_title(groups = "title"))
    ) %>%
    # adjust subtitle font
    tab_style(
      style     = list(cell_text(font = "helvetica", size = px(18))),
      locations = list(cells_title(groups = "subtitle"))
    ) %>%
    # highlight national estimate
    tab_style(
      style = cell_fill(color = "#fcf8d4"),
      locations = cells_body(rows = Location == "India")
    )

  cli::cli_alert_success("cumulative table made")

  if (!is.null(top20)) {

    t20_tib <- data.table::merge.data.table(tib, covid19india::pop[, !c("population")], by.x = "Location", by.y = "place")[abbrev %in% unique(c(top20, "tt"))][, !c("abbrev")][order(-`total cases`)]

    source_note_text <- glue(
      "**\uA9 COV-IND-19 Study Group**<br>**Source data:** Up to 10/17/2021: covid19india.org. After 10/17/2021: count data (mohfw.gov.in), vaccine data (cowin.gov.in)<br>
      **Notes:** Cells highlighted in green indicates good performance for given metric while red indicates need for improvement.
      Only states/union territories with the highest cumulative case counts as of {format(today, '%B %e')} are shown.
      States are omitted if they have missing case count data.
      <br>
      R values are not reliable when case counts are below 100.
      <br>
      **Abbrev:** CFR, Case-fatality rate."
    )

    t20_tabl <- t20_tib %>%
      gt() %>%
      # format table body text
      tab_style(
        style     = cell_text(size = px(14), font = "helvetica"),
        locations = cells_body()
      ) %>%
      tab_style(
        style     = cell_text(weight = "bold"),
        locations = cells_body((Location))
      ) %>%
      # format column names
      tab_style(
        style = cell_text(
          size      = px(12),
          color     = "#999999",
          font      = "helvetica",
          transform = "uppercase"
        ),
        locations = cells_column_labels(everything())
      ) %>%
      # format numbers
      fmt_number(
        columns  = c(CFR),
        decimals = 3
      ) %>%
      fmt_number(
        columns  = c(R),
        decimals = 2
      ) %>%
      # random formatting
      tab_options(
        column_labels.border.top.style    = "none",
        column_labels.border.bottom.width = 1,
        column_labels.border.bottom.color = "#334422",
        table_body.border.bottom.color    = "#0000001A",
        data_row.padding                  = px(4)
      ) %>%
      # column widths
      cols_width(
        Location ~ px(150),
        c(R, CFR) ~ px(75),
        everything() ~ px(100)
      ) %>%
      cols_align(
        align   = "center",
        columns = everything()
      ) %>%
      # title
      tab_header(
        title    = md("**Assessing COVID-19 in India**"),
        subtitle = glue("data through {format(today, '%B %e')}")
      ) %>%
      # caption
      tab_source_note(
        source_note = md(source_note_text)
      ) %>%
      # add and format column spanners
      tab_spanner(
        label   = "Point in time metrics",
        columns = c(`# daily new cases`, `# daily new deaths`,
                    `7-day average daily CFR`, R, `daily vaccine doses`)
      ) %>%
      tab_spanner(
        label   = "Cumulative metrics",
        columns = c(`total cases`, `total deaths`, CFR,
                    `Total doses`, `% pop. with two shots`, `% pop. with at least one shot`)
      ) %>%
      cols_move_to_start((Location)) %>%
      tab_style(
        style = cell_text(
          size      = px(14),
          color     = "#999999",
          font      = "helvetica",
          transform = "uppercase"
        ),
        locations = cells_column_spanners(spanners = c("Point in time metrics", "Cumulative metrics"))
      ) %>%
      # adjust title font
      tab_style(
        style     = list(cell_text(font = "helvetica", size = px(24))),
        locations = list(cells_title(groups = "title"))
      ) %>%
      # adjust subtitle font
      tab_style(
        style     = list(cell_text(font = "helvetica", size = px(18))),
        locations = list(cells_title(groups = "subtitle"))
      ) %>%
      # color cells based on values
      data_color(
        columns = c(R),
        colors = scales::col_bin(c("#FFFFFF", "#fae0de"), domain = NULL, bins = c(0,1,1000), pretty = F)
      ) %>%
      # highlight national estimate
      tab_style(
        style = cell_fill(color = "#fcf8d4"),
        locations = cells_body(
          rows = Location == "India")
      ) %>%
      tab_style(
        style = cell_borders(sides = "left"),
        locations = cells_body(columns = (`total cases`))
      ) %>%
      tab_style(
        style = cell_borders(sides = "left"),
        locations = cells_column_labels(columns = (`total cases`))
      ) %>%
      tab_style(
        style = cell_borders(sides = "left"),
        locations = cells_column_spanners(("Cumulative metrics"))
      )

    cli::cli_alert_success("full top 20 table made")

    # new table
    t20_point_in_time <- t20_tib[, !c("total cases", "total deaths", "CFR",
                                      "Total doses", "% pop. with two shots",
                                      "% pop. with at least one shot")] %>%
      gt() %>%
      # format table body text
      tab_style(
        style     = cell_text(size = px(14), font = "helvetica"),
        locations = cells_body()
      ) %>%
      tab_style(
        style     = cell_text(weight = "bold"),
        locations = cells_body(c(Location))
      ) %>%
      # format column names
      tab_style(
        style = cell_text(
          size      = px(12),
          color     = "#999999",
          font      = "helvetica",
          transform = "uppercase"
        ),
        locations = cells_column_labels(everything())
      ) %>%
      # format numbers
      fmt_number(
        columns  = c(R),
        decimals = 2
      ) %>%
      # random formatting
      tab_options(
        column_labels.border.top.style    = "none",
        column_labels.border.bottom.width = 1,
        column_labels.border.bottom.color = "#334422",
        table_body.border.bottom.color    = "#0000001A",
        data_row.padding                  = px(4)
      ) %>%
      # column widths
      cols_width(
        Location ~ px(150),
        R ~ px(75),
        everything() ~ px(100)
      ) %>%
      cols_align(
        align   = "center",
        columns = everything()
      ) %>%
      # title
      tab_header(
        title    = md("**Assessing COVID-19 in India**"),
        subtitle = glue("data through {format(today, '%B %e')}")
      ) %>%
      # caption
      tab_source_note(
        source_note = md(source_note_text)
      ) %>%
      tab_spanner(
        label   = "Point in time metrics",
        columns = c(`# daily new cases`, `# daily new deaths`,
                    `7-day average daily CFR`, R, `daily vaccine doses`)
      ) %>%
      cols_move_to_start((Location)) %>%
      tab_style(
        style = cell_text(
          size      = px(14),
          color     = "#999999",
          font      = "helvetica",
          transform = "uppercase"
        ),
        locations = cells_column_spanners(spanners = c("Point in time metrics")) #, glue("Predictions on ({format(today + 21, '%m/%d')}) (No intervention)")
      ) %>%
      # adjust title font
      tab_style(
        style     = list(cell_text(font = "helvetica", size = px(24))),
        locations = list(cells_title(groups = "title"))
      ) %>%
      # adjust subtitle font
      tab_style(
        style     = list(cell_text(font = "helvetica", size = px(18))),
        locations = list(cells_title(groups = "subtitle"))
      ) %>%
      # color cells based on values
      data_color(
        columns = c(R),
        colors = scales::col_bin(c("#FFFFFF", "#fae0de"), domain = NULL, bins = c(0,1,1000), pretty = F)
      ) %>%
      # highlight national estimate
      tab_style(
        style = cell_fill(color = "#fcf8d4"),
        locations = cells_body(
          rows = Location == "India")
      )

    cli::cli_alert_success("top 20 point-in-time table made")

    t20_cumulative <- t20_tib[, !c("# daily new cases", "# daily new deaths",
                                   "7-day average daily CFR", "R", "daily vaccine doses")] %>%
      gt() %>%
      # format table body text
      tab_style(
        style     = cell_text(size = px(14), font = "helvetica"),
        locations = cells_body()
      ) %>%
      tab_style(
        style     = cell_text(weight = "bold"),
        locations = cells_body(c(Location))
      ) %>%
      # format column names
      tab_style(
        style = cell_text(
          size      = px(12),
          color     = "#999999",
          font      = "helvetica",
          transform = "uppercase"
        ),
        locations = cells_column_labels(everything())
      ) %>%
      # format numbers
      fmt_number(
        columns  = c(CFR),
        decimals = 3
      ) %>%
      # random formatting
      tab_options(
        column_labels.border.top.style    = "none",
        column_labels.border.bottom.width = 1,
        column_labels.border.bottom.color = "#334422",
        table_body.border.bottom.color    = "#0000001A",
        data_row.padding                  = px(4)
      ) %>%
      # column widths
      cols_width(
        (Location) ~ px(150),
        (CFR) ~ px(75),
        everything() ~ px(100)
      ) %>%
      cols_align(
        align   = "center",
        columns = everything()
      ) %>%
      # title
      tab_header(
        title    = md("**Assessing COVID-19 in India**"),
        subtitle = glue("data through {format(today, '%B %e')}")
      ) %>%
      # caption
      tab_source_note(
        source_note = md(source_note_text)
      ) %>%
      tab_spanner(
        label   = "Cumulative metrics",
        columns = c(`total cases`, `total deaths`, CFR,
                    `Total doses`, `% pop. with two shots`, `% pop. with at least one shot`)
      ) %>%
      cols_move_to_start((Location)) %>%
      tab_style(
        style = cell_text(
          size      = px(14),
          color     = "#999999",
          font      = "helvetica",
          transform = "uppercase"
        ),
        locations = cells_column_spanners(spanners = c("Cumulative metrics"))
      ) %>%
      # adjust title font
      tab_style(
        style     = list(cell_text(font = "helvetica", size = px(24))),
        locations = list(cells_title(groups = "title"))
      ) %>%
      # adjust subtitle font
      tab_style(
        style     = list(cell_text(font = "helvetica", size = px(18))),
        locations = list(cells_title(groups = "subtitle"))
      ) %>%
      # highlight national estimate
      tab_style(
        style = cell_fill(color = "#fcf8d4"),
        locations = cells_body(rows = Location == "India")
      )

    cli::cli_alert_success("top 20 cumulative table made")

  }

  if (is.null(top20)) {
    return(list(full       = tabl,
         point_in_time     = point_in_time,
         cumulative        = cumulative
    ))
  } else {
    return(list(full       = tabl,
         point_in_time     = point_in_time,
         cumulative        = cumulative,
         full_t20          = t20_tabl,
         point_in_time_t20 = t20_point_in_time,
         cumulative_t20    = t20_cumulative
    ))
  }

}
maxsal/covid19india documentation built on Jan. 28, 2022, 8:33 p.m.