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
## # … with 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) 
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 year2…¹
##    <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 Kingdom     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
## # … with abbreviated variable name ¹​year2007

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
  )
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
## # … with 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