gt cookbook - advanced

A cookbook of advanced examples with extending {gt}
Author

Tom Mock

Introduction

This cookbook attempts to walk through many of the advanced applications for gt, and provide useful commentary around the use of the various gt functions. The full gt documentation has other more succinct examples and full function arguments.

For more introductory use cases, make sure to check out the {gt} Cookbook

Many of these examples rely on some working knowledge of:

  • HTML
  • CSS
  • Functional Programming
  • purrr and or apply

I am a big fan the Mozilla MDN Web Docs for learning more about how to code up the web with front-end developement. They have sections on general reference material, Tutorials, and Developer Guides.

As far as functional programming and purrr, I suggest checking out R4DS Functions Chapter, R4DS Iteration chapter, and Advanced R’s Function chapter, and lastly the Learn to purrr guide by Rebecca Barter.

Custom CSS

For more control over styling, you can add custom class names to the table and apply your own CSS. Note that this can require more effort than the built in gt functions, but also allows some things that aren’t possible by the functions align (like hover highlighting!).

 exibble %>%
  dplyr::select(num, currency) %>%
  gt(id = "one") %>% # need to name the table so that you can apply CSS
  fmt_currency(
    columns = vars(currency),
    currency = "HKD"
  ) %>%
  fmt_scientific(
    columns = vars(num)
  ) %>%
  opt_css(
    css = "
    #one .gt_table {
      background-color: lightgrey;
    }
    #one .gt_row {
      padding: 20px 30px;
    }
    #one tr:hover {
    background-color: #f5f8ff;
    }
    #one .gt_col_heading {
      text-align: center !important;
    }
    "
  )
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
num currency
1.11 × 10−1 HK$49.95
2.22 HK$17.95
3.33 × 101 HK$1.39
4.44 × 102 HK$65,100.00
5.55 × 103 HK$1,325.81
NA HK$13.26
7.77 × 105 NA
8.88 × 106 HK$0.44

The examples here embed CSS for demonstration, but it’s often better to put CSS in an external style sheet. You can learn more about adding custom CSS to R Markdown documents here, or to Shiny apps here.

Parse arbitrary HTML

Because gt supports HTML, you can also optionally “create” HTML strings prior to passing them into gt proper.

color_span <- function(x){paste0("<span style='color: ", x, ";'>", x, "</span>")}

data.frame(
  count = c(1L, 2L, 3L, 4L, 5L),
  weight_g = c(150.65, 149.65, 171.28, 142.58, 139.04),
  color = c("green", "yellow", "yellow", "green", "yellow")
) %>% 
  mutate(color = color_span(color)) %>% 
  mutate(color = purrr::map(color, gt::html)) %>% 
  gt()
count weight_g color
1 150.65 green
2 149.65 yellow
3 171.28 yellow
4 142.58 green
5 139.04 yellow

Embed URLs

You can also use things like htmltools or glue to arbitrarily build HTML content like hyperlinks.

library(htmltools)
ex_sites <- data.frame(
  Address = c("https://google.com", "https://yahoo.com", "https://duckduckgo.com"),
  Site = c("Google", "Yahoo", "DuckDuckGo")
)
gt(ex_sites) %>% 
  text_transform(
    locations = cells_body(columns = vars(Address)),
    fn = function(x) {
    purrr::map(x,  ~htmltools::tags$a(href = .x, target = "_blank", .x))
      }
  ) %>% 
  text_transform(
    locations = cells_body(columns = vars(Site)),
    fn = function(x) {
    purrr::map2(
      .x = x, .y = ex_sites$Address, 
      .f = ~glue::glue('<a href="{.y}" target="_blank">{.x}</a>'))
      }
  )
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
Address Site
https://google.com Google
https://yahoo.com Yahoo
https://duckduckgo.com DuckDuckGo

Embed data

While gt tables can be beautiful, it’s often best to also include the raw data for download. You can see how to do this with Markdown or HTML thanks to Bob Rudis’ example.

write.csv2(mtcars, "./file.csv")

encoded <- readLines("./file.csv") %>% 
  paste0(collapse="\n") %>% 
  openssl::base64_encode() -> encoded

The raw markdown could be embedded in a Shiny app or RMarkdown document as seen below.

[Download CSV](data:text/csv;base64,IiI7Im1wZyI7ImN5bCI7ImRpc3AiOyJocCI7ImRyYXQiOyJ3dCI7InFzZWMiOyJ2cyI7ImFtIjsiZ2VhciI7ImNhcmIiCiJNYXpkYSBSWDQiOzIxOzY7MTYwOzExMDszLDk7Miw2MjsxNiw0NjswOzE7NDs0CiJNYXpkYSBSWDQgV2FnIjsyMTs2OzE2MDsxMTA7Myw5OzIsODc1OzE3LDAyOzA7MTs0OzQKIkRhdHN1biA3MTAiOzIyLDg7NDsxMDg7OTM7Myw4NTsyLDMyOzE4LDYxOzE7MTs0OzEKIkhvcm5ldCA0IERyaXZlIjsyMSw0OzY7MjU4OzExMDszLDA4OzMsMjE1OzE5LDQ0OzE7MDszOzEKIkhvcm5ldCBTcG9ydGFib3V0IjsxOCw3Ozg7MzYwOzE3NTszLDE1OzMsNDQ7MTcsMDI7MDswOzM7MgoiVmFsaWFudCI7MTgsMTs2OzIyNTsxMDU7Miw3NjszLDQ2OzIwLDIyOzE7MDszOzEKIkR1c3RlciAzNjAiOzE0LDM7ODszNjA7MjQ1OzMsMjE7Myw1NzsxNSw4NDswOzA7Mzs0CiJNZXJjIDI0MEQiOzI0LDQ7NDsxNDYsNzs2MjszLDY5OzMsMTk7MjA7MTswOzQ7MgoiTWVyYyAyMzAiOzIyLDg7NDsxNDAsODs5NTszLDkyOzMsMTU7MjIsOTsxOzA7NDsyCiJNZXJjIDI4MCI7MTksMjs2OzE2Nyw2OzEyMzszLDkyOzMsNDQ7MTgsMzsxOzA7NDs0CiJNZXJjIDI4MEMiOzE3LDg7NjsxNjcsNjsxMjM7Myw5MjszLDQ0OzE4LDk7MTswOzQ7NAoiTWVyYyA0NTBTRSI7MTYsNDs4OzI3NSw4OzE4MDszLDA3OzQsMDc7MTcsNDswOzA7MzszCiJNZXJjIDQ1MFNMIjsxNywzOzg7Mjc1LDg7MTgwOzMsMDc7Myw3MzsxNyw2OzA7MDszOzMKIk1lcmMgNDUwU0xDIjsxNSwyOzg7Mjc1LDg7MTgwOzMsMDc7Myw3ODsxODswOzA7MzszCiJDYWRpbGxhYyBGbGVldHdvb2QiOzEwLDQ7ODs0NzI7MjA1OzIsOTM7NSwyNTsxNyw5ODswOzA7Mzs0CiJMaW5jb2xuIENvbnRpbmVudGFsIjsxMCw0Ozg7NDYwOzIxNTszOzUsNDI0OzE3LDgyOzA7MDszOzQKIkNocnlzbGVyIEltcGVyaWFsIjsxNCw3Ozg7NDQwOzIzMDszLDIzOzUsMzQ1OzE3LDQyOzA7MDszOzQKIkZpYXQgMTI4IjszMiw0OzQ7NzgsNzs2Njs0LDA4OzIsMjsxOSw0NzsxOzE7NDsxCiJIb25kYSBDaXZpYyI7MzAsNDs0Ozc1LDc7NTI7NCw5MzsxLDYxNTsxOCw1MjsxOzE7NDsyCiJUb3lvdGEgQ29yb2xsYSI7MzMsOTs0OzcxLDE7NjU7NCwyMjsxLDgzNTsxOSw5OzE7MTs0OzEKIlRveW90YSBDb3JvbmEiOzIxLDU7NDsxMjAsMTs5NzszLDc7Miw0NjU7MjAsMDE7MTswOzM7MQoiRG9kZ2UgQ2hhbGxlbmdlciI7MTUsNTs4OzMxODsxNTA7Miw3NjszLDUyOzE2LDg3OzA7MDszOzIKIkFNQyBKYXZlbGluIjsxNSwyOzg7MzA0OzE1MDszLDE1OzMsNDM1OzE3LDM7MDswOzM7MgoiQ2FtYXJvIFoyOCI7MTMsMzs4OzM1MDsyNDU7Myw3MzszLDg0OzE1LDQxOzA7MDszOzQKIlBvbnRpYWMgRmlyZWJpcmQiOzE5LDI7ODs0MDA7MTc1OzMsMDg7Myw4NDU7MTcsMDU7MDswOzM7MgoiRmlhdCBYMS05IjsyNywzOzQ7Nzk7NjY7NCwwODsxLDkzNTsxOCw5OzE7MTs0OzEKIlBvcnNjaGUgOTE0LTIiOzI2OzQ7MTIwLDM7OTE7NCw0MzsyLDE0OzE2LDc7MDsxOzU7MgoiTG90dXMgRXVyb3BhIjszMCw0OzQ7OTUsMTsxMTM7Myw3NzsxLDUxMzsxNiw5OzE7MTs1OzIKIkZvcmQgUGFudGVyYSBMIjsxNSw4Ozg7MzUxOzI2NDs0LDIyOzMsMTc7MTQsNTswOzE7NTs0CiJGZXJyYXJpIERpbm8iOzE5LDc7NjsxNDU7MTc1OzMsNjI7Miw3NzsxNSw1OzA7MTs1OzYKIk1hc2VyYXRpIEJvcmEiOzE1Ozg7MzAxOzMzNTszLDU0OzMsNTc7MTQsNjswOzE7NTs4CiJWb2x2byAxNDJFIjsyMSw0OzQ7MTIxOzEwOTs0LDExOzIsNzg7MTgsNjsxOzE7NDsy)

Or you can embed it as HTML using the html_csv object as seen above/below.

html_encode <- sprintf('data:text/csv;base64,%s', encoded)
html_csv <- glue::glue(
  "<a download='mtcars.csv' href='{html_encode}'>CSV Download</a>"
  )

head(mtcars) %>% 
  gt() %>% 
  tab_source_note(html(html_csv))
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1
CSV Download


You can make this process a bit easier with the downloadthis R package. It supports csv, Excel and even .rds files! It also takes care of the “download button”, and supports Bootstrap button styles. H/t to Kyle Cuilla for the suggestion and Jonathan Regenstein for the ask of how to do this.

library(downloadthis)

head(mtcars) %>%
  gt() %>%
  tab_source_note(
    mtcars %>%
      download_this(
        output_name = "mtcars",
        output_extension = ".csv", # CSV output
        button_label = "Download csv",
        button_type = "default",
      )
  )
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1


You can specify the file/output extension, and the button type to alter the appearance. Note that the code works inline as seen above, or defined in an external object as seen below.

attach_excel <- mtcars %>%
  download_this(
    output_name = "mtcars",
    output_extension = ".xlsx", # Excel file type
    button_label = "Download Excel",
    button_type = "primary", # change button type
  )

head(mtcars) %>%
  gt() %>%
  tab_source_note(attach_excel)
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1


You can continue and go one step farther by adding custom styling CSS to the table to affect the button style.

attach_excel <- mtcars %>%
  download_this(
    output_name = "mtcars",
    output_extension = ".xlsx", # Excel file type
    button_label = "Download Excel",
    class = "buttonExcel"
  )

head(mtcars) %>%
  gt() %>%
  opt_css(
    css = "
    .buttonExcel{
    font-size: 12px;
    color: #fff;
    background-color: black;
    border-color: black;
    font-weight: bold;
    border-radius: 10px;
    padding: 4px;
    }
    
    .buttonExcel:hover,
    .buttonExcel:active,
    .buttonExcel:focus,
    .buttonExcel.active {
    background: grey;
    color: #ffffff;
    border-color: grey;
    }
    "
  ) %>% 
  tab_source_note(attach_excel)
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Combine and stack

Combine text into div containers and then “stack” the text on top of each other with alternating color.

stack_function <- function(x){
  
  name <- sub(x = x, pattern = " .*$", replacement = "")
  model <- sub(x = x, pattern = ".*? ", replacement = "")

  
  glue::glue(
    "<div style='line-height:10px'>
    <span style='font-weight:bold;font-variant:small-caps;font-size:14px'>
    {name}</div>
    <div style='line-height:12px'>
    <span style ='font-weight:bold;color:grey;font-size:10px'>
    {model}</span></div>"
  )
    }

head(gtcars) %>% 
  dplyr::select(mfr, model, year, trim, hp) %>%
  gt() %>% 
  cols_merge(
    columns = vars(mfr, model)
  ) %>% 
  text_transform(
    locations = cells_body(
      columns = vars(mfr)
    ),
    fn = stack_function
  ) %>% 
  tab_options(
    data_row.padding = px(5),
  )
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
mfr year trim hp
Ford
GT
2017 Base Coupe 647
Ferrari
458 Speciale
2015 Base Coupe 597
Ferrari
458 Spider
2015 Base 562
Ferrari
458 Italia
2014 Base Coupe 562
Ferrari
488 GTB
2016 Base Coupe 661
Ferrari
California
2015 Base Convertible 553

Align symbol on first row only

We can align text on the first row only even with a suffix (ie symbol at the end). This can be done with just gt, but it’s a bit verbose.

This example applies a percent label to the hp_pct column and properly maintains the decimal place alignment.

head(gtcars) %>%
  mutate(hp_pct = (hp/max(hp) * 100)) %>% 
  dplyr::select(mfr, model, year, trim, hp, hp_pct) %>%
  gt() %>%
  # use a mono-spaced font
  tab_style(
    style = cell_text(font = google_font("Fira Mono")),
    locations = cells_body(columns = vars(hp_pct))
    ) %>% 
  # align the column of interst to right
  cols_align(align = "right", columns = vars(hp_pct)) %>% 
  # round and transform the first row to percent
  text_transform(
    locations = cells_body(vars(hp_pct), rows = 1),
    fn = function(x){ 
      fmt_val <- format(as.double(x), nsmall = 1, digits = 1)
      paste0(fmt_val, "%") %>% gt::html()}
  ) %>% 
  text_transform(
    locations = cells_body(vars(hp_pct), rows = 2:6),
    fn = function(x){ 
      # round remaining rows, add a non-breaking space
     fmt_val <- format(as.double(x), nsmall = 1, digits = 1)
     lapply(fmt_val, function(x) paste0(x, '&nbsp') %>% gt::html())
  })
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