Pretty tables with {gt}

Bitcoin gt ggplot bitmexr R

Traditionally I have been an ardent user of kable + kableExtra when it comes to creating tables. These packages have served me well, however the CRAN release of a new player in the table package space - gt - promted me to try it out and explore some of the features it had to offer.

Harry Fisher https://hfshr.netlify.com/
05-02-2020

gt (Iannone, Cheng, and Schloerke 2020) has been under development for a while, but a stable version has recently been released to CRAN. In order to try the package out we first need some data for creating tables. I’ll be using some Bitcoin price data (shameless self plug for my bitmexr (Fisher 2020) package that has just landed on CRAN - check it out here).

For demonstration purposes, I pulled the OHLC prices for the last 10 days.

bitcoin <- bucket_trades(
  binSize = "1d",
  startTime = "2020-04-23",
  endTime = "2020-05-02"
) %>%
  select(1:8) %>%
  select(-symbol)


head(bitcoin)

   timestamp   open   high    low  close trades     volume
1 2020-04-23 6848.5 7189.0 6822.0 7133.5 572398 1450803027
2 2020-04-24 7133.5 7802.0 7023.5 7492.0 935125 2488032747
3 2020-04-25 7492.0 7610.0 7380.0 7503.5 621057 1473830307
4 2020-04-26 7503.5 7745.0 7431.0 7542.0 641738 1362595381
5 2020-04-27 7542.0 7720.0 7450.0 7702.5 674889 1432590477
6 2020-04-28 7702.5 7836.5 7625.0 7788.0 811266 1663495897

The most basic table without any formatting applied looks like this:

bitcoin %>%
  gt()
timestamp open high low close trades volume
2020-04-23 6848.5 7189.0 6822.0 7133.5 572398 1450803027
2020-04-24 7133.5 7802.0 7023.5 7492.0 935125 2488032747
2020-04-25 7492.0 7610.0 7380.0 7503.5 621057 1473830307
2020-04-26 7503.5 7745.0 7431.0 7542.0 641738 1362595381
2020-04-27 7542.0 7720.0 7450.0 7702.5 674889 1432590477
2020-04-28 7702.5 7836.5 7625.0 7788.0 811266 1663495897
2020-04-29 7788.0 7795.5 7651.0 7752.0 520240 1154456663
2020-04-30 7752.0 8978.0 7706.0 8794.0 2384499 5110631297
2020-05-01 8794.0 9481.0 8407.0 8627.5 3661752 5794365072
2020-05-02 8627.5 9065.0 8622.5 8832.0 2085264 2573647732

To get started, I borrowed some ideas straight from an example on https://gt.rstudio.com/ and applied some simple formatting to the raw data in the table.

start_date <- format(min(bitcoin$timestamp), "%d/%m/%Y")
end_date <- format(max(bitcoin$timestamp), "%d/%m/%Y")

tab <- bitcoin %>%
  mutate(timestamp = as.character(timestamp)) %>%
  gt() %>%
  tab_header(
    title = md("**Bitcoin price**"),
    subtitle = glue::glue("{start_date} to {end_date}")
  ) %>%
  fmt_currency(
    columns = vars(open, high, low, close),
    currency = "USD"
  ) %>%
  fmt_number(
    columns = vars(trades, volume),
    suffixing = TRUE
  ) %>%
  fmt_date(
    columns = vars(timestamp),
    date_style = 9
  )

tab
Bitcoin price
23/04/2020 to 02/05/2020
timestamp open high low close trades volume
23 April $6,848.50 $7,189.00 $6,822.00 $7,133.50 572.40K 1.45B
24 April $7,133.50 $7,802.00 $7,023.50 $7,492.00 935.12K 2.49B
25 April $7,492.00 $7,610.00 $7,380.00 $7,503.50 621.06K 1.47B
26 April $7,503.50 $7,745.00 $7,431.00 $7,542.00 641.74K 1.36B
27 April $7,542.00 $7,720.00 $7,450.00 $7,702.50 674.89K 1.43B
28 April $7,702.50 $7,836.50 $7,625.00 $7,788.00 811.27K 1.66B
29 April $7,788.00 $7,795.50 $7,651.00 $7,752.00 520.24K 1.15B
30 April $7,752.00 $8,978.00 $7,706.00 $8,794.00 2.38M 5.11B
1 May $8,794.00 $9,481.00 $8,407.00 $8,627.50 3.66M 5.79B
2 May $8,627.50 $9,065.00 $8,622.50 $8,832.00 2.09M 2.57B

Starting to look a little more presentable. Next, I

A cool feature of gt is that you can rename the column labels to something different, but refer to the original labels for any further manipulation.

tab <- tab %>%
  tab_spanner(
    label = "Price",
    columns = vars(open, high, low, close)
  ) %>%
  data_color(
    columns = vars(trades, volume),
    colors = scales::col_numeric("Greens", domain = NULL)
  ) %>%
  cols_align(
    align = "center",
    columns = vars(trades, volume)
  ) %>%
  cols_label(
    timestamp = "Date",
    open = md("**Open**"),
    high = "High",
    low = "Low",
    close = md("**Close**"),
    trades = "Trades",
    volume = "Volume"
  ) %>%
  fmt_currency(
    columns = vars(open, high, low, close),
    currency = "USD",
    decimals = 0
  )


tab
Bitcoin price
23/04/2020 to 02/05/2020
Date Price Trades Volume
Open High Low Close
23 April $6,848 $7,189 $6,822 $7,134 572.40K 1.45B
24 April $7,134 $7,802 $7,024 $7,492 935.12K 2.49B
25 April $7,492 $7,610 $7,380 $7,504 621.06K 1.47B
26 April $7,504 $7,745 $7,431 $7,542 641.74K 1.36B
27 April $7,542 $7,720 $7,450 $7,702 674.89K 1.43B
28 April $7,702 $7,836 $7,625 $7,788 811.27K 1.66B
29 April $7,788 $7,796 $7,651 $7,752 520.24K 1.15B
30 April $7,752 $8,978 $7,706 $8,794 2.38M 5.11B
1 May $8,794 $9,481 $8,407 $8,628 3.66M 5.79B
2 May $8,628 $9,065 $8,622 $8,832 2.09M 2.57B

Finally, it is also very easy to add custom html to the tables using the text_transformations() function (again inspired by https://gt.rstudio.com/). The rocket and sad face indicate whether the closing price was greater or less than the opening price for each dat

rocket <- "<span style=\"color:green\">&#128640;</span>"
sadface <- "<span style=\"color:red\">&#128546;</span>"

tab <- tab %>%
  text_transform(
    locations = cells_body(
      columns = "close",
      rows = close > open
    ),
    fn = function(x) paste(x, rocket)
  ) %>%
  text_transform(
    locations = cells_body(
      columns = "close",
      rows = close < open
    ),
    fn = function(x) paste(x, sadface)
  )

tab
Bitcoin price
23/04/2020 to 02/05/2020
Date Price Trades Volume
Open High Low Close
23 April $6,848 $7,189 $6,822 $7,134 🚀 572.40K 1.45B
24 April $7,134 $7,802 $7,024 $7,492 🚀 935.12K 2.49B
25 April $7,492 $7,610 $7,380 $7,504 🚀 621.06K 1.47B
26 April $7,504 $7,745 $7,431 $7,542 🚀 641.74K 1.36B
27 April $7,542 $7,720 $7,450 $7,702 🚀 674.89K 1.43B
28 April $7,702 $7,836 $7,625 $7,788 🚀 811.27K 1.66B
29 April $7,788 $7,796 $7,651 $7,752 😢 520.24K 1.15B
30 April $7,752 $8,978 $7,706 $8,794 🚀 2.38M 5.11B
1 May $8,794 $9,481 $8,407 $8,628 😢 3.66M 5.79B
2 May $8,628 $9,065 $8,622 $8,832 🚀 2.09M 2.57B

Looks good! I’ve barely scratched the surface of what gt can do here and the package website is well worth a look if you are interested.

Bonus table

One experimental feature in gt is the ability to add a ggplot (or any image for that matter) to a table. Yes thats right, a ggplot in a table. I did have to do a bit of rummaging in the package repo to get this to work, but the idea is really cool.

To demonstrate this functionality I pulled some new Bitcoin price data - the hourly OHLC for the whole on April 2020. The goal is to summarise this information for weekly intervals, with the total volume and trades and a plot of the price action for that week.

First I define a few functions that will help in creating the table/plot combo.

# helper for summary data
oc <- function(name, df) {
  df %>%
    summarise(
      open = dplyr::first(open),
      close = dplyr::last(close),
      volume = sum(volume),
      trades = sum(trades),
      date = dplyr::first(timestamp)
    )
}

# ggplot for each week
plot_group <- function(name, df) {
  plot_object <-
    ggplot(
      data = df,
      aes(x = timestamp, y = close)
    ) +
    geom_barchart(
      aes(open = open, high = high, low = low, close = close),
      fill_up = "green",
      fill_down = "red",
      colour_up = "green",
      colour_down = "red"
    ) +
    theme_minimal() +
    theme(
      legend.position = "none",
      axis.title = element_blank(),
      axis.text = element_blank()
    )
  return(plot_object)
}

# combine ggplot within table
fmt_ggplot <- fmt_gg <- function(
  data,
  columns,
  rows = NULL,
  height = 100,
  aspect_ratio = 1.0
) {
  rows <- rlang::enquo(rows)

  fmt(
    data = data,
    columns = columns,
    rows = !!rows,
    fns = list(
      html = function(x) {
        map(
          x,
          ggplot_image,
          height = height,
          aspect_ratio = aspect_ratio
        )
      }
    )
  )
}

  1. The first is just a simple helper function which generates some summary information for the final table

  2. The second is the ggplot object that will be used to visualise each weeks data.

  3. The third was borrowed straight from gt’s repo here. I think some of this functionality is still under development, so is not yet available in the CRAN release.

We’re now ready to prepare the data for the table.

newdata <- map_bucket_trades(
  start_date = "2020-04-01",
  end_date = "2020-04-28",
  binSize = "1h"
) %>%
  mutate(week = lubridate::week(timestamp)) %>%
  select(week, timestamp, open, high, low, close, volume, trades) %>%
  group_by(week) %>%
  nest() %>%
  mutate(
    plot = map2(week, data, plot_group),
    info = map2(week, data, oc)
  ) %>%
  unnest(info)

head(newdata)

# A tibble: 4 x 8
# Groups:   week [4]
   week data     plot    open close  volume trades date               
  <dbl> <list>   <list> <dbl> <dbl>   <dbl>  <int> <dttm>             
1    14 <tibble… <gg>   6440. 7166  1.45e10 5.35e6 2020-04-01 00:00:00
2    15 <tibble… <gg>   7166  6880. 1.21e10 4.67e6 2020-04-08 00:00:00
3    16 <tibble… <gg>   6880. 6898. 1.20e10 4.24e6 2020-04-15 00:00:00
4    17 <tibble… <gg>   6898. 7788  9.93e 9 4.28e6 2020-04-22 00:00:00

Now the data is ready, we can make the table.

newdata %>%
  ungroup() %>%
  select(date, volume, trades, open, close, plot) %>%
  mutate(date = as.character(date)) %>%
  gt() %>%
  fmt_ggplot(
    columns = vars(plot),
    height = 170,
    aspect_ratio = 1
  ) %>%
  fmt_number(
    columns = vars(trades, volume),
    suffixing = TRUE
  ) %>%
  fmt_date(
    columns = vars(date),
    date_style = 8
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  fmt_currency(
    columns = vars(open, close)
  ) %>%
  tab_header(
    title = md("**Price action summary for April 2020**")
  ) %>%
  cols_label(
    date = "Week beginning",
    open = "Open",
    close = "Close",
    trades = "Trades",
    volume = "Volume",
    plot = "Price action"
  ) %>%
  tab_spanner(
    label = "Summary",
    columns = vars(volume, trades, open, close)
  )
Price action summary for April 2020
Week beginning Summary Price action
Volume Trades Open Close
1 April 2020 14.53B 5.35M $6,440.50 $7,166.00
8 April 2020 12.10B 4.67M $7,166.00 $6,880.50
15 April 2020 12.03B 4.24M $6,880.50 $6,897.50
22 April 2020 9.93B 4.28M $6,897.50 $7,788.00

Pretty cool! The possibilities are endless with this and it was good fun trying to get it to work.

Fisher, Harry. 2020. Bitmexr: R Client for BitMEX. https://CRAN.R-project.org/package=bitmexr.
Iannone, Richard, Joe Cheng, and Barret Schloerke. 2020. Gt: Easily Create Presentation-Ready Display Tables. https://github.com/rstudio/gt.

References

Reuse

Text and figures are licensed under Creative Commons Attribution CC BY 4.0. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".

Citation

For attribution, please cite this work as

Fisher (2020, May 2). Data, Code & Coffee: Pretty tables with {gt}. Retrieved from https://hfshr.xyz/posts/2020-05-02-pretty-tables-with-gt/

BibTeX citation

@misc{fisher2020pretty,
  author = {Fisher, Harry},
  title = {Data, Code & Coffee: Pretty tables with {gt}},
  url = {https://hfshr.xyz/posts/2020-05-02-pretty-tables-with-gt/},
  year = {2020}
}

Built with Netlify, R markdown and Distill by RStudio