Pretty tables with {gt}.

Bitcoin

ggplot

bitmexr

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.

Published

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.

Added a header containing the title and subtitle of the table
Format the price columns with the appropriate currency symbol
Format the date column
Format the trades and volume column with appropriate suffixes

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
  )

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

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

Added some colour to highlight changes in the trades and volume columns
Applied some formatting to the column names.
I also changed the number of decimal places to 0 (2 decimal places seemd overkill for this example).

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
  )

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

tab

Bitcoin price
23/04/2020 to 02/05/2020
Date	Price				Trades	Volume
Date	Open	High	Low	Close	Trades	Volume
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
Date	Open	High	Low	Close	Trades	Volume
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
        )
      }
    )
  )
}

The first is just a simple helper function which generates some summary information for the final table
The second is the ggplot object that will be used to visualise each weeks data.
~~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.~~

2022 update: It is now much easier to support ggplot objects in gt tables! See here

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 × 8
# Groups:   week [4]
   week data               plot    open close  volume trades date               
  <dbl> <list>             <list> <dbl> <dbl>   <dbl>  <int> <dttm>             
1    14 <tibble [168 × 7]> <gg>   6440. 7166  1.45e10 5.35e6 2020-04-01 00:00:00
2    15 <tibble [168 × 7]> <gg>   7166  6880. 1.21e10 4.67e6 2020-04-08 00:00:00
3    16 <tibble [168 × 7]> <gg>   6880. 6898. 1.20e10 4.24e6 2020-04-15 00:00:00
4    17 <tibble [145 × 7]> <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() %>%
  text_transform(
    locations = cells_body(columns = plot),
    fn = function(x) {
      newdata$plot %>% 
        ggplot_image(height = px(200))
    }
  ) %>%
  fmt_number(
    columns = c(trades, volume),
    suffixing = TRUE
  ) %>%
  fmt_date(
    columns = c(date),
    date_style = 8
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  fmt_currency(
    columns = c(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 = c(volume, trades, open, close)
  )

Price action summary for April 2020
Week beginning	Summary				Price action
Week beginning	Volume	Trades	Open	Close	Price action
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.

References

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.