2  Fancy stuff / Eye catchers

In this chapter, we’re going to learn how to add fancy elements like plots, icon and images to {gt} tables. We’re going to start this chapter by using a selection of the gapminder data set from {gapminder}.

library(tidyverse)
library(gt)
gapminder_data <- gapminder::gapminder |> 
  janitor::clean_names() |> 
  select(continent, country, year, life_exp) |> 
  mutate(
    year = as.character(year),
    # Year is really categorical with numeric labels
    country = as.character(country) 
  ) 
gapminder_data
## # A tibble: 1,704 × 4
##    continent country     year  life_exp
##    <fct>     <chr>       <chr>    <dbl>
##  1 Asia      Afghanistan 1952      28.8
##  2 Asia      Afghanistan 1957      30.3
##  3 Asia      Afghanistan 1962      32.0
##  4 Asia      Afghanistan 1967      34.0
##  5 Asia      Afghanistan 1972      36.1
##  6 Asia      Afghanistan 1977      38.4
##  7 Asia      Afghanistan 1982      39.9
##  8 Asia      Afghanistan 1987      40.8
##  9 Asia      Afghanistan 1992      41.7
## 10 Asia      Afghanistan 1997      41.8
## # ℹ 1,694 more rows

Let’s bring this into a table using some fancy elements. Many such elements can be added relatively easily with {gtExtras}. For example, here’s a summary table of our data set.

library(gtExtras)
gt_plt_summary(gapminder_data) 
## Warning in geom_point(data = NULL, aes(x = rng_vals[1], y = 1), color = "transparent", : All aesthetics have length 1, but the data has 1704 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.
## Warning in geom_point(data = NULL, aes(x = rng_vals[2], y = 1), color = "transparent", : All aesthetics have length 1, but the data has 1704 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.
gapminder_data
1704 rows x 4 cols
Column Plot Overview Missing Mean Median SD
continent 5 categories 0.0% — — —
country 142 categories 0.0% — — —
year 12 categories 0.0% — — —
life_exp 2483 0.0% 59.5 60.7 12.9

As you can see, this table includes icons in the first column (categorical or continuous variables) and a plot overview in the third column. Automatic tables like this can give you a feeling for the data at a glance. For example, we can see that there are 12 years and 142 countries present in the data set. Also, no values are missing.

Since we have quite a lot of info on many countries and years, let us make our data set a bit smaller. We don’t want to create huge tables (yet). Just like in the last chapter, we will have to reorder our data a bit so that it’s already in a good table format.

selected_countries <- gapminder_data  |> 
# Filter to use only six years (those that end in 7)
  filter(str_ends(year, "7")) |>
# sample two countries per continent
  group_by(continent, country) |> 
  nest() |> 
  group_by(continent) |> 
  slice_sample(n = 2) |> 
  ungroup() |> 
  unnest(data) |> 
# Rearrange the data into table format
  pivot_wider(names_from = year, names_prefix = 'year', values_from = life_exp)
selected_countries
## # A tibble: 10 × 8
##    continent country       year1957 year1967 year1977 year1987 year1997 year2007
##    <fct>     <chr>            <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
##  1 Africa    Egypt             44.4     49.3     53.3     59.8     67.2     71.3
##  2 Africa    Sierra Leone      31.6     34.1     36.8     40.0     39.9     42.6
##  3 Americas  Nicaragua         45.4     51.9     57.5     62.0     68.4     72.9
##  4 Americas  Jamaica           62.6     67.5     70.1     71.8     72.3     72.6
##  5 Asia      Syria             48.3     53.7     61.2     67.0     71.5     74.1
##  6 Asia      Singapore         63.2     67.9     70.8     73.6     77.2     80.0
##  7 Europe    Netherlands       73.0     73.8     75.2     76.8     78.0     79.8
##  8 Europe    United Kingd…     70.4     71.4     72.8     75.0     77.2     79.4
##  9 Oceania   New Zealand       70.3     71.5     72.2     74.3     77.6     80.2
## 10 Oceania   Australia         70.3     71.1     73.5     76.3     78.8     81.2

From this we can create a {gt} table just like we learned in the last chapter. And with {gtExtras} we can apply a cool FiveThirtyEight theme to our table.

# New column names
new_colnames <- colnames(selected_countries) |> str_remove('(country|year)')
names(new_colnames) <- colnames(selected_countries)

selected_countries |> 
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538()
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14
Singapore 63.18 67.95 70.80 73.56 77.16 79.97
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20
Australia 70.33 71.10 73.49 76.32 78.83 81.23

2.1 Transform columns into heatmaps

In this table, we can see that Sierra Leone had by far the lowest life expectancy in 2007 (among the depicted countries). We can figure this out by comparing the numbers in the most recent column one-by-one.

But that takes quite a lot of effort. Instead, let us make that easier to see by transforming that column into a heat map. To do so, just pass our table to gt_color_rows()1. What you’ll need to specify, is

  • the targeted columns
  • the range of the values that are supposed to be colored
  • two colors that are used in a linear gradient
# Two colors from the Okabe Ito color palette
color_palette <- c("#CC79A7", "#009E73")

selected_countries |> 
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538() |> 
  gt_color_rows(
    columns = year2007, 
    domain = c(30, 85),
    palette = color_palette
  )
## Warning: Since gt v0.9.0, the `colors` argument has been deprecated.
## • Please use the `fn` argument instead.
## This warning is displayed once every 8 hours.
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14
Singapore 63.18 67.95 70.80 73.56 77.16 79.97
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20
Australia 70.33 71.10 73.49 76.32 78.83 81.23

We could also do this for more columns. For example, we could also do the same with the 1957 column.

# Two colors from the Okabe Ito color palette
color_palette <- c("#CC79A7", "#009E73")

selected_countries |> 
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538() |> 
  gt_color_rows(
    columns = c(year1957, year2007), 
    domain = c(30, 85),
    palette = color_palette
  )
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14
Singapore 63.18 67.95 70.80 73.56 77.16 79.97
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20
Australia 70.33 71.10 73.49 76.32 78.83 81.23

You could even do that with all columns. But I am not sure whether that’s a good idea here. After all, we may not want to overload our table with colors.

2.2 Add sparklines

It is quite hard to figure out that each depicted country increased its life expectancy in each year. Sure, you may have an idea that this is the case. But to be sure for real, you will have to compare each cell of each row.

Why don’t we make that a little bit easier? Let us add small line charts. This kind of chart is known as a sparkline. It’s main advantage is that it can make patterns really obvious. Have a look for yourself.

Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007 Timeline
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34 71.3
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57 42.6
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90 72.9
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57 72.6
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14 74.1
Singapore 63.18 67.95 70.80 73.56 77.16 79.97 80.0
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76 79.8
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42 79.4
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20 80.2
Australia 70.33 71.10 73.49 76.32 78.83 81.23 81.2

To create such a table we first need a tibble that has a column Timeline that contains the values from 1957 to 2007. A column that contains more than one value per cell, you say? Yes, you heard that correctly. What we need is a tibble with list-like columns. Sounds fancy if you’ve never heard it before but it is not actually that hard to create one. Here’s what we’re going to do.

  1. Take the original data set gapminder_data and filter it such that it contains the same years and countries as our data set selected_countries
  2. Group the filtered data set by country and run summarise(Timeline = list(c(life_exp))).

The trick here is to wrap the combine function c() into list(). This way, the new list will become one object that will be saved into a tibble’s cell.

gapminder_data |> 
  filter(
    str_ends(year, "7"),
    country %in% selected_countries$country
  )
## # A tibble: 60 × 4
##    continent country   year  life_exp
##    <fct>     <chr>     <chr>    <dbl>
##  1 Oceania   Australia 1957      70.3
##  2 Oceania   Australia 1967      71.1
##  3 Oceania   Australia 1977      73.5
##  4 Oceania   Australia 1987      76.3
##  5 Oceania   Australia 1997      78.8
##  6 Oceania   Australia 2007      81.2
##  7 Africa    Egypt     1957      44.4
##  8 Africa    Egypt     1967      49.3
##  9 Africa    Egypt     1977      53.3
## 10 Africa    Egypt     1987      59.8
## # ℹ 50 more rows
life_exps_timeline <- gapminder_data |> 
  filter(
    str_ends(year, "7"),
    country %in% selected_countries$country
  ) |> 
  group_by(country) |> 
  summarise(Timeline = list(c(life_exp)))
life_exps_timeline
## # A tibble: 10 × 2
##    country        Timeline 
##    <chr>          <list>   
##  1 Australia      <dbl [6]>
##  2 Egypt          <dbl [6]>
##  3 Jamaica        <dbl [6]>
##  4 Netherlands    <dbl [6]>
##  5 New Zealand    <dbl [6]>
##  6 Nicaragua      <dbl [6]>
##  7 Sierra Leone   <dbl [6]>
##  8 Singapore      <dbl [6]>
##  9 Syria          <dbl [6]>
## 10 United Kingdom <dbl [6]>

Now we can run a quick left_join() to, well, join our two data sets. Then it’s gt()-time. This will list all values of the Timeline column in the {gt} table. Have a look.

selected_countries |> 
  left_join(life_exps_timeline, by = 'country') |> 
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538() |> 
  gt_color_rows(
    columns = c(year1957, year2007), 
    domain = c(30, 85),
    palette = color_palette
  )
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007 Timeline
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34 44.444, 49.293, 53.319, 59.797, 67.217, 71.338
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57 31.570, 34.113, 36.788, 40.006, 39.897, 42.568
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90 45.432, 51.884, 57.470, 62.008, 68.426, 72.899
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57 62.610, 67.510, 70.110, 71.770, 72.262, 72.567
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14 48.284, 53.655, 61.195, 66.974, 71.527, 74.143
Singapore 63.18 67.95 70.80 73.56 77.16 79.97 63.179, 67.946, 70.795, 73.560, 77.158, 79.972
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76 72.990, 73.820, 75.240, 76.830, 78.030, 79.762
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42 70.420, 71.360, 72.760, 75.007, 77.218, 79.425
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20 70.260, 71.520, 72.220, 74.320, 77.550, 80.204
Australia 70.33 71.10 73.49 76.32 78.83 81.23 70.330, 71.100, 73.490, 76.320, 78.830, 81.235

Finally, the last ingredient is to target the Timeline column with the gt_plt_sparkline() layer. In that layer, we can adjust the colors and the dimensions of our sparkline too.

## Join First
selected_countries |> 
  left_join(life_exps_timeline, by = 'country') |> 
## Do table as before
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538() |> 
  gt_color_rows(
    columns = c(year1957, year2007), 
    domain = c(30, 85),
    palette = color_palette
  ) |> 
## Target Timeline column
  gt_plt_sparkline(
    column = Timeline,
    palette = c("grey40", "grey40", "grey40", "dodgerblue1", "grey40"),
    fig_dim = c(5, 28)
  )
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007 Timeline
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34 71.3
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57 42.6
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90 72.9
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57 72.6
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14 74.1
Singapore 63.18 67.95 70.80 73.56 77.16 79.97 80.0
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76 79.8
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42 79.4
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20 80.2
Australia 70.33 71.10 73.49 76.32 78.83 81.23 81.2

Alright, we’ve created the our first table that contains a plot. The pattern to add fancy plots/images/fancy stuff is always the same, so let’s recap.

  • Step 1: Get the necessary data for the image into the tibble before even calling gt(). This will give you additional columns.
  • Step 2: Target the additional columns with a new layer.

For completeness’ sake let me mention that we could also use the rowwise() and c_across() functions in step 1.2

selected_countries |> 
  rowwise() |> 
  mutate(Timeline = list(c_across(year1957:year2007))) |> 
  ungroup()
## # A tibble: 10 × 9
##    continent country       year1957 year1967 year1977 year1987 year1997 year2007
##    <fct>     <chr>            <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
##  1 Africa    Egypt             44.4     49.3     53.3     59.8     67.2     71.3
##  2 Africa    Sierra Leone      31.6     34.1     36.8     40.0     39.9     42.6
##  3 Americas  Nicaragua         45.4     51.9     57.5     62.0     68.4     72.9
##  4 Americas  Jamaica           62.6     67.5     70.1     71.8     72.3     72.6
##  5 Asia      Syria             48.3     53.7     61.2     67.0     71.5     74.1
##  6 Asia      Singapore         63.2     67.9     70.8     73.6     77.2     80.0
##  7 Europe    Netherlands       73.0     73.8     75.2     76.8     78.0     79.8
##  8 Europe    United Kingd…     70.4     71.4     72.8     75.0     77.2     79.4
##  9 Oceania   New Zealand       70.3     71.5     72.2     74.3     77.6     80.2
## 10 Oceania   Australia         70.3     71.1     73.5     76.3     78.8     81.2
## # ℹ 1 more variable: Timeline <list>

2.3 Add bullet charts

As we know, the gapminder data set is much larger than what we show here. In fact, we have the same data for many more countries. But showing all of that information would make the table HUUUGE.

We could still use that information, though. Here, we could put the life expectancy of our selected countries into context. For example, for each country let us compare its life expectancy to the mean life expectancy of its continent . A so-called bullet chart will do the trick. Check it out.

Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007 Comparison 2007
continent mean | country
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14
Singapore 63.18 67.95 70.80 73.56 77.16 79.97
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20
Australia 70.33 71.10 73.49 76.32 78.83 81.23

In this table you can see that Sierra Leone’s life expectancy in 2007 is way below Africa’s mean life expectancy. In contrast, Egypt’s life expectancy is much higher than Africa’s mean life expectancy.

So, how do we create this table? Well, do you remember the first step of getting fancy plots into your table? That’s right. Expand your tibble with the necessary data for your plot.

In this case, that’s two things: The life expectancy of a country in 2007 and the continent’s mean life expectancy. So, we’re going to add two new columns. One of the columns will just be a duplicate of an already existent column though.

mean_life_exps <- gapminder_data |> 
  filter(year == "2007") |> 
  group_by(continent) |> 
  summarise(mean_life_exp = mean(life_exp))

selected_countries_joined_info <- selected_countries |> 
  left_join(mean_life_exps, by = 'continent') |> 
  mutate(rep2007 = year2007)
selected_countries_joined_info
## # A tibble: 10 × 10
##    continent country       year1957 year1967 year1977 year1987 year1997 year2007
##    <fct>     <chr>            <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
##  1 Africa    Egypt             44.4     49.3     53.3     59.8     67.2     71.3
##  2 Africa    Sierra Leone      31.6     34.1     36.8     40.0     39.9     42.6
##  3 Americas  Nicaragua         45.4     51.9     57.5     62.0     68.4     72.9
##  4 Americas  Jamaica           62.6     67.5     70.1     71.8     72.3     72.6
##  5 Asia      Syria             48.3     53.7     61.2     67.0     71.5     74.1
##  6 Asia      Singapore         63.2     67.9     70.8     73.6     77.2     80.0
##  7 Europe    Netherlands       73.0     73.8     75.2     76.8     78.0     79.8
##  8 Europe    United Kingd…     70.4     71.4     72.8     75.0     77.2     79.4
##  9 Oceania   New Zealand       70.3     71.5     72.2     74.3     77.6     80.2
## 10 Oceania   Australia         70.3     71.1     73.5     76.3     78.8     81.2
## # ℹ 2 more variables: mean_life_exp <dbl>, rep2007 <dbl>

Next step is using the two new columns in a layer that creates the bullet chart. That’s gt_plt_bullet(). Two of its arguments are designed for the two new columns.

selected_countries_joined_info |> 
## Do table as before
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538() |> 
  gt_color_rows(
    columns = c(year1957, year2007), 
    domain = c(30, 85),
    palette = color_palette
  ) |> 
## Use mean_life_exp and rep2007
  gt_plt_bullet(
    column = rep2007,
    target = mean_life_exp,
    palette = c("dodgerblue4", "dodgerblue1"),
    width = 45 # width in px
  )
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007 rep2007
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14
Singapore 63.18 67.95 70.80 73.56 77.16 79.97
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20
Australia 70.33 71.10 73.49 76.32 78.83 81.23

Finally, we need to relabel the rep2007 column with cols_label(). And to make the new label use colors, we will have to write a label with HTML. Here’s what you need to know for that:

  • <br> is a line break in HTML
  • <span style="color:red;font-size:24pt;">some text</span> would result in some text.

So, just create a character variable in R that uses this Syntax and let gt() know that you mean business HTML. The latter can be done with html().

# I like to use str_c() to connect strings to make the text less messy
html_text <- str_c(
  'Comparison 2007',
  '<br>',
  '<span style="color:#1e90ff;display:inline;">',
  'continent mean', 
  '</span> | ',
  '<span style="color:#104e8b;display:inline;">',
  'country',
  '</span>'
)

selected_countries_joined_info |> 
## Do table as before
  gt(groupname_col = 'continent') |> 
  tab_header(
    title = 'Life Expectancies over time',
    subtitle = 'Data is courtesy of the Gapminder foundation'
  ) |> 
  cols_label(.list = new_colnames) |> 
  fmt_number(columns = where(is.numeric), decimals = 2) |> 
  gt_theme_538() |> 
  gt_color_rows(
    columns = c(year1957, year2007), 
    domain = c(30, 85),
    palette = color_palette
  ) |> 
## Target mean_life_exp column and change it's column name
  gt_plt_bullet(
    column = rep2007,
    target = mean_life_exp,
    palette = c("dodgerblue4", "dodgerblue1"),
    width = 45
  ) |> 
  cols_label(rep2007 = html(html_text))
Life Expectancies over time
Data is courtesy of the Gapminder foundation
1957 1967 1977 1987 1997 2007 Comparison 2007
continent mean | country
Africa
Egypt 44.44 49.29 53.32 59.80 67.22 71.34
Sierra Leone 31.57 34.11 36.79 40.01 39.90 42.57
Americas
Nicaragua 45.43 51.88 57.47 62.01 68.43 72.90
Jamaica 62.61 67.51 70.11 71.77 72.26 72.57
Asia
Syria 48.28 53.66 61.20 66.97 71.53 74.14
Singapore 63.18 67.95 70.80 73.56 77.16 79.97
Europe
Netherlands 72.99 73.82 75.24 76.83 78.03 79.76
United Kingdom 70.42 71.36 72.76 75.01 77.22 79.42
Oceania
New Zealand 70.26 71.52 72.22 74.32 77.55 80.20
Australia 70.33 71.10 73.49 76.32 78.83 81.23

2.4 Include icons in your tables

Adding icons to any {gt} table is easy. You don’t actually need anything but the icon itself. Thankfully, R has just the right {emoji} package to get the work done. Once you’ve got the data, just send that to gt() and you’re done.

vegetables <- tibble(
  Vegetable = c('eggplant', 'cucumber', 'broccoli', 'garlic', 'onion')
) |> 
  mutate(
# Apply emoji() function to every text from Vegetable column
    Emoji = map_chr(Vegetable, emoji::emoji),
    Vegetable = str_to_title(Vegetable)
  ) 
vegetables
## # A tibble: 5 × 2
##   Vegetable Emoji
##   <chr>     <chr>
## 1 Eggplant  🍆   
## 2 Cucumber  🥒   
## 3 Broccoli  🥦   
## 4 Garlic    🧄   
## 5 Onion     🧅

vegetables |> 
  gt() |> 
  tab_header(
    title = 'VegeTABLE',
    subtitle = 'Emojis are taken from the {emoji} package'
  ) |> 
# This part makes emojis larger
  tab_style(
    style = list(cell_text(size = px(25))),
    locations = cells_body(columns = 'Emoji')
  )
VegeTABLE
Emojis are taken from the {emoji} package
Vegetable Emoji
Eggplant 🍆
Cucumber 🥒
Broccoli 🥦
Garlic 🧄
Onion 🧅

Notice that I have increased the size of the emojis here. Think of this as a teaser for what we’re going to do in Section 4.1.

The same works with fontawesome icons as well. But you have to be a little bit more careful in that case. The {fontawesome} package will give you an icon as HTML code. Thus, you need to wrap the output from fontawesome::fa() in html().

brands <- tibble(
  Brand = c('twitter', 'facebook', 'linkedin', 'github'),
  color = c('#1DA1F2', '#4267B2', '#0077B5', '#333' )
) |>
  mutate(
# Apply fa() function with all values from columns Brand and color
    Emoji = map2(Brand, color, ~fontawesome::fa(.x, fill = .y)),
# Apply html() function to previous results
    Emoji = map(Emoji, html),
    Brand = str_to_title(Brand)
  ) |>
  select(-color)
brands
## # A tibble: 4 × 2
##   Brand    Emoji     
##   <chr>    <list>    
## 1 Twitter  <html [1]>
## 2 Facebook <html [1]>
## 3 Linkedin <html [1]>
## 4 Github   <html [1]>

brands |>
  gt() |>
  tab_header(
    title = 'Brand table',
    subtitle = 'Icons are taken from the {fontawesome} package'
  )  |>
# This part makes emojis larger
  tab_style(
    style = list(cell_text(size = px(25))),
    locations = cells_body(columns = 'Emoji')
  )
Brand table
Icons are taken from the {fontawesome} package
Brand Emoji
Twitter
Facebook
Linkedin
Github

2.5 Include images in your tables

The easiest way to add images to your table is to rely on gt_img_rows() from {gtExtras}. Just add a column with file paths/URLs of images to your tibble. Then, target that column with gt_img_rows() and your work is done.

For example, you could use this to get images of the last four British prime ministers from Wikipedia and use them in a table.3

pm_data <- tribble(
  ~Name, ~Image,
  'Rishi Sunak', 'https://upload.wikimedia.org/wikipedia/commons/thumb/0/09/Rishi_Sunak%27s_first_speech_as_Prime_Minister_Front_%28cropped%29.jpg/1024px-Rishi_Sunak%27s_first_speech_as_Prime_Minister_Front_%28cropped%29.jpg',
  'Liz Truss', 'https://upload.wikimedia.org/wikipedia/commons/thumb/1/16/Liz_Truss_official_portrait_%28cropped%292.jpg/292px-Liz_Truss_official_portrait_%28cropped%292.jpg',
  'Boris Johnson', 'https://upload.wikimedia.org/wikipedia/commons/thumb/7/76/Boris_Johnson_official_portrait_%28cropped%29.jpg/288px-Boris_Johnson_official_portrait_%28cropped%29.jpg',
  'Theresa May', 'https://upload.wikimedia.org/wikipedia/commons/thumb/d/d1/Official_portrait_of_Baroness_May_of_Maidenhead_crop_2.jpg/1024px-Official_portrait_of_Baroness_May_of_Maidenhead_crop_2.jpg'
)

pm_data |>
  gt() |>
  gt_img_rows(columns = 'Image', height = 100)
Name Image
Rishi Sunak
Liz Truss
Boris Johnson
Theresa May

It used to be that you could also use gt_img_circle() from the {gtExtras} package. Instead of square images, it gave you image circles. But this function doesn’t work anymore.

Luckily, it’s not too hard to take the gt_img_rows() function and throw of a little bit of css magic on top to rebuild gt_img_circle(). But don’t worry. If you’re not a fan of CSS, you can just take the function I give you below. And in case you’re wondering what text_transform() does: Just ignore that until the next section. There, everything will be explained.

pm_data_round <- tribble(
  ~Name, ~Image,
  'Rishi Sunak', 'https://pbs.twimg.com/profile_images/1572638567381307394/AEahAxu5_400x400.jpg',
  'Liz Truss', 'https://pbs.twimg.com/profile_images/1847347554771435520/qwbWVRDK_400x400.jpg',
  'Boris Johnson', 'https://pbs.twimg.com/profile_images/1678440881890680832/ootyWocq_400x400.jpg',
  'Theresa May', 'https://pbs.twimg.com/profile_images/936639677121081344/_e5l_DEG_400x400.jpg'
)
my_gt_img_circles <- function(gt_tbl, columns, height_px) {
  gt_tbl |>
    gt_img_rows(columns = columns, height = 100) |> 
    text_transform(
      locations = cells_body(columns = columns),
      fn = function(x) {
        css_style <- htmltools::css(
          border_radius = '100%',
          border = '2px solid black',
          overflow = 'hidden',
          height = glue::glue('{height_px}px'),
          width = glue::glue('{height_px}px')
        )
        glue::glue(
          '<div style = "{css_style}">{x}</div>'
        )
      }
    )
}
pm_data_round |>
  gt() |>
  my_gt_img_circles(columns = 'Image', height_px = 100)
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(columns)
## 
##   # Now:
##   data %>% select(all_of(columns))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
Name Image
Rishi Sunak
Liz Truss
Boris Johnson
Theresa May

2.6 Add arbitrary plots to your table

So far we’ve learned to add spark lines, bullet charts, icons and images to our tables. There are some other cool visual elements that can be added with help from {gtExtras}. You should definitely check out its documentation to see the full list.

For my final trick of this chapter, I’m going to show you how you can add any ggplot to your table. For example, we could look at our penguins from the last chapter again. Here’s a table about their weight and its distribution (visualized with a violin plot.)

Species
Penguin's Weight
Min Mean Max Distribution
Adelie 2850 3706.16 4775
Chinstrap 2700 3733.09 4800
Gentoo 3950 5092.44 6300

To create this table, let us begin with the basics. Let’s compute the numeric values first.

filtered_penguins <- palmerpenguins::penguins |>
    filter(!is.na(sex))

penguin_weights <- filtered_penguins |>
  group_by(species) |>
  summarise(
    Min = min(body_mass_g),
    Mean = mean(body_mass_g) |> round(digits = 2),
    Max = max(body_mass_g)
  ) |>
  mutate(species = as.character(species)) |>
  rename(Species = species)

penguin_weights |>
  gt() |>
  tab_spanner(
    label = 'Penguin\'s Weight',
    columns = -Species
  )
Species
Penguin's Weight
Min Mean Max
Adelie 2850 3706.16 4775
Chinstrap 2700 3733.09 4800
Gentoo 3950 5092.44 6300

Next, let us write a function plot_violin_species(my_species) that depends on a penguin species and creates one violin plot.

plot_density_species <- function(my_species) {
  full_range <- filtered_penguins |>
    pull(body_mass_g) |>
    range()

  filtered_penguins |>
    filter(species == my_species) |>
    ggplot(aes(x = body_mass_g, y = species)) +
    geom_violin(fill = 'dodgerblue4') +
    theme_minimal() +
    scale_y_discrete(breaks = NULL) +
    scale_x_continuous(breaks = NULL) +
    labs(x = element_blank(), y = element_blank()) +
    coord_cartesian(xlim = full_range)
}
plot_density_species('Adelie')

Notice that I have set the coordinate system of the plot to the full range of the data (regardless of the species). This part is important. Without this trick, the three plots would not share a common x-axis. Then, our table might look something like this:

Species
Penguin's Weight
Min Mean Max Distribution
Adelie 2850 3706.16 4775
Chinstrap 2700 3733.09 4800
Gentoo 3950 5092.44 6300

WATCH OUT: The violin plots are not using a shared axis here and are misleading

Ok, so now we have a function that creates the desired plots. Time to apply it to our table. For this to work, we need an additional column that we can target (just like before).

penguin_weights |>
  mutate(Distribution = Species) |> 
  gt() |>
  tab_spanner(
    label = 'Penguin\'s Weight',
    columns = -Species
  )
Species
Penguin's Weight
Min Mean Max Distribution
Adelie 2850 3706.16 4775 Adelie
Chinstrap 2700 3733.09 4800 Chinstrap
Gentoo 3950 5092.44 6300 Gentoo

Next, use the text_transform() layer to turn the species names into ggplot images. This layer can actually target not just the data rows but everything including column labels or the table header.

So, we have to make sure that we attempt to turn only the data table cells into an image and not, say, the spanner. This is done with the helper function cells_body() (more on this function in Section 4.1). Here’s how that will look.

penguin_weights |>
  mutate(Distribution = Species) |> 
  gt() |>
  tab_spanner(
    label = 'Penguin\'s Weight',
    columns = -Species
  ) |>
  text_transform(
    locations = cells_body(columns = 'Distribution'),
    fn = #Put function here
  )

Finally, we need to set the fn argument to a function that takes a column and returns actual images. This is not our plot_density_species() function. This one takes only one species name and returns one ggplot object.

But we can wrap it in map() such that a column is turned into a list of ggplot objects. The conversion to images is performed by ggplot_image(). We can use it to also specify the height and width (indirectly via aspect ratio) of the image.

penguin_weights |>
  mutate(Distribution = Species) |> 
  gt() |>
  tab_spanner(
    label = 'Penguin\'s Weight',
    columns = -Species
  ) |>
  text_transform(
    locations = cells_body(columns = 'Distribution'),
    fn = function(column) {
      map(column, plot_density_species) |>
        ggplot_image(height = px(50), aspect_ratio = 3)
    }
  )
Species
Penguin's Weight
Min Mean Max Distribution
Adelie 2850 3706.16 4775
Chinstrap 2700 3733.09 4800
Gentoo 3950 5092.44 6300

We can take this up a notch. What if our plot depends on two or more variables? For example, we could label the mean weight of each species with a white line and the maximum with a red dot.

Yeah, I know. Totally arbitrary example. But it’s as good as any example, I suppose.

So first you will need a new function that depends on three arguments. But you have to make sure that all numeric variables are understood as characters. Because that’s how they will come in (you’ll see why in a sec). To use them as actual numbers, convert them from text to number via parse_number().

plot_density_species_with_mean <- function(my_species, my_mean, my_max) {
  full_range <- filtered_penguins |>
    pull(body_mass_g) |>
    range()

  filtered_penguins |>
    filter(species == my_species) |>
    ggplot(aes(x = body_mass_g, y = species)) +
    geom_violin(fill = 'dodgerblue4') +
    geom_vline(
      xintercept = parse_number(my_mean), # Parse number
      color = 'white',
      linewidth = 3
    ) +
    annotate(
      'point', 
      x = parse_number(my_max), # Parse number
      y = 1, 
      color = 'red', 
      size = 25 ## Needs to be large since the image is small
    ) +
    theme_minimal() +
    scale_y_discrete(breaks = NULL) +
    scale_x_continuous(breaks = NULL) +
    labs(x = element_blank(), y = element_blank()) +
    coord_cartesian(xlim = full_range)
}
plot_density_species_with_mean('Adelie', '3700', '4775')

Next, we have to create a new column in our tibble that contains all the data. In this case, this means collecting Species, Mean and Max in a vector and wrapping that vector in a list.

penguins_new <- penguin_weights |> 
  group_by(Species) |> 
  mutate(Distribution = list(c(Species, Mean, Max))) |> 
  ungroup()
penguins_new
## # A tibble: 3 × 5
##   Species     Min  Mean   Max Distribution
##   <chr>     <int> <dbl> <int> <list>      
## 1 Adelie     2850 3706.  4775 <chr [3]>   
## 2 Chinstrap  2700 3733.  4800 <chr [3]>   
## 3 Gentoo     3950 5092.  6300 <chr [3]>

Now comes the hard part. It requires a little bit of hacking. In principle, you have to write a function that transforms our table column Distribution into a ggplot. But take a look how Distribution looks in the table.

penguins_new |> 
  gt()
Species Min Mean Max Distribution
Adelie 2850 3706.16 4775 Adelie, 3706.16, 4775
Chinstrap 2700 3733.09 4800 Chinstrap, 3733.09, 4800
Gentoo 3950 5092.44 6300 Gentoo, 5092.44, 6300

Our beautiful list of arguments for plot_density_species_with_mean() is saved as a text. This means that this extra function fn that we’re going to pass to text_transform() needs to do a couple of things.

  1. Split the texts into separate arguments with str_split_1() (better output than str_split())
  2. Pass the lists of arguments to plot_density_species_with_mean() and make sure that the arguments are placed correctly.
  3. Convert ggplot objects to images with ggplot_image().

And task 1 and 2 need to be wrapped in map() because they don’t work on whole columns.

penguins_new |> 
  gt() |>
  text_transform(
    locations = cells_body(columns = 'Distribution'),
    fn = function(column) {
      map(column, ~str_split_1(., ', ')) |>
        map(~plot_density_species_with_mean(.[1], .[2], .[3])) |>
        ggplot_image(height = px(50), aspect_ratio = 3)
    }
  )
Species Min Mean Max Distribution
Adelie 2850 3706.16 4775
Chinstrap 2700 3733.09 4800
Gentoo 3950 5092.44 6300

2.7 Summary

Sweet! We’ve learned a lot of fancy table elements. Some of them were quite easy to implement. Some of them not so much.

In the next chapter, we’re going to take a breather. We’re going to learn about the two families of sub_* and fmt_*. They’re super easy to learn and crucial for formatting the data in your table.

  1. You can also get similar results with the gt::data_color() function. Currently, I prefer the gtExtras::gt_color_rows() function because it allows me to set domain.↩︎

  2. Thank you, Brani, for pointing this out to me.↩︎

  3. This is the current list (November 12, 2022). The British change PMs quite often recently.↩︎