Replicating a New York Times Table of Swedish COVID-19 deaths with gt

I recently read an article in the New York Times about excess deaths in Sweden during the coronavirus outbreak. As opposed to many of its neighbors, Sweden did not do a general lockdown; instead, it (controversially) strove to systematically develop herd immunity. However, current data suggest that excess deaths (the number of deaths above the usual number) in Sweden are higher than many of its neighbors that enacted early, stricter lockdowns. It’s unclear at this point whether this means the approach taken in Sweden doesn’t help prevent COVID-19 deaths in the long run, but the data are worth considering either way. In the NYT article, the authors present a table of excess deaths for Sweden and other countries in Europe. I thought this table was remarkably good: it’s simple, clear, and beautiful.

I’ve been working with the gt package for making tables (new to CRAN!), and I wondered if I could replicate this table in R. gt is a flexible tool with an excellent interface, and it’s particularly strong with HTML tables. There are many, many packages for making tables in R, but I think gt solves the problem of making tables in R in a generalized and elegant way. (If you want to learn how to use gt, try the gt Test Drive RStudio Cloud project. It’s a comprehensive introduction with runnable code.)

Anyway, let’s give this table a shot. First, I’ll load gt and htmltools (which we’ll need later for some final touches), as well as the data from the NYT article. The euro_table data frame has columns with European country names, the percentage of deaths the country has had during the pandemic that is above normal amounts, the number of excess deaths the country has had, and the time the data cover.

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"
)

Similar to ggplot2’s ggplot() for setting up a basic plot, gt has a function, gt(), that sets up a basic table.

euro_table_gt <- gt(euro_table)

euro_table_gt
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

gt has reasonable defaults that create a nice looking, simple table from the data, but this table lacks many of the elements the NYT article has. The columns with the percentage above normal and the number of deaths, for instance, had some basic formatting that isn’t included here. gt has a whole set of fmt_*() functions for formatting columns. The first argument is where you tell gt what columns you want to format. You can use tidy select helpers, as in dplyr and friends, to specify columns, but here I’ll format them one at a time, so I can just put the column name in a string. fmt_number() is a reasonable place to start because it’s simple: it will format Excess Deaths as a number (adding commas and justifying it to the right, here without decimal places).

euro_table_gt <- gt(euro_table) %>%
  fmt_number("Excess Deaths", decimals = 0)

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom 67 53,300 Mar. 14 - May 1
Spain 60 31,500 Mar. 16 - May 3
Belgium 50 5,300 Mar. 16 - Apr. 19
Netherlands 50 8,700 Mar. 16 - Apr. 26
Italy 49 24,600 March
France 44 28,500 Mar. 16 - Apr. 26
Sweden 27 3,300 Mar. 16 - May 3
Switzerland 24 2,000 Mar. 16 - May 3
Portugal 15 1,300 Mar. 16 - Apr. 12
Austria 11 1,000 Mar. 16 - Apr. 26
Germany 6 4,100 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

gt has a number of formatting functions, but you can also write custom formatters with fmt(). That’s good for what we have to do here. First, we need to add a + before the percentages and a % after. Then, we need to add a < for countries had that have excess numbers of deaths below 100. We’ll write two functions, plus_percent() and less_than_100(), to format Pct Above Normal and Excess Deaths using the glue package. For Pct Above Normal, we want to format the whole column, but for Excess Deaths, we only want to format rows with values of 100. We can specify that with the rows argument.

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

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

euro_table_gt <- euro_table_gt %>%
  fmt("Pct Above Normal", fns = plus_percent) %>%
  fmt("Excess Deaths", rows = `Excess Deaths` == 100,  fns = less_than_100)

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

So now, the content of the table matches the NYT article, but there are a lot of stylistic differences. In particular, we need to change the font (depending on the cell, we might need to change the size, color, case, or weight), and we need to highlight the row with data from Sweden.

tab_style() can handle both of these issues. tab_style() takes two additional arguments beyond a gt object: style and locations. style lets us specify how a part of the table should be styled with cell_text(), cell_fill(), or cell_borders(). Let’s highlight Sweden first. We’ll add the highlighting color with cell_fill(color = "#F7EFB2"). The locations argument is the real magic of tab_style(): it lets us specify exactly which columns, rows, or cells to style. We want to format some cells in the table body, so we’ll use cells_body() (see the help page for tab_style() for all the helper functions available). As above, we can use the rows argument to tell gt to highlight the row where Country == "Sweden".

euro_table_gt <- euro_table_gt %>%
  tab_style(
    style = cell_fill(color = "#F7EFB2"),
    locations = cells_body(
      rows = Country == "Sweden")
  )

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

There are also several typographic styles in the table, so let’s address them one at a time. First, Country, Pct Above Normal, and Excess Deaths all have a font size of 15 pixels, are lightly bolded, and have a different font than gt’s defaults (technically the font is the NYT custom font, but we’ll use their backup font, Arial, to get close). We can specify all of these differences with cell_text(). Again, these are cells in the table body, so we’ll use cells_body() to locate them. I’ll use the tidyselect function vars() to find each of the columns we want to format.

euro_table_gt <- euro_table_gt %>%
  tab_style(
    style = cell_text(size = px(15), weight = "bold", font = "arial"),
    locations = cells_body(vars(Country, `Pct Above Normal`, `Excess Deaths`))
  )

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

Time Period has a smaller font in gray. It’s also got a margin on the left to push it away from the excess deaths column; we can use the indent argument for that. We need to add the same indent to the Time Period column label, so we’ll add a second tab_style() that finds that location with cells_column_labels().

euro_table_gt <- euro_table_gt %>%
  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`))
  ) 

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

Finally, the column labels are all smaller, gray, and uppercase. Again, we can use cell_text() to specify each of these, including the transform = "uppercase" argument. For locations, we’ll use cells_column_labels() again, and since we want to apply this to all columns, we can use the tidyselect helper everything() to get them all.

euro_table_gt <- euro_table_gt %>%
  tab_style(
    style = cell_text(
      size = px(11),
      color = "#999",
      font = "arial",
      transform = "uppercase"
    ),
    locations = cells_column_labels(everything())
  ) 

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

There are two more things left for the table body: some overall table styling and the column widths. We can deal with global table options with tab_options(). I won’t go over these in great detail, but we are changing some minor details in the cell borders and padding to match the original table better.

euro_table_gt <- euro_table_gt %>%
  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)
  )
euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

Finally, we’ll use cols_width() to specify column widths. cols_width() has a syntax similar to dplyr’s case_when(): on the left-hand side of ~, we specify a column, and on the right-hand side, we specify a width (here using the px() helper function).

euro_table_gt <- euro_table_gt %>%
  cols_width(
    vars(Country) ~ px(175),
    vars(`Pct Above Normal`) ~ px(100),
    vars(`Excess Deaths`) ~ px(100),
    vars(`Time Period`) ~ px(175)
  )

euro_table_gt
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

That gets us most of the way there! We’re able to the this far entirely in gt. However, it turns out that one of the more compelling parts of the NYT table–the more-or-less annotation on the left side–is actually not part of the table. Instead, they use a trick with divs and flexboxes to group the arrow annotation with the table. Everything is wrapped in a container <div> with row-wise flexboxes, and the annotations are themselves in a <div> with column-wise flexboxes. The arrows are from a single image file, which I’ve saved as arrow-01.png.

Luckily, gt works well with the htmltools package, so we can add the annotations ourselves. First, we’ll turn our gt table into raw HTML with as_raw_html(). Then, we’ll use the htmltools package to create the more-or-less annotation and combine it with the HTML from the gt table later on.

html_table <- as_raw_html(euro_table_gt)
class(html_table)
## [1] "html"      "character"

We need to write a little CSS for the annotations to create a column-wise flexbox and match the typography in the NYT table. htmltool’s css() function will help us write the CSS using R. For the arrows, we’ll use the same image, but we’ll rotate the lower one with the CSS transform property. Then, we’ll put together the more-or-less <div> which has the images and text stacked on top of each other (with some additions to the padding and widths to put them in the right spot).

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(
    img(src = "arrow-01.png", style = css(width =  px(15))),
    div("More than Sweden", style = css(padding.bottom = px(20)))
  ),
  div(
    style = css(padding.top = px(40)),
    div("Less than Sweden"),
    img(src = "arrow-01.png", style = arrow_css)
  )
)

Here’s the resulting annotation:

more_or_less
More than Sweden
Less than Sweden

Finally, we need to put it together with the gt table. We’ll create the container <div> that groups the annotation with the table and style it to put the two parts together row-wise. We’ll also set the width and center the table with margin = "auto".

table_css <- css(
  width = px(620),
  display = "flex",
  flex.direction = "row",
  flex.wrap = "nowrap",
  margin = "auto"
)

div(
  style = table_css,
  more_or_less,
  html_table
)
More than Sweden
Less than Sweden
Country Pct Above Normal Excess Deaths Time Period
United Kingdom +67% 53,300 Mar. 14 - May 1
Spain +60% 31,500 Mar. 16 - May 3
Belgium +50% 5,300 Mar. 16 - Apr. 19
Netherlands +50% 8,700 Mar. 16 - Apr. 26
Italy +49% 24,600 March
France +44% 28,500 Mar. 16 - Apr. 26
Sweden +27% 3,300 Mar. 16 - May 3
Switzerland +24% 2,000 Mar. 16 - May 3
Portugal +15% 1,300 Mar. 16 - Apr. 12
Austria +11% 1,000 Mar. 16 - Apr. 26
Germany +6% 4,100 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

And there we have it! There are some slight differences from the original table, but we’ve now got a beautiful replication made entirely in R. gt didn’t get us all the way there, but it did most of the heavy lifting and worked well with htmltools to put in the finishing touches.

gt is an incredible, well-designed tool for making beautiful tables. I’m really excited about the future of this package and to see what the broader R community does with it. After watching gt for a long time, I fully expect that it will have the same impact on tables that ggplot2 has had on data visualizations. While it’s still maturing, it solves many of the pain points of creating pretty tables in R. In particular, it’s API for specifying which location to style, transform, or annotate is powerful and elegant. It’s most robust for HTML tables, but gt also supports LaTeX and RTF tables and may support others more fully in the future.

Avatar
Malcolm Barrett
PhD Student in Epidemiology

I am an R developer and a PhD student in Epidemiology at the University of Southern California. My work in public health has spanned on-ground clinical education and research for clinical and cohort studies. Previously, I was an intern at RStudio, and I served two years in AmeriCorps at federally-qualified health centers in Michigan and New York City.