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 rowsLet’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 | |
|---|---|---|---|---|---|---|
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 ¹year2007From 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 | ||||||
| Africa | ||||||
|---|---|---|---|---|---|---|
| Americas | ||||||
| Asia | ||||||
| Europe | ||||||
| Oceania | ||||||
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 | ||||||
| Africa | ||||||
|---|---|---|---|---|---|---|
| Americas | ||||||
| Asia | ||||||
| Europe | ||||||
| Oceania | ||||||
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 | ||||||
| Africa | ||||||
|---|---|---|---|---|---|---|
| Americas | ||||||
| Asia | ||||||
| Europe | ||||||
| Oceania | ||||||
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 | |||||||
| Africa | |||||||
|---|---|---|---|---|---|---|---|
| Americas | |||||||
| Asia | |||||||
| Europe | |||||||
| Oceania | |||||||
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.
- Take the original data set
gapminder_dataand filter it such that it contains the same years and countries as our data setselected_countries - Group the filtered data set by
countryand runsummarise(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 rowslife_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 | |||||||
| Africa | |||||||
|---|---|---|---|---|---|---|---|
| Americas | |||||||
| Asia | |||||||
| Europe | |||||||
| Oceania | |||||||
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 | |||||||
| Africa | |||||||
|---|---|---|---|---|---|---|---|
| Americas | |||||||
| Asia | |||||||
| Europe | |||||||
| Oceania | |||||||
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
tibblebefore even callinggt(). 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 year1…¹ year1…² year1…³ year1…⁴ year1…⁵ year2…⁶ Timel…⁷
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <list>
## 1 Africa Egypt 44.4 49.3 53.3 59.8 67.2 71.3 <dbl>
## 2 Africa Sierra Leo… 31.6 34.1 36.8 40.0 39.9 42.6 <dbl>
## 3 Americas Nicaragua 45.4 51.9 57.5 62.0 68.4 72.9 <dbl>
## 4 Americas Jamaica 62.6 67.5 70.1 71.8 72.3 72.6 <dbl>
## 5 Asia Syria 48.3 53.7 61.2 67.0 71.5 74.1 <dbl>
## 6 Asia Singapore 63.2 67.9 70.8 73.6 77.2 80.0 <dbl>
## 7 Europe Netherlands 73.0 73.8 75.2 76.8 78.0 79.8 <dbl>
## 8 Europe United Kin… 70.4 71.4 72.8 75.0 77.2 79.4 <dbl>
## 9 Oceania New Zealand 70.3 71.5 72.2 74.3 77.6 80.2 <dbl>
## 10 Oceania Australia 70.3 71.1 73.5 76.3 78.8 81.2 <dbl>
## # … with abbreviated variable names ¹year1957, ²year1967, ³year1977, ⁴year1987,
## # ⁵year1997, ⁶year2007, ⁷Timeline2.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 | |||||||
| Africa | |||||||
|---|---|---|---|---|---|---|---|
| Americas | |||||||
| Asia | |||||||
| Europe | |||||||
| Oceania | |||||||
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 year1…¹ year1…² year1…³ year1…⁴ year1…⁵ year2…⁶ mean_…⁷
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Africa Egypt 44.4 49.3 53.3 59.8 67.2 71.3 54.8
## 2 Africa Sierra Leo… 31.6 34.1 36.8 40.0 39.9 42.6 54.8
## 3 Americas Nicaragua 45.4 51.9 57.5 62.0 68.4 72.9 73.6
## 4 Americas Jamaica 62.6 67.5 70.1 71.8 72.3 72.6 73.6
## 5 Asia Syria 48.3 53.7 61.2 67.0 71.5 74.1 70.7
## 6 Asia Singapore 63.2 67.9 70.8 73.6 77.2 80.0 70.7
## 7 Europe Netherlands 73.0 73.8 75.2 76.8 78.0 79.8 77.6
## 8 Europe United Kin… 70.4 71.4 72.8 75.0 77.2 79.4 77.6
## 9 Oceania New Zealand 70.3 71.5 72.2 74.3 77.6 80.2 80.7
## 10 Oceania Australia 70.3 71.1 73.5 76.3 78.8 81.2 80.7
## # … with 1 more variable: rep2007 <dbl>, and abbreviated variable names
## # ¹year1957, ²year1967, ³year1977, ⁴year1987, ⁵year1997, ⁶year2007,
## # ⁷mean_life_expNext 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 | |||||||
| Africa | |||||||
|---|---|---|---|---|---|---|---|
| Americas | |||||||
| Asia | |||||||
| Europe | |||||||
| Oceania | |||||||
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 | |||||||
| Africa | |||||||
|---|---|---|---|---|---|---|---|
| Americas | |||||||
| Asia | |||||||
| Europe | |||||||
| Oceania | |||||||
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 |
|---|---|
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 |
|---|---|
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/a/af/Theresa_May_cropped.png/291px-Theresa_May_cropped.png'
)
pm_data |>
gt() |>
gt_img_rows(columns = 'Image', height = 100)| Name | Image |
|---|---|
Alternatively, you can use gt_img_circle(). This will give you round images. But you have to be careful that your column width matches the height of your image. You can achieve that with cols_width(). This function’s syntax is really simple. Basically, it’s cols_width(column ~ px(<number of pixels>)).
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/1514636699946602499/hUoOgAOz_400x400.jpg',
'Boris Johnson', 'https://pbs.twimg.com/profile_images/1500170386520129536/Rr2G6A-N_400x400.jpg',
'Theresa May', 'https://pbs.twimg.com/profile_images/936639677121081344/_e5l_DEG_400x400.jpg'
)
pm_data_round |>
gt() |>
gt_img_circle(column = 'Image', height = 100, border_weight = 1) |>
cols_width(Image ~ px(110)) # 110 = 100 (height) + 10 (padding around imgs)| Name | Image |
|---|---|
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 | ||||
|---|---|---|---|---|
| Min | Mean | Max | Distribution | |
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 | |||
|---|---|---|---|
| Min | Mean | Max | |
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 | ||||
|---|---|---|---|---|
| Min | Mean | Max | Distribution | |
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 | ||||
|---|---|---|---|---|
| Min | Mean | Max | Distribution | |
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 | ||||
|---|---|---|---|---|
| Min | Mean | Max | Distribution | |
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 |
|---|---|---|---|---|
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.
- Split the texts into separate arguments with
str_split_1()(better output thanstr_split()) - Pass the lists of arguments to
plot_density_species_with_mean()and make sure that the arguments are placed correctly. - 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 |
|---|---|---|---|---|
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.