Embedding custom HTML in gt tables

gt loves HTML

gt really does love HTML, and for now, gt is HTML-first which is great since HTML can do SOO many things in R Markdown, shiny, and elsewhere.

A gt table can always be saved as an .png or .pdf file if you need to incorporate it in non-HTML content. Lastly, gt does have preliminary support for RTF, and could export to a PDF via gtsave().

gt allows for HTML to be incorporated in MANY different locations with gt::html(). For example, we can use a <span style> to color the title for this table, and another <span style> to change the font size and weight for one off column. This really just scratches the surface of what is possible, and mostly you are free to use a lot of your creativity in building these tables.

As a note - it’s worth learning a bit more about how HTML works, as it will help with building R Markdown content, shiny, your personal website, and the syntax is used in the ggtext package, so it’ll help with ggplot2 as well! For a lot of this we’re nesting HTML, things should really just work, BUT if you run into problems getting some HTML content to export into content, you can try a R Markdown chunk with results='asis', along with gt() %>% as_raw_html(inline_css = TRUE).

Also, if you want to learn a bit more CSS/HTML to adjust tables beyond what I’ve shown below - check out either Mozilla Docs or the W3schools.

nfl_qbr <- espnscrapeR::get_nfl_qbr(2020) %>% 
  slice(1:10)

Scraping QBR totals for 2020!

ex_tab <- nfl_qbr %>% 
  select(rank, name_last, team, qbr_total, qb_plays, pass, run) %>% 
  gt() %>% 
  tab_header(
    title = gt::html("<span style='color:red'>ESPN's QBR for 2020</span>")
  ) %>% 
  cols_label(
    qbr_total = gt::html(
      "<span style ='font-weight:bold;font-size:20px'>QBR</span>")
  )
ex_tab

ESPN's QBR for 2020
rank	name_last	team	QBR	qb_plays	pass	run
1	Rodgers	Packers	79.8	608	98.4	9.3
2	Mahomes	Chiefs	78.1	710	116.1	19.1
3	Allen	Bills	76.6	729	112.1	13.0
4	Tannehill	Titans	72.6	594	68.2	22.1
5	Fitzpatrick	Dolphins	70.9	324	41.6	5.6
6	Brees	Saints	68.3	428	62.5	1.0
7	Jackson	Ravens	67.3	585	50.9	30.8
8	Wilson	Seahawks	67.1	716	88.6	9.1
9	Brady	Buccaneers	66.0	681	90.4	-3.1
10	Mayfield	Browns	65.5	597	76.9	3.3

More HTML!

So that’s cool to see where things can be changed, but let’s walk through a bit more engaging example. Here we’re going to merge some columns for the Player’s last name + team.

ex_tab <- nfl_qbr %>% 
  select(rank, name_last, team, qbr_total, qb_plays, pass, run) %>% 
  gt() 

ex_tab %>%
  cols_merge(
    columns = vars(name_last, team)
  )

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

rank	name_last	qbr_total	qb_plays	pass	run
1	Rodgers Packers	79.8	608	98.4	9.3
2	Mahomes Chiefs	78.1	710	116.1	19.1
3	Allen Bills	76.6	729	112.1	13.0
4	Tannehill Titans	72.6	594	68.2	22.1
5	Fitzpatrick Dolphins	70.9	324	41.6	5.6
6	Brees Saints	68.3	428	62.5	1.0
7	Jackson Ravens	67.3	585	50.9	30.8
8	Wilson Seahawks	67.1	716	88.6	9.1
9	Brady Buccaneers	66.0	681	90.4	-3.1
10	Mayfield Browns	65.5	597	76.9	3.3

This saves us some space since we’re dropping a column, but isn’t the prettiest thing. Let’s use an anonymous function and text_transform to change the styling of our player’s name/team with <span style> along with small caps, different font colors and sizes.

ex_tab %>%
  cols_merge(
    columns = vars(name_last, team)
  ) %>% 
  text_transform(
    locations = cells_body(
      columns = vars(name_last)
    ),
    fn = function(x){
      name <- word(x, 1)
      team <- word(x, -1)
      glue::glue(
        "<div><span style='font-weight:bold;font-variant:small-caps;font-size:14px'>{name}</div>
        <div><span style ='font-weight:bold;color:grey;font-size:10px'>{team}</span></div>"
      )
    }
  )

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

rank	name_last	qbr_total	qb_plays	pass	run
1	Rodgers Packers	79.8	608	98.4	9.3
2	Mahomes Chiefs	78.1	710	116.1	19.1
3	Allen Bills	76.6	729	112.1	13.0
4	Tannehill Titans	72.6	594	68.2	22.1
5	Fitzpatrick Dolphins	70.9	324	41.6	5.6
6	Brees Saints	68.3	428	62.5	1.0
7	Jackson Ravens	67.3	585	50.9	30.8
8	Wilson Seahawks	67.1	716	88.6	9.1
9	Brady Buccaneers	66.0	681	90.4	-3.1
10	Mayfield Browns	65.5	597	76.9	3.3

This is starting to look better! However, since we stacked it, the rows are very tall, a bit too tall in my opinion. We can use line-height inside the <div> now to decrease the vertical space between our words.

ex_tab %>%
  cols_merge(
    columns = vars(name_last, team)
  ) %>% 
  text_transform(
    locations = cells_body(
      columns = vars(name_last)
    ),
    fn = function(x){
      name <- word(x, 1)
      team <- word(x, -1)
      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'>{team}</span></div>"
      )
    }
  ) %>% 
  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

rank	name_last	qbr_total	qb_plays	pass	run
1	Rodgers Packers	79.8	608	98.4	9.3
2	Mahomes Chiefs	78.1	710	116.1	19.1
3	Allen Bills	76.6	729	112.1	13.0
4	Tannehill Titans	72.6	594	68.2	22.1
5	Fitzpatrick Dolphins	70.9	324	41.6	5.6
6	Brees Saints	68.3	428	62.5	1.0
7	Jackson Ravens	67.3	585	50.9	30.8
8	Wilson Seahawks	67.1	716	88.6	9.1
9	Brady Buccaneers	66.0	681	90.4	-3.1
10	Mayfield Browns	65.5	597	76.9	3.3

While we did that ALL within gt, we could also have made similar changes by writing some HTML with functions inside mutate ahead of sending it to gt!

# function to incorporate player name + team
combine_word <- function(name, team){
      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'>{team}</span></div>"
      )
    }

nfl_qbr %>% 
  select(rank, name_short, team, qbr_total, qb_plays, pass, run) %>% 
  mutate(
    combo = combine_word(name_short, team),
    combo = map(combo, gt::html)
    ) %>% 
  select(rank, combo, everything(), -name_short, -team) %>% 
  gt() %>% 
  cols_align(
    align = "left",
    columns = vars(combo)
  ) %>% 
  tab_options(
    data_row.padding = px(5)
  )

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

rank	combo	qbr_total	qb_plays	pass	run
1	A. Rodgers Packers	79.8	608	98.4	9.3
2	P. Mahomes Chiefs	78.1	710	116.1	19.1
3	J. Allen Bills	76.6	729	112.1	13.0
4	R. Tannehill Titans	72.6	594	68.2	22.1
5	R. Fitzpatrick Dolphins	70.9	324	41.6	5.6
6	D. Brees Saints	68.3	428	62.5	1.0
7	L. Jackson Ravens	67.3	585	50.9	30.8
8	R. Wilson Seahawks	67.1	716	88.6	9.1
9	T. Brady Buccaneers	66.0	681	90.4	-3.1
10	B. Mayfield Browns	65.5	597	76.9	3.3

So that’s really cool and allows you to do some creative things with HTML-based content. What else can we do with HTML?

kableExtra integration

The fantastic kableExtra package has some sparkline-esque graphing capabilities that export as SVG, meaning they can be integrated into HTML.

Note that while I love gt, kableExtra is again a great package in it’s own right and has more mature LaTeX integration today. If you REALLY have to use PDF/LaTex, it’s a great choice today.

kableExtra approaches inline plots with the spec_plot() family of functions.

kableExtra example

Here’s a quick example from kableExtra, which can be adapted to work in gt, mainly incorporating an inline boxplot into the table.

library(kableExtra)
library(gt)
library(tidyverse)

kableExtra method, adapted from the great guide by Hao Zhu.

# first split the data by cylinders
mpg_list <- split(mtcars$mpg, mtcars$cyl)

mpg_list

$`4`
 [1] 22.8 24.4 22.8 32.4 30.4 33.9 21.5 27.3 26.0 30.4 21.4

$`6`
[1] 21.0 21.0 21.4 18.1 19.2 17.8 19.7

$`8`
 [1] 18.7 14.3 16.4 17.3 15.2 10.4 10.4 14.7 15.5 15.2 13.3 19.2 15.8 15.0

# pipe the 
data.frame(
  cyl = c(4,6,8),
  boxplot = ""
  ) %>% 
  kbl(booktabs = TRUE) %>%
  kable_paper(full_width = FALSE) %>%
  column_spec(2, image = spec_boxplot(mpg_list, width = 300, height = 70))

cyl	boxplot
4
6
8

gt + kableExtra

We can adapt a similar idea for gt, here we are using mutate calls ahead of time to prep the data. Here we are going to keep all the data in a pipe, rather than having to split it and reference a dataset external to our table. We can essentially nest the same mpg column by group, keeping it in a single tibble this time. As an aside, note that you can embed ANY ggplot into gt with gt::ggplot_image(), but the ggplot_image() method is quite a bit slower as of today. If you need the full power of ggplot it’s totally worth it, but if you’re just adding sparklines I’m a big fan of kableExtra::spec_plot().

mtcars %>% 
  group_by(cyl) %>% 
  summarize(data = list(mpg), .groups = "drop")

# A tibble: 3 × 2
    cyl data      
  <dbl> <list>    
1     4 <dbl [11]>
2     6 <dbl [7]> 
3     8 <dbl [14]>

Then we can create a range to set baselines for MPG, and then use kableExtra::spec_plot() to embed an inline sparkline. Note we have to use purrr::map() here to apply the function iteratively across each row.

mpg_rng <- range(mtcars$mpg)

mtcars %>% 
  group_by(cyl) %>% 
  summarize(data = list(mpg), .groups = "drop") %>% 
  mutate(
    plot = map(data, ~spec_plot(.x, ylim = mpg_rng, same_lim = TRUE, width = 300, height = 70)),
    plot = map(plot, "svg_text"),
    plot = map(plot, gt::html)
    ) %>% 
  select(-data) %>% 
  gt()

cyl	plot
4
6
8

Now that I’ve showed that it’s possible, what are we actually doing? kableExtra::spec_plot() creates a plot in base R, and then returns it as either svg or pdf, which means it can be compatible with either HTML or LaTeX. Remember the mpg_list we created by splitting the mpg column into a list of vectors by cyl?

mpg_list %>% str()

List of 3
 $ 4: num [1:11] 22.8 24.4 22.8 32.4 30.4 33.9 21.5 27.3 26 30.4 ...
 $ 6: num [1:7] 21 21 21.4 18.1 19.2 17.8 19.7
 $ 8: num [1:14] 18.7 14.3 16.4 17.3 15.2 10.4 10.4 14.7 15.5 15.2 ...

We can create plots for each cyl and then pull the cyl == 4 plot and look at it’s structure.

spec_plot(mpg_list) %>% 
  pluck("4") %>% 
  str()

List of 7
 $ path    : chr(0) 
 $ dev     : chr "svg"
 $ type    : chr "line"
 $ width   : num 200
 $ height  : num 50
 $ res     : num 300
 $ svg_text: chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__
 - attr(*, "class")= chr [1:2] "kableExtraInlinePlots" "list"

We see that it returns a list object, with mostly metadata about what parameters were passed to the function. The part we really want is the svg_text since that has the xml code to generate our inline plot. We can pull out the svg_text list item from our list of lists by calling map("svg_text"). Now we can see each of the svg-plots, one for each cylinder group!

spec_plot(mpg_list) %>% 
  map("svg_text") %>% 
  str()

List of 3
 $ 4: chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__
 $ 6: chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__
 $ 8: chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__

So now that we have the specific item of interest we need to let gt “know” to treat this as HTML and not just a random character string. We can call map() one more time and apply the gt::html() function to each svg plot.

spec_plot(mpg_list) %>% 
  map("svg_text") %>% 
  map(gt::html) %>% 
  str()

List of 3
 $ 4: 'html' chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__
  ..- attr(*, "html")= logi TRUE
 $ 6: 'html' chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__
  ..- attr(*, "html")= logi TRUE
 $ 8: 'html' chr "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www."| __truncated__
  ..- attr(*, "html")= logi TRUE

And that’s why the following code works:
- Group by cylinder
- Summarize down to a list-column of the respective MPG column by cylinder
- Create the spec_plot object
- Extract the svg_text
- Recognize the svg_text as HTML
- gt takes the HTML and parses it

mtcars %>% 
  group_by(cyl) %>% 
  summarize(data = list(mpg), .groups = "drop") %>% 
  mutate(
    plot = map(data, ~spec_plot(.x, ylim = mpg_rng, same_lim = TRUE, width = 300, height = 70)),
    plot = map(plot, "svg_text"),
    plot = map(plot, gt::html)
    ) %>% 
  select(-data) %>% 
  gt()

cyl	plot
4
6
8

Do it all in gt

While that works just fine, it assumes that you create the content ahead of time, before incorporating it into gt. However, you can also approach it from within gt itself.

For the next one, I have a more general function to use.

The custom function gt_plot():
- Takes the table data from gt
- You specify a specific column
- You specify external data to plot
- Specify what type of plot
- Optionally pass additional arguments to spec_plot with ...

gt_plot <- function(table_data, column, plot_data, plot_fun, ...){
  text_transform(
    table_data,
    # note the use of {{}} here - this is tidy eval
    # that allows you to indicate specific columns
    locations = cells_body(columns = vars({{column}})),
    fn = function(x){
      plot <- map(plot_data, plot_fun, width = 300, height = 70, same_lim = TRUE, ...)
      plot_svg <- map(plot, "svg_text")
      map(plot_svg, gt::html)
    }
  )
}

Note that again, my table “data” is pretty minimal, and I’ve got the data externally as our mpg_list object we created earlier.

mpg_list %>% str()

List of 3
 $ 4: num [1:11] 22.8 24.4 22.8 32.4 30.4 33.9 21.5 27.3 26 30.4 ...
 $ 6: num [1:7] 21 21 21.4 18.1 19.2 17.8 19.7
 $ 8: num [1:14] 18.7 14.3 16.4 17.3 15.2 10.4 10.4 14.7 15.5 15.2 ...

tibble(cyl = c(4,6,8), boxplot = "") %>% 
  gt() %>% 
  gt_plot(
    column = boxplot,  # column to create plot in 
    plot_data = mpg_list, # external data to reference
    plot_fun = spec_boxplot,  # which plot fun
    lim = mpg_rng # range applied
    )

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

cyl	boxplot
4
6
8

We can quickly switch from a boxplot to a sparkline, just by changing the plot_fun argument to spec_plot. Also since I passed ellipses (...) to the spec_plot() function we can also use some additional arguments to change the line-color to black, and make the max/min points to be a bit larger.

tibble(cyl = c(4,6,8), boxplot = "") %>% 
  gt() %>% 
  gt_plot(
    column = boxplot,  # column to create plot in 
    plot_data = mpg_list, # external data to reference
    plot_fun = spec_plot,  # which plot fun
    ylim = mpg_rng, # range applied,
    col = "black", # change color of line
    cex = 5 # change size of points
    )

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

cyl	boxplot
4
6
8

This works with all the kableExtra inline plot functions! Note that we are just varying the ylim on the line/points 1 vs 2, where the mpg_line1/mpg_points1 share a common y-axis, and line2/points2 have their own y-axis.

tibble(
  cyl = c(4,6,8), 
  boxplot = "", mpg_hist = "", mpg_line1 = "", 
  mpg_line2 = "", mpg_points1 = "", 
  mpg_points2 = "", mpg_poly = ""
  ) %>% 
  gt() %>% 
  gt_plot(column = boxplot, plot_data = mpg_list, plot_fun = spec_boxplot, lim = mpg_rng) %>% 
  gt_plot(column = mpg_hist, plot_data = mpg_list, plot_fun = spec_hist, lim = mpg_rng) %>% 
  gt_plot(column = mpg_line1, plot_data = mpg_list, plot_fun = spec_plot, ylim = mpg_rng) %>% 
  gt_plot(column = mpg_line2, plot_data = mpg_list, plot_fun = spec_plot) %>% 
  gt_plot(column = mpg_points1, plot_data = mpg_list, plot_fun = spec_plot, type = "p", ylim = mpg_rng, cex = 4) %>% 
  gt_plot(column = mpg_points2, plot_data = mpg_list, plot_fun = spec_plot, type = "p", cex = 4) %>% 
  gt_plot(column = mpg_poly, plot_data = mpg_list, plot_fun = spec_plot, polymin = 5, ylim = mpg_rng)

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

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

cyl	boxplot	mpg_hist	mpg_line1	mpg_line2	mpg_points1	mpg_points2	mpg_poly
4
6
8

Use a single source of data

OK so we now have a function, but we’re referencing an external data object, rather than data within the “table” itself - not ideal!

Can we just use our group_by + summarize as list from before without any changes? (Spoiler = nope)

# doesn't work
mtcars %>% 
  group_by(cyl) %>% 
  summarize(data = list(mpg), .groups = "drop") %>% 
  gt() %>% 
  text_transform(
    locations = cells_body(columns = vars(data)),
    fn = function(x){
    plot = map(x, ~spec_plot(.x, ylim = mpg_rng, same_lim = TRUE, width = 300, height = 70))
    plot = map(plot, "svg_text")
    plot = map(plot, gt::html)
    }
  ) 

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

Warning in xy.coords(x, y, xlabel, ylabel, log): NAs introduced by coercion

Warning in which.min(y): NAs introduced by coercion

Warning in which.max(y): NAs introduced by coercion

Warning in xy.coords(x, y, xlabel, ylabel, log): NAs introduced by coercion

Warning in which.min(y): NAs introduced by coercion

Warning in which.max(y): NAs introduced by coercion

Warning in xy.coords(x, y, xlabel, ylabel, log): NAs introduced by coercion

Warning in which.min(y): NAs introduced by coercion

Warning in which.max(y): NAs introduced by coercion

cyl	data
4
6
8

Nope - but it does give us a decent error message!

1: In xy.coords(x, y, xlabel, ylabel, log) : NAs introduced by coercion
2: In which.min(y) : NAs introduced by coercion
3: In which.max(y) : NAs introduced by coercion

There seems to be a type conversion - NAs are being returned where we expect numeric data to create the x-y coordinates for the plot. Let’s dive a bit closer into what happens when we call text_transform(). I’m calling str() inside our text_transform() now to expose what the data itself looks like.

# doesn't work
mtcars %>% 
  group_by(cyl) %>% 
  summarize(mpg_data = list(mpg), .groups = "drop") %>% 
  gt() %>% 
  text_transform(
    locations = cells_body(columns = vars(mpg_data)),
    fn = function(x){
      str(x)
    })

List of 3
 $ : chr "22.8, 24.4, 22.8, 32.4, 30.4, 33.9, 21.5, 27.3, 26.0, 30.4, 21.4"
 $ : chr "21.0, 21.0, 21.4, 18.1, 19.2, 17.8, 19.7"
 $ : chr "18.7, 14.3, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 15.5, 15.2, 13.3, 19.2, 15.8, 15.0"
Error: Assigned data `*vtmp*` must be compatible with existing data.
x Existing data has 3 rows.
x Assigned data has 0 rows.
ℹ Only vectors of size 1 are recycled.

This tells us something interesting! It’s combined all the vectors into a character string separated by commas. No wonder our graph can’t understand its xy coords, it is passed as one long text string!

Now if we’re tricky, we can get at the guts of gt since it’s just a list object. There’s quite a bit there inside the gt object, but the first list item is arguably the most important! We have the raw data as _data!

mtcars %>% 
  group_by(cyl) %>% 
  summarize(mpg_data = list(mpg), .groups = "drop") %>% 
  gt() %>% 
  str(max.level = 1)

List of 16
 $ _data        : tibble [3 × 2] (S3: tbl_df/tbl/data.frame)
 $ _boxhead     : tibble [2 × 6] (S3: tbl_df/tbl/data.frame)
 $ _stub_df     : tibble [3 × 5] (S3: tbl_df/tbl/data.frame)
 $ _row_groups  : chr(0) 
 $ _heading     :List of 2
 $ _spanners    : tibble [0 × 6] (S3: tbl_df/tbl/data.frame)
 $ _stubhead    :List of 1
 $ _footnotes   : tibble [0 × 7] (S3: tbl_df/tbl/data.frame)
 $ _source_notes: list()
 $ _formats     : list()
 $ _styles      : tibble [0 × 7] (S3: tbl_df/tbl/data.frame)
 $ _summary     : list()
 $ _options     : tibble [156 × 5] (S3: tbl_df/tbl/data.frame)
 $ _transforms  : list()
 $ _locale      :List of 1
 $ _has_built   : logi FALSE
 - attr(*, "class")= chr [1:2] "gt_tbl" "list"

We can pluck() the raw underlying data itself from gt, extract the mpg_data column, and could work with it in our function.

mtcars %>% 
  group_by(cyl) %>% 
  summarize(mpg_data = list(as.double(mpg)), .groups = "drop") %>% 
  gt() %>% 
  pluck("_data", "mpg_data") %>% 
  str()

List of 3
 $ : num [1:11] 22.8 24.4 22.8 32.4 30.4 33.9 21.5 27.3 26 30.4 ...
 $ : num [1:7] 21 21 21.4 18.1 19.2 17.8 19.7
 $ : num [1:14] 18.7 14.3 16.4 17.3 15.2 10.4 10.4 14.7 15.5 15.2 ...

So let’s try it out! Remember, we’re using pluck() to get the dataframe from gt’s list object, and then pulling out the mpg_data column from it.

# works now
mtcars %>% 
  group_by(cyl) %>% 
  summarize(mpg_data = list(mpg), .groups = "drop") %>% 
  gt() %>% 
  text_transform(
    locations = cells_body(columns = vars(mpg_data)),
    fn = function(x){
      data_in = pluck(., "_data", "mpg_data")
      plot = map(data_in, ~spec_plot(.x, ylim = mpg_rng, same_lim = TRUE, width = 300, height = 70))
      plot = map_chr(plot, "svg_text")
    })

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

cyl	mpg_data
4
6
8

That worked beautifully!

An alternative that doesn’t require going into the gt object itself and coerces the character string back into numeric. This is a bit clunkier, but totally possible.

# WORKS
mtcars %>%
  group_by(cyl) %>%
  summarize(mpg_data = list(as.double(mpg)), .groups = "drop") %>%
  gt() %>%
  text_transform(
    locations = cells_body(columns = vars(mpg_data)),
    fn = function(x) {
      # split the strings at each comma
      split_data <- str_split(x, ", ")
      # convert to type double
      data <- map(split_data, as.double)
      # create the plot
      plot <- map(data, ~ spec_plot(.x, ylim = mpg_rng, same_lim = TRUE, width = 300, height = 70))
      # extract the svg item
      map(plot, "svg_text")
    }
  )

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

cyl	mpg_data
4
6
8

Ok so we’ve shown that it’s possible to do that either way, so let’s rewrite our function!

gt_plot <- function(table_data, plot_col, data_col, plot_fun, ...){
  # save the data extract ahead of time 
  # to be used in our anonymous function below
  data_in = pluck(table_data, "_data", data_col)

  text_transform(
    table_data,
    # note the use of {{}} here - this is tidy eval
    # that allows you to indicate specific columns
    locations = cells_body(columns = vars({{plot_col}})),
    fn = function(x){
      plot <- map(data_in, plot_fun, width = 300, height = 70, same_lim = FALSE, ...)
      plot_svg <- map(plot, "svg_text")
      map(plot_svg, gt::html)
    }
  )
}

This function will now work exactly as expected with the grouped list data columns!

# works!
mtcars %>% 
  group_by(cyl) %>% 
  summarize(mpg_data = list(mpg), .groups = "drop") %>% 
  gt() %>% 
  # note you can leave mpg_data unquoted for the tidyeval
  # but have to quote mpg_data for the pluck
  gt_plot(mpg_data, "mpg_data", plot_fun = spec_plot)

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

cyl	mpg_data
4
6
8

Interactive sparklines

So the embedded sparklines as shown above are fantastic, quick and robust, but they’re static. Since we’re focusing on HTML content, why don’t we also see if we can get javascript enabled interactivity?

Quick example of this working below, but note you need to call sparkline(0) somewhere ahead of time in your RMarkdown doc to load the javascript library dependency. Also, if you try to view this interactively it will look like it failed and didn’t pass anything through, but it will work when the RMarkdown is knit and the JavaScript can be called properly.

tibble(
  var = c("mpg", "wt"),
  sparkline1 = "",
  sparkline2 = "",
  box = ""
) %>% 
  gt() %>% 
  text_transform(
    locations = cells_body(vars(sparkline1)),
    fn = function(x){
      sparkline <- map(list(mtcars$mpg, mtcars$wt), ~spk_chr(values = .x, chartRangeMin = 0))
      map(sparkline, gt::html)
    }
  ) %>% 
  text_transform(
    locations = cells_body(vars(sparkline2)),
    fn = function(x){
      sparkline <- map(list(mtcars$mpg, mtcars$wt), ~spk_chr(values = .x, type = "bar", chartRangeMin = 0))
      map(sparkline, gt::html)
    }
  ) %>% 
  text_transform(
    locations = cells_body(vars(box)),
    fn = function(x){
      sparkline <- map(list(mtcars$mpg, mtcars$wt), ~spk_chr(values = .x, type = "box", chartRangeMin = 0))
      map(sparkline, 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

var	sparkline1	sparkline2	box
mpg
wt

While we’re likely to only be using this in a table once per each , I do want to try and create a function so that we don’t have to re-write these each time and could potentially roll it into a package.

gt_spark <- function(table_data, plot_col, data_col){
  # save the data extract ahead of time 
  # to be used in our anonymous function below
  data_in = pluck(table_data, "_data", data_col)
  
  text_transform(
    table_data,
    # note the use of {{}} here - this is tidy eval
    # that allows you to indicate specific columns
    locations = cells_body(columns = vars({{plot_col}})),
    fn = function(x){
      sparkline_plot <- map(
        data_in, 
        ~spk_chr(values = .x, chartRangeMin = 0)
        )
      
      map(sparkline_plot, gt::html)
    }
  )
}

We can then apply the function to work very succinctly, referencing only the internal list-column data.

# works!
mtcars %>% 
  group_by(cyl) %>% 
  summarize(mpg_data = list(mpg), .groups = "drop") %>% 
  gt() %>% 
  # note you can leave mpg_data unquoted for the tidyeval
  # but have to quote mpg_data for the pluck
  gt_spark(mpg_data, "mpg_data")

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

cyl	mpg_data
4
6
8

Forest

You can also make forest-plot like tables in gt, note that this code is taken essentially verbatim from kableExtra’s documentation, just adapted to work in gt.

coef_table <- data.frame(
  Variables = c("var 1", "var 2", "var 3"),
  Coefficients = c(1.6, 0.2, -2.0),
  Conf.Lower = c(1.3, -0.4, -2.5),
  Conf.Higher = c(1.9, 0.6, -1.4)
) 

tibble(
  Variable = coef_table$Variables,
) %>%
  mutate(
    image = spec_pointrange(
      x = coef_table$Coefficients, 
      xmin = coef_table$Conf.Lower, 
      xmax = coef_table$Conf.Higher, 
      vline = 0,
      width = 250,
      cex = .75,
      col = "black",
      pch = 16
      )
    ) %>% 
  mutate(
    image = map(image, "svg_text"),
    image = map(image, ~gt::html(as.character(.x)))
  ) %>% 
  gt()

Variable	image
var 1
var 2
var 3

We can show a bit more robust example from a recent question by Silvia Canelón - @spcanelon

Code to generate fake data

coef_table <- tibble(
  group = c(
    "",
    rep("Sex", 2),
    rep("Age", 4),
    rep("Body-Mass index", 2),
    rep("Race", 3),
    rep("Baseline statin treatment", 2),
    rep("Intensity of statin treatment", 2),
    rep("Metabolic disease", 3),
    rep("Renal function", 3)
  ),
  subgroup = c(
    "All Patients",
    "Male", "Female",
    "<65 yr", ">= 65 yr", "<75 yr", ">=75 yr",
    "<=Median", ">Median",
    "White", "Black", "Other",
    "Yes", "No",
    "High", "Not high",
    "Diabetes", "Metabolic syndrome", "Neither",
    "Normal", "Mild impairment", "Moderate impairment"
  ),
  Inclisiran = c(
    781, 535,246,297,484,638,143,394,387,653,110,18,701,80,538,243,371,195,215,395,269,113
  ),
  Placebo = c(
    780,548,232,333,447,649,131,385,394,685,87,8,692,88,546,234,331,207,242,410,260,107
  ),
  coefficients = c(-60,-55,-68,-58,-55,-57,-58,-55,-48,-58,-57,-49,-44,-58,-55,-57,-54,-52,-54,-53, -54,-52)
  ) %>% 
  mutate(
    conf_range = runif(22, min = 5, max = 10),
    conf_lower = coefficients - conf_range,
    conf_higher = coefficients + conf_range
  ) %>%
  mutate(
    image = spec_pointrange(
      x = coefficients, 
      xmin = conf_lower, 
      xmax = conf_higher, 
      same_lim = TRUE,
      lim = c(-100, 25),
      vline = 0,
      width = 550,
      cex = .75,
      col = "black"
      )
    )

Here’s the code to create a quick table with a zero-indicated line, and some randomly generated “variation”.

coef_table %>% 
  select(-coefficients, -contains("conf")) %>% 
  mutate(
    image = map(image, "svg_text"),
    image = map(image, ~gt::html(as.character(.x)))
  ) %>% 
  select(group:Placebo, pct_diff = image) %>% 
  gt(
    groupname_col = "group",
    rowname_col = "subgroup"
  ) %>% 
  opt_row_striping() %>% 
  tab_options(
    data_row.padding = px(3)
  )

	Inclisiran	Placebo	pct_diff
All Patients	781	780
Sex
Male	535	548
Female	246	232
Age
<65 yr	297	333
>= 65 yr	484	447
<75 yr	638	649
>=75 yr	143	131
Body-Mass index
<=Median	394	385
>Median	387	394
Race
White	653	685
Black	110	87
Other	18	8
Baseline statin treatment
Yes	701	692
No	80	88
Intensity of statin treatment
High	538	546
Not high	243	234
Metabolic disease
Diabetes	371	331
Metabolic syndrome	195	207
Neither	215	242
Renal function
Normal	395	410
Mild impairment	269	260
Moderate impairment	113	107

More custom HTML work

For the next section, I’ll be showing some functions that are mostly adapted from Greg Lin’s fantastic examples for the reactable package Cookbook. I love reactable, but want to show how some of the same ideas can translate in to mostly static tables as well. Note that some of the tags$, div, etc are from the htmltools package, and you can generally write your own HTML by hand if you wanted.

Function to add tooltip to a table column label

library(htmltools)

# Add tooltip to column labels
with_tooltip <- function(value, tooltip) {
  tags$abbr(style = "text-decoration: underline; text-decoration-style: solid; cursor: question; color: blue",
            title = tooltip, value)
}

Function that creates a star rating scale from 0-5

# note you could use ANY font-awesome logo
# https://fontawesome.com/cheatsheet
rating_stars <- function(rating, max_rating = 5) {
  rounded_rating <- floor(rating + 0.5)  # always round up
  stars <- lapply(seq_len(max_rating), function(i) {
    if (i <= rounded_rating) fontawesome::fa("star", fill= "orange") else fontawesome::fa("star", fill= "grey")
  })
  label <- sprintf("%s out of %s", rating, max_rating)
  div_out <- div(title = label, "aria-label" = label, role = "img", stars)
  
  as.character(div_out) %>% 
    gt::html()
}

fontawesome package for inline icons

rank_chg <- function(change_dir){
  if (change_dir == "increase") {
    logo_out <- fontawesome::fa("arrow-up", fill = "blue")
  } else if (change_dir == "decrease"){
    logo_out <- fontawesome::fa("arrow-down", fill = "red")
  }
  
  logo_out %>% 
    as.character() %>% 
    gt::html()
  
}

Create a “badge” style label with a specific color, and round edges.

add_cyl_color <- function(cyl){
      add_color <- if (cyl == 4) {
        "background: hsl(116, 60%, 90%); color: hsl(116, 30%, 25%);"
      } else if (cyl == 6) {
        "background: hsl(230, 70%, 90%); color: hsl(230, 45%, 30%);"
      } else if (cyl == 8) {
        "background: hsl(350, 70%, 90%); color: hsl(350, 45%, 30%);"
      }
      div_out <- htmltools::div(
        style = paste(
          "display: inline-block; padding: 2px 12px; border-radius: 15px; font-weight: 600; font-size: 12px;",
          add_color
          ),
        paste(cyl, "Cylinders")
      )
      
      as.character(div_out) %>% 
        gt::html()
}

Example of a inline bar chart made purely with HTML

bar_chart <- function(value, color = "red"){
    
    glue::glue("<span style=\"display: inline-block; direction: ltr; border-radius: 4px; padding-right: 2px; background-color: {color}; color: {color}; width: {value}%\"> &nbsp; </span>") %>% 
    as.character() %>% 
    gt::html()
}

All of these examples can be used in one example table! I’ve also added a HTML example of a hyperlink for the “data source” which links to the gt page for HTML content 😄. So now we have:
- Tooltips
- Embedded icons/font-awesome logos
- Badges + colors
- HTML-only bar charts
- Hyperlinks
- Expandable Tabke Key as “Details” with a HTML <details> tag

set.seed(377)
  
mtcars %>% 
  tibble() %>% 
  select(1:4) %>% 
  sample_n(size = 6) %>% 
  mutate(
    rank_change = sample(c("increase", "decrease"), size = 6, replace = TRUE),
    rank_change = map(rank_change, rank_chg)
  ) %>% 
  mutate(
    rating = sample(1:5, size = 6, replace = TRUE),
    rating = map(rating, rating_stars)
    ) %>% 
  mutate(
    cylinder = map(cyl, add_cyl_color)
  ) %>% 
  mutate(
    mpg_plot = mpg/max(mpg) * 100,
    mpg_plot = map(mpg_plot, ~bar_chart(value = .x, color = "lightblue"))
    ) %>% 
  gt() %>% 
  cols_align(
    align = "left",
    columns = vars(mpg_plot)
  ) %>% 
  cols_label(
    mpg = gt::html(as.character(with_tooltip("MPG", "Miles per Gallon")))
  ) %>% 
  tab_source_note(
    source_note = html(
      htmltools::tags$a(
        href = "https://gt.rstudio.com/reference/md.html", 
        target = "_blank", 
        "Data Source"
        ) %>% 
        as.character()
      )
    ) %>% 
  tab_source_note(
    source_note = html(
      "<details><h3 style='font-face:bold'>Table Key</h3><div>MPG: Miles Per Gallon</div><div>Cyl: Cylinders</div><div>disp: Displacement</div><div>hp: Horsepower</div><div>rank_change: Rank Change</div><div>rating: Rating</div></details>"
    )
  ) %>% 
  tab_options(
    data_row.padding = px(5)
  )

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

MPG	cyl	disp	hp	rank_change	rating	cylinder	mpg_plot
15.5	8	318.0	150			8 Cylinders
14.3	8	360.0	245			8 Cylinders
21.0	6	160.0	110			6 Cylinders
10.4	8	472.0	205			8 Cylinders
26.0	4	120.3	91			4 Cylinders
15.0	8	301.0	335			8 Cylinders
Data Source
Table Key MPG: Miles Per Gallon Cyl: Cylinders disp: Displacement hp: Horsepower rank_change: Rank Change rating: Rating

Put it all together

Let’s put all the things we’ve learned together into a publication-quality table, we’ll collect some QBR data to use.

# use espnscrapeR to get NFL standings + QBR ratings
nfl_qbr <- get_nfl_qbr(2020)

Scraping QBR totals for 2020!

nfl_standings <- get_nfl_standings(2020)

Returning 2020

# also get weekly for embedded plot
qbr_weekly <- crossing(season = 2020, week = 1:8) %>%
  pmap_dfr(.f = get_nfl_qbr)

Scraping weekly QBR for week 1 of 2020!

Scraping weekly QBR for week 2 of 2020!

Scraping weekly QBR for week 3 of 2020!

Scraping weekly QBR for week 4 of 2020!

Scraping weekly QBR for week 5 of 2020!

Scraping weekly QBR for week 6 of 2020!

Scraping weekly QBR for week 7 of 2020!

Scraping weekly QBR for week 8 of 2020!

Then we’ll summarise the data to prep for an embedded plot, and join together our NFL standings, QBR, and weekly QBR.

Data Prep

qbr_match <- qbr_weekly %>%
  filter(name_short %in% unique(nfl_qbr$name_short)) %>%
  group_by(name_short, team) %>%
  summarise(qbr_weekly = list(qbr_total), .groups = "drop",
            qbr = mean(qbr_total),
            qbr_sd = sd(qbr_total),
            plays = sum(qb_plays),
            pass = mean(pass),
            run = mean(run),
            head = unique(headshot_href),
            n = n()) %>%
  arrange(desc(qbr)) %>% 
  filter(n >= 7)

# clean up the data a bit and combine
tab_df <- qbr_match %>% 
  left_join(nfl_standings, by = c("team" = "team_name")) %>%
  select(name_short, team, head, qbr_weekly:run, wins, losses, pts_for) %>%
  mutate(wl = glue("{wins}-{losses}")) %>%
  select(-wins, -losses)
tab_df

# A tibble: 23 × 11
   name_short   team    head  qbr_weekly   qbr qbr_sd plays  pass    run pts_for
   <chr>        <chr>   <chr> <list>     <dbl>  <dbl> <dbl> <dbl>  <dbl>   <dbl>
 1 R. Wilson    Seahaw… http… <dbl [7]>   77.0   9.57   328  7.43  1.17      459
 2 A. Rodgers   Packers http… <dbl [7]>   73.2  29.9    285  6.3   0.586     509
 3 P. Mahomes   Chiefs  http… <dbl [8]>   72.1  20.8    347  7.22  1.29      473
 4 D. Brees     Saints  http… <dbl [7]>   70.1  13.1    280  6.31  0.171     482
 5 J. Allen     Bills   http… <dbl [8]>   69.9  20.9    362  6.64  1.21      501
 6 R. Tannehill Titans  http… <dbl [7]>   68.8  20.3    284  5.81  1.13      491
 7 D. Carr      Raiders http… <dbl [7]>   66.2  19.9    284  5.69  0.357     434
 8 M. Ryan      Falcons http… <dbl [8]>   64.9  28.3    370  5.54  0.662     396
 9 K. Murray    Cardin… http… <dbl [7]>   64.2  20.8    340  3.81  2.69      410
10 T. Brady     Buccan… http… <dbl [8]>   62.2  25.9    349  5.88 -0.262     492
# … with 13 more rows, and 1 more variable: wl <glue>

# calc rank change
qbr_rnk_chg <- qbr_weekly %>% 
  mutate(game_week = as.integer(game_week)) %>% 
  group_by(name_short) %>% 
  mutate(mean_qbr = mean(qbr_total)) %>% 
  ungroup() %>% 
  select(game_week, rank, name_short, qbr_total, mean_qbr) %>% 
  filter(game_week != max(game_week)) %>% 
  filter(name_short %in% nfl_qbr$name_short) %>%
  group_by(name_short) %>%
  summarize(prev_qbr = mean(qbr_total), mean_qbr = unique(mean_qbr)) %>% 
  mutate(
    prev_week = rank(-prev_qbr),
    rank = rank(-mean_qbr)
    ) %>% 
  mutate(rank_chg = prev_week-rank) %>% 
  ungroup() %>% 
  arrange(desc(mean_qbr)) %>% 
  select(name_short, qbr = mean_qbr, rank_chg, rank)

qbr_rnk_chg

# A tibble: 35 × 4
   name_short       qbr rank_chg  rank
   <chr>          <dbl>    <dbl> <dbl>
 1 R. Wilson       77.0        0     1
 2 A. Rodgers      73.2        1     2
 3 P. Mahomes      72.1        5     3
 4 D. Prescott     71.5        1     4
 5 D. Brees        70.1        1     5
 6 J. Allen        69.9       -4     6
 7 R. Tannehill    68.8       -3     7
 8 J. Herbert      68.7        3     8
 9 K. Allen        68.2        0     9
10 R. Fitzpatrick  67.6        0    10
# … with 25 more rows

We can then combine the player name, team, and win-loss record into one set of “data” presented with some HTML formatting.

Code for Name/Team/Record Combo

combine_word <- function(name, team, wl){
      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'>{team}&nbsp;&nbsp;{wl}</span></div>"
      )
    }

combo_df <- tab_df %>% 
  left_join(qbr_rnk_chg, by = c("name_short", "qbr")) %>%
  select(rank, rank_chg, name_short:wl) %>% 
  mutate(
    rank = row_number(),
    combo = combine_word(name_short, team, wl),
    combo = map(combo, gt::html)
    ) %>% 
  select(rank, rank_chg, head, combo, qbr, qbr_weekly, plays, pts_for)

combo_df

# A tibble: 23 × 8
    rank rank_chg head                     combo    qbr qbr_weekly plays pts_for
   <int>    <dbl> <chr>                    <list> <dbl> <list>     <dbl>   <dbl>
 1     1        0 https://a.espncdn.com/i… <html>  77.0 <dbl [7]>    328     459
 2     2        1 https://a.espncdn.com/i… <html>  73.2 <dbl [7]>    285     509
 3     3        5 https://a.espncdn.com/i… <html>  72.1 <dbl [8]>    347     473
 4     4        1 https://a.espncdn.com/i… <html>  70.1 <dbl [7]>    280     482
 5     5       -4 https://a.espncdn.com/i… <html>  69.9 <dbl [8]>    362     501
 6     6       -3 https://a.espncdn.com/i… <html>  68.8 <dbl [7]>    284     491
 7     7       -4 https://a.espncdn.com/i… <html>  66.2 <dbl [7]>    284     434
 8     8        5 https://a.espncdn.com/i… <html>  64.9 <dbl [8]>    370     396
 9     9        0 https://a.espncdn.com/i… <html>  64.2 <dbl [7]>    340     410
10    10        6 https://a.espncdn.com/i… <html>  62.2 <dbl [8]>    349     492
# … with 13 more rows

Table Code

final_table <- combo_df %>% 
  gt() %>% 
  cols_align(
    align = "left",
    columns = vars(combo)
  ) %>% 
  tab_options(
    data_row.padding = px(2)
  ) %>% 
  text_transform(
    locations = cells_body(columns = vars(head)),
    fn = function(x){
      gt::web_image(x)
    }
  ) %>% 
  text_transform(
    locations = cells_body(columns = vars(rank_chg)),
    fn = function(x){
      
      rank_chg <- as.integer(x)
      
      choose_logo <-function(x){
        if (x == 0){
        gt::html(fontawesome::fa("equals", fill = "grey"))
      } else if (x > 0){
         gt::html(glue::glue("<span style='color:#1134A6;font-face:bold;font-size:10px;'>{x}</span>"), fontawesome::fa("arrow-up", fill = "#1134A6"))
      } else if (x < 0) {
        gt::html(glue::glue("<span style='color:#DA2A2A;font-face:bold;font-size:10px;'>{x}</span>"), fontawesome::fa("arrow-down", fill = "#DA2A2A"))
      }
      } 
      
      map(rank_chg, choose_logo)
    
    }
  ) %>% 
  fmt_number(
    columns = vars(qbr), 
    decimals = 1
    ) %>% 
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_column_labels(TRUE)
  ) %>% 
  cols_label(
    rank = "RK",
    combo = "",
    head = "QB",
    qbr = "QBR",
    plays = "PLAYS",
    pts_for = "PF",
    qbr_weekly = "WEEKLY",
    rank_chg = ""
  ) %>% 
  gt_spark(qbr_weekly, "qbr_weekly") %>%
  espnscrapeR::gt_theme_espn() %>% 
  tab_source_note(
    source_note = gt::html(
      htmltools::tags$a(
        href = "https://www.espn.com/nfl/qbr", 
        target = "_blank", 
        "Data: ESPN"
        ) %>% 
        as.character()
      )
    ) %>% 
  cols_align(
    "left",
    columns = vars(qbr_weekly)
  ) %>% 
  cols_width(
    vars(rank) ~ px(25),
    vars(rank_chg) ~ px(35),
    vars(head) ~ px(50),
    vars(combo) ~ px(115),
    vars(qbr) ~ px(35),
    vars(plays) ~ px(35),
    vars(pts_for) ~ px(35),
    vars(qbr_weekly) ~ px(75)
  ) %>% 
  tab_header(
    title = gt::html("<h3>NFL QBR through Week 8</h3>")
  ) %>% 
  tab_options(
    table.width = px(480),
    data_row.padding = px(4)
  )

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 = TRUE` has been deprecated in gt 0.3.0:
* please use `columns = everything()` 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

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

final_table

NFL QBR through Week 8
RK		QB		QBR	WEEKLY	PLAYS	PF
1			R. Wilson Seahawks  12-4	77.0		328	459
2	1		A. Rodgers Packers  13-3	73.2		285	509
3	5		P. Mahomes Chiefs  14-2	72.1		347	473
4	1		D. Brees Saints  12-4	70.1		280	482
5	-4		J. Allen Bills  13-3	69.9		362	501
6	-3		R. Tannehill Titans  11-5	68.8		284	491
7	-4		D. Carr Raiders  8-8	66.2		284	434
8	5		M. Ryan Falcons  4-12	64.9		370	396
9			K. Murray Cardinals  8-8	64.2		340	410
10	6		T. Brady Buccaneers  11-5	62.2		349	492
11	3		D. Watson Texans  4-12	60.8		305	384
12	-1		B. Mayfield Browns  11-5	58.6		271	408
13			T. Bridgewater Panthers  5-11	58.5		329	350
14	-7		L. Jackson Ravens  11-5	58.2		282	468
15	-5		M. Stafford Lions  5-11	58.2		295	377
16	1		P. Rivers Colts  11-5	57.4		256	451
17	-7		J. Goff Rams  10-6	56.2		328	372
18	-2		D. Jones Giants  6-10	55.6		346	280
19			B. Roethlisberger Steelers  12-4	52.1		283	416
20	1		J. Burrow Bengals  4-11	50.4		426	311
21	4		K. Cousins Vikings  7-9	46.9		232	430
22	-4		C. Wentz Eagles  4-11	46.1		407	334
23	-1		G. Minshew Jaguars  1-15	44.3		331	306
Data: ESPN

So that’s all for now, but hopefully having this “cheatsheet” lets you go even further with all the possible creations you can make with a lot of gt and a little bit of HTML!

Expand for Session Info

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version    date (UTC) lib source
 dplyr       * 1.0.8      2022-02-08 [1] CRAN (R 4.2.0)
 espnscrapeR * 0.6.5      2022-04-26 [1] Github (jthomasmock/espnscrapeR@084ce80)
 forcats     * 0.5.1      2021-01-27 [1] CRAN (R 4.2.0)
 formattable * 0.2.1      2021-01-07 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5      2021-06-25 [1] CRAN (R 4.2.0)
 glue        * 1.6.2      2022-02-24 [1] CRAN (R 4.2.0)
 gt          * 0.5.0.9000 2022-04-27 [1] Github (rstudio/gt@0d4c83d)
 htmltools   * 0.5.2      2021-08-25 [1] CRAN (R 4.2.0)
 kableExtra  * 1.3.4      2021-02-20 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4      2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2      2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2      2021-12-06 [1] CRAN (R 4.2.0)
 sparkline   * 2.0        2016-11-12 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0      2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6      2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0      2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1      2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────