Rstudio Table Contest Submission

PUBLISHED ON OCT 26, 2020

This is going to be a pretty short post. After seeing the Rstudio Table Contest announced a few weeks ago, I decided that I wanted to submit something to give myself more of a reason to practice with the {gt} package. I (somewhat arbitrarily) chose to use some longitudinal Broadway data posted earlier in the year as part of #TidyTuesday that I thought would lend itself well to a table.

Anyway, below is my submission to the contest, and below that are some initial impressions of the {gt} package (tl;dr – it’s pretty awesome).

Table

knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)

library(tidyverse)
## Warning: package 'tibble' was built under R version 4.0.3
library(gt)
library(lubridate)


# Cleaning and Setup ------------------------------------------------------

#loading in broadway data from wk 18 of TidyTuesday 2020
grosses <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-28/grosses.csv', guess_max = 40000)

#removing 2020 bc it's not yet complete & is an awkward year
grosses <- grosses %>%
  filter(year(week_ending) != 2020)

#getting top 20 selling shows
top_shows <- grosses %>%
  count(show, wt = weekly_gross, sort = TRUE) %>%
  slice_max(order_by = n, n = 10) %>%
  pull(show)

#getting data for line plot
annual_sales <- grosses %>%
  filter(show %in% top_shows) %>%
  mutate(year = year(week_ending)) %>%
  group_by(show, year) %>%
  summarize(tix = sum(seats_sold, na.rm = TRUE)) %>%
  ungroup()

#setting values for plots/tables
labs_col <- '#d9b51c'
labs_back <- '#373737'
bckgrnd <- '#474747'
bck_light <- '#515151'
text_col <- '#fdfdfd'
font <- google_font("Rubik")
lob <- google_font("Lobster")

bckgrnd_vec <- rep(c(bckgrnd, bck_light), times = 5)

#getting playbill img urls
playbills <- c("https://bsp-static.playbill.com/dims4/default/25f6db1/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F06%2Ffb%2Ff6ba0a7c40ca918068a0fdc04bf7%2Fthe-lion-king-playbill-2017-11-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/823dbab/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2Feb%2Fc2%2F90b25fdb41f7a75d2f9532ff7da4%2Fwicked-playbill-2017-05-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/a4bd340/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F50%2Fa4%2Fa71805ca472a8f12c97cac39f1e7%2Fthe-phantom-of-the-opera-playbill-2019-01-01-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/641d7e2/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F1d%2Fa9%2F224d538645058e0877d400321174%2Fchicago-playbill-2020-01-01-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/38f17a2/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F8e%2Fc9%2F60189ac7483b86d4f26f0d26d85e%2Fthe-book-of-mormon-playbill-2011-2-24-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/5101191/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F23%2Fde%2F41ceb4094b0d9b7c9e53a51f2731%2Fmamma-mia-playbill-2001-10-05-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/9ce9b12/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2Fb2%2Fd5%2Fd007cd9d468f8b0ed107c00d119e%2Fhamilton-playbill-2018-01-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/a66da3d/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F5f%2F0d%2F9372f5f347ee824597d030323716%2Fjersey-boys-playbill-2005-10-17-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/b0dcc9c/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F8f%2Fd7%2F3d838c6441c192023d35429c4de5%2Fles-miserables-playbill-2014-03-01-web.jpg",
               "https://bsp-static.playbill.com/dims4/default/4b36540/2147483647/resize/x250%3C/quality/90/?url=http%3A%2F%2Fpb-asset-replication.s3.amazonaws.com%2F41%2F3d%2Fc505cabe4e0fb51d74e83f26b453%2Faladdin-playbill-2018-04-01-web.jpg")

#creating plot function
plot_line <- function(show, col = bckgrnd) {
  annual_sales %>%
    filter(show == {{ show }}) %>%
    ggplot(aes(x = year, y = tix)) +
    geom_line(size = 2, color = text_col) +
    scale_x_continuous(limits = c(min(annual_sales$year) - 1, max(annual_sales$year) + 1)) +
    theme_void() +
    theme(
      plot.background = element_rect(fill = col, color = col),
      panel.background = element_rect(fill = col, color = col)
    )
}

#set up tbl
tbl <- grosses %>%
  filter(show %in% top_shows) %>%
  group_by(show) %>%
  summarize(yr_of_premier = min(year(week_ending)),
            total_gross = sum(weekly_gross),
            avg_capacity = mean(pct_capacity),
            tix_year = sum(seats_sold)/(max(year(week_ending)) - min(year(week_ending)) + 1)) %>%
  arrange(desc(total_gross)) %>%
  mutate(plots = map2(show, bckgrnd_vec, plot_line),
         ranking = row_number(),
         playbills = playbills)


# Creating Table ----------------------------------------------------------

styled_tbl <- tbl %>%
  select(ranking, show, playbills, everything()) %>%
  gt() %>%
  opt_table_font(
    font = font
  ) %>%
  opt_row_striping() %>%
  tab_header(
    title = md("**Top Earning Broadway Shows**"),
    subtitle = md("*through 2019*")
  ) %>%
  cols_label(
    ranking = "Rank",
    show = "Show",
    playbills = "",
    yr_of_premier = "Premiere Year",
    total_gross = "Total Earnings",
    avg_capacity = md("Avg Theater<br>Capacity Filled"),
    tix_year = "Average",
    plots = "1987 - 2019"
  ) %>%
  tab_spanner(
    label = "Tickets Sold Per Year",
    columns = vars(tix_year, plots)
  ) %>%
  tab_style(
    style = cell_text(font = lob, align = "center", size = px(50), color = labs_col),
    locations = cells_title("title")
  ) %>%
  tab_style(
    style = cell_fill(color = labs_back),
    location = cells_title("title")
  ) %>%
  tab_style(
    style = cell_text(font = lob, align = "center", size = px(12), color = labs_col),
    locations = cells_title("subtitle")
  ) %>% 
  tab_style(
    style = cell_fill(color = labs_back),
    locations = cells_title("subtitle")
  ) %>%
  tab_style(
    style = cell_text(size = px(15), style = "italic"),
    locations = list(cells_column_labels(vars(ranking, show, yr_of_premier, total_gross, avg_capacity)), cells_column_spanners(everything()))
  ) %>%
  tab_style(
    style = cell_text(size = px(12), style = "italic", align = "center"),
    locations = cells_column_labels(vars(tix_year, plots))
  ) %>%
  tab_style(
    style = cell_text(align = "center"),
    locations = cells_body(everything())
  ) %>%
  tab_style(
    style = cell_borders(sides = c("top", "bottom"), color = bckgrnd),
    locations = cells_body(
      columns = everything(),
      rows = everything()
    )
  ) %>%
  text_transform(locations = cells_body(vars(plots)),
                 fn = function(x) {
                   map(tbl$plots, ggplot_image)
                 }) %>%
  text_transform(
    locations = cells_body(vars(playbills)),
    fn = function(x) {
      map(tbl$playbills, ~web_image(.x, height = 50))
    }
  ) %>%
  fmt_currency(
    columns = vars(total_gross),
    currency = "USD",
    decimals = 2,
    suffixing = TRUE
  ) %>%
  fmt_number(
    columns = vars(tix_year),
    decimals = 0,
    sep_mark = ",",
    use_seps = TRUE
  ) %>%
  fmt_percent(
    columns = vars(avg_capacity),
    decimals = 1
  ) %>%
  tab_options(
    column_labels.background.color = labs_back,
    table.background.color = bckgrnd,
    table.font.color = text_col,
    data_row.padding = -30,
    row.striping.background_color = bck_light
  ) %>%
  tab_source_note(
    source_note = md("**Data:** Playbill | **Table:** Eric Ekholm (@ekholm_e)")
  )

styled_tbl
Top Earning Broadway Shows
through 2019
Rank Show Premiere Year Total Earnings Avg Theater
Capacity Filled
Tickets Sold Per Year
Average 1987 - 2019
1 The Lion King 1997 $1.66B 97.7% 676,795
2 Wicked 2003 $1.35B 97.2% 708,412
3 The Phantom of the Opera 1988 $1.24B 89.8% 600,508
4 Chicago 1996 $673.91M 82.7% 392,534
5 The Book of Mormon 2011 $647.07M 102.4% 445,435
6 Mamma Mia! 2001 $624.39M 89.7% 504,408
7 Hamilton 2015 $620.60M 101.7% 498,052
8 Jersey Boys 2005 $557.51M 89.5% 395,571
9 Les Miserables 1987 $548.80M 88.5% 353,014
10 Aladdin 2014 $447.72M 98.0% 686,539
Data: Playbill | Table: Eric Ekholm (@ekholm_e)

Impressions

Right, so, my overall impression of {gt} is that it’s an amazing package for building stylized static tables that fills a gap in R’s table ecosystem (to the extent that’s a thing). In my day job, I often find myself having to build tables either 1) as part of documents I’m creating on my own or 2) as stand-alone pieces that end up getting dropped into Powerpoints other people are putting together, and I’m excited about incorporating {gt} into my workflow for both of those types of tasks. Some more specific impressions of {gt}:

  • It feels a lot like {ggtplot2}. This isn’t surprising, given that the intent of the package is to provide a “grammar of tables.” But the flow & general process felt very familiar to me even though I haven’t used it extensively before, and I imagine anyone else who’s reasonably proficient using ggplot will feel the same when picking up gt. Which is a big plus, because it mitigates a lot of that difficulty of learning a new package.
  • It’s refreshingly easy to work with fonts. My biggest sore spot with ggplot is incorporating different fonts, which I always seem to struggle with (and my understanding is that this is a common struggle for Windows users). The {ragg} package seems to have made using fonts in ggplot easier, though. That said, using any Google font in gt is as easy as dropping in the google_font() function and voila, it works! Such a nice change of pace after my typical long troubleshooting sessions with fonts in ggplot.
  • The ability to include ggplot images and web images in a table is pretty cool. You’ll see that I added both to my table above, and each felt very easy to include. Honestly, the most time-consuming part was finding the urls for the playbill images.
  • The helper functions to format numbers, percents, and currency are great. I work with a lot of large $ amounts – as well as percents – in my job, and I’m super stoked about not having to manually format these anymore.
  • I may have run into a small bug passing where font types (e.g. Lobster, Rubik) weren’t being recognized when called from within a list in the tab_style() function, which I’ll open an issue for. I found a workaround, but it involved essentially stylizing the same element multiple times, which doesn’t feel ideal.

Overall, {gt} is a really awesome package – huge thanks to the team at Rstudio for putting it together and maintaining it!