nyt_table

library(gt)
library(htmltools)

euro_table <- tibble::tribble(
  ~Country, ~`Pct Above Normal`, ~`Excess Deaths`, ~`Time Period`,
  "United Kingdom", 67, 53300, "Mar. 14 - May 1",
  "Spain", 60,	31500, "Mar. 16 - May 3",
  "Belgium", 50,	5300, "Mar. 16 - Apr. 19",
  "Netherlands", 50, 8700,	"Mar. 16 - Apr. 26",
  "Italy", 49, 24600, "March",
  "France", 44, 28500, "Mar. 16 - Apr. 26",
  "Sweden", 27,	3300, "Mar. 16 - May 3",
  "Switzerland", 24,	2000, "Mar. 16 - May 3",
  "Portugal", 15,	1300, "Mar. 16 - Apr. 12",
  "Austria", 11, 1000, "Mar. 16 - Apr. 26",
  "Germany", 6,	4100, "Mar. 16 - Apr. 12",
  "Denmark", 5, 300, "Mar. 16 - May 3",
  "Norway", 0, 100, "Mar. 16 - Apr. 26",
  "Finland", 0, 100, "Mar. 16 - Apr. 26"
)

less_than_100 <- function(.x) {
  glue::glue("<{.x}")
}

plus_percent <- function(.x) {
  glue::glue("+{.x}%")
}

euro_table_gt <- gt(euro_table) %>%
  fmt("Pct Above Normal", fns = plus_percent) %>%
  fmt_number("Excess Deaths", decimals = 0) %>%
  fmt("Excess Deaths", rows = `Excess Deaths` == 100,  fns = less_than_100) %>%
  tab_style(
    style = cell_fill(color = "#F7EFB2"),
    locations = cells_body(
      rows = Country == "Sweden")
  ) %>%
  tab_style(
    style = cell_text(size = px(15), weight = "bold", font = "arial"),
    locations = cells_body(vars(Country, `Pct Above Normal`, `Excess Deaths`))
  ) %>%
  tab_style(
    style = cell_text(
      size = px(12),
      color = "#999",
      font = "arial",
      indent = px(65)
    ),
    locations = cells_body(vars(`Time Period`))
  ) %>%
  tab_style(
    style = cell_text(indent = px(65)),
    locations = cells_column_labels(vars(`Time Period`))
  ) %>%
  tab_style(
    style = cell_text(
      size = px(11),
      color = "#999",
      font = "arial",
      transform = "uppercase"
    ),
    locations = cells_column_labels(everything())
  ) %>%
  tab_options(
    column_labels.border.top.style = "none",
    table.border.top.style = "none",
    column_labels.border.bottom.style = "none",
    column_labels.border.bottom.width = 1,
    column_labels.border.bottom.color = "#334422",
    table_body.border.top.style = "none",
    table_body.border.bottom.color = "#0000001A",
    data_row.padding = px(7)
  ) %>%
  cols_width(
    vars(Country) ~ px(175),
    vars(`Pct Above Normal`) ~ px(100),
    vars(`Excess Deaths`) ~ px(100),
    vars(`Time Period`) ~ px(175)
  )

css <- function(...) {
  .x <- c(...)
  .x <- paste0(names(.x), ":", .x)
  paste(.x, collapse = ";")
}

html_table <- as_raw_html(euro_table_gt)

arrow_url <- "https://static01.nyt.com/newsgraphics/2020/05/12/sweden/9e1eca4da0509269e349b4771ee3b25daf054f51/arrow-01.png"

more_or_less_css <- css(
  "font-size" = px(13),
  "width" = px(80),
  "font-family" = "arial",
  "display" = "flex",
  "flex-direction" = "column",
  "justify-content" = "center",
  "text-align" = "center",
  "padding-right" = px(5),
  "color" = "#999"
)

arrow_css <- css(
  "transform" = "rotate(180deg)",
  "width" = px(15)
)

more_or_less <- div(
  style = more_or_less_css,
  div(
    style = css("margin-top" = px(20)),
    img(src = arrow_url, style = css(width =  px(15))),
    div("More than Sweden")
  ),
  div(
    style = css("margin-top" = px(70)),
    div("Less than Sweden"),
    img(src = arrow_url, style = arrow_css)
  )
)

table_css <- css(
  "width" = px(620),
  "height" = px(451),
  "display" = "flex",
  "flex-direction" = "row",
  "flex-wrap" = "nowrap"
)

browsable(
  div(
    style = table_css,
    more_or_less,
    html_table
  )
)