Eric Ekholm - RStudio Table Contest Submission

is 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

library(tidyverse)
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
Rank	Show	Premiere Year	Total Earnings	Avg Theater Capacity Filled	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,538
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!

Reuse

https://creativecommons.org/licenses/by-nc/4.0/

Citation

BibTeX citation:

@online{ekholm2020,
  author = {Ekholm, Eric},
  title = {RStudio {Table} {Contest} {Submission}},
  date = {2020-10-26},
  url = {https://www.ericekholm.com/posts/rstudio-table-contest-submission},
  langid = {en}
}

For attribution, please cite this work as:

Ekholm, Eric. 2020. “RStudio Table Contest Submission.” October 26, 2020. https://www.ericekholm.com/posts/rstudio-table-contest-submission.