library(tidyverse)
library(gt)
levels <- c('Standard', 'Popular', 'Golden', 'Ultimate')
prices <- c(15, 25, 35, 50)
names(prices) <- levels
prices
## Standard Popular Golden Ultimate
## 15 25 35 50
features <- c('Beginner Classes', 'Training Overview', 'Personal Training', 'Olympic Weightlifting', 'Foundation Training')
dat <- tibble(
level = levels,
monthly_price = prices[levels],
features = list(features[1], features[1:2], features[1:3], features),
booking_link = 'https://www.youtube.com/watch?v=dQw4w9WgXcQ'
) |>
unnest(features) |>
select(level, features)
dat
## # A tibble: 11 × 2
## level features
## <chr> <chr>
## 1 Standard Beginner Classes
## 2 Popular Beginner Classes
## 3 Popular Training Overview
## 4 Golden Beginner Classes
## 5 Golden Training Overview
## 6 Golden Personal Training
## 7 Ultimate Beginner Classes
## 8 Ultimate Training Overview
## 9 Ultimate Personal Training
## 10 Ultimate Olympic Weightlifting
## 11 Ultimate Foundation Training
level_colors <- c(
Standard = "#c40d53",
Popular = "#26559b",
Golden = "#f90",
Ultimate = "#0d833e"
)
level_colors
## Standard Popular Golden Ultimate
## "#c40d53" "#26559b" "#f90" "#0d833e"5 Case studies
5.1 Fitness pricing
In this chapter we’re going to build this Fitness pricing table I found online. It’s not really a data table but it’s a fun exercise to build this.
Notice that I’ve even added a little interactive element. You can hover over the booking button. And clicking it redirects you to a certain web page. To get started, let us define the data we need.
5.1.1 Feature tables
From this we can create a table for the features of a single tier, e.g. the “Popular” tier. First, we need to create the data set for this. To do so, we’re going to proceed as follows:
- Filter
datso that we have only the features of our current tier - Add a new column
in_leveland set it to true (since all the filtered features are in the tier) - Expand the tibble so that the other features are also present in the data set (with
in_levelfalse)
level <- 'Popular'
dat |>
## We use !! here so that this filter actually filters
filter(level == !!level) |>
mutate(in_level = TRUE) |>
complete(
expand(dat, features),
fill = list(in_level = FALSE, level = 'Popular')
)
## # A tibble: 5 × 3
## features level in_level
## <chr> <chr> <lgl>
## 1 Beginner Classes Popular TRUE
## 2 Foundation Training Popular FALSE
## 3 Olympic Weightlifting Popular FALSE
## 4 Personal Training Popular FALSE
## 5 Training Overview Popular TRUENext, we can throw away the level column and sort the rows by the features (which we saved in the vector features).
level <- 'Popular'
dat |>
## We use !! here so that this filter actually filters
filter(level == !!level) |>
mutate(in_level = TRUE) |>
complete(
expand(dat, features),
fill = list(in_level = FALSE, level = 'Popular')
) |>
select(in_level, features) |>
arrange(features = fct_relevel(features, !!features))
## # A tibble: 5 × 2
## in_level features
## <lgl> <chr>
## 1 TRUE Beginner Classes
## 2 TRUE Training Overview
## 3 FALSE Personal Training
## 4 FALSE Olympic Weightlifting
## 5 FALSE Foundation TrainingFinally, we turn the column in_level into fontawesome icons. The colors of these icons are taken from our vector level_colors.
level_data <- dat |>
## We use !! here so that this filter actually filters
filter(level == !!level) |>
mutate(in_level = TRUE) |>
complete(
expand(dat, features),
fill = list(in_level = FALSE)
) |>
select(in_level, features) |>
arrange(features = fct_relevel(features, !!features)) |>
mutate(
in_level = ifelse(
in_level,
fontawesome::fa('check', fill = level_colors[level]) |> html(),
fontawesome::fa('xmark', fill = level_colors[level]) |> html()
)
)
level_data
## # A tibble: 5 × 2
## in_level features
## <chr> <chr>
## 1 "<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 448 512\" styl… Beginne…
## 2 "<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 448 512\" styl… Trainin…
## 3 "<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 384 512\" styl… Persona…
## 4 "<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 384 512\" styl… Olympic…
## 5 "<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 384 512\" styl… Foundat…Sweet. Now we can turn this into a {gt} table. We have to use fmt_markdown() on our in_leel column so that the icons are actually displayed as icons. While we’re at it, we can style the table a tiny bit. This includes getting rid of the column labels.
level_data |>
gt() |>
fmt_markdown(columns = 'in_level') |>
cols_width(in_level ~ px(25), everything() ~ px(175)) |>
tab_options(
column_labels.hidden = TRUE,
table.font.names = 'Source Sans Pro',
table_body.border.top.style = 'none',
table.border.top.style = 'none',
table_body.border.bottom.style = 'none',
table.border.bottom.style = 'none',
table_body.hlines.style = 'none',
) | Beginner Classes | |
| Training Overview | |
| Personal Training | |
| Olympic Weightlifting | |
| Foundation Training |
Alright, this looks already pretty good. We’ll get rid of the grid lines once we have assembled the full table. Of course, we have to create this table for all tiers. So let’s wrap this into a function.
Code
tier_feature_table <- function(level) {
level_data <- dat |>
## We use !! here so that this filter actually filters
filter(level == !!level) |>
mutate(in_level = TRUE) |>
complete(
expand(dat, features),
fill = list(in_level = FALSE)
) |>
select(in_level, features) |>
arrange(features = fct_relevel(features, !!features)) |>
mutate(
in_level = ifelse(
in_level,
fontawesome::fa('check', fill = level_colors[level]) |> html(),
fontawesome::fa('xmark', fill = level_colors[level]) |> html()
)
)
level_data |>
gt() |>
fmt_markdown(columns = 'in_level') |>
cols_width(in_level ~ px(25), everything() ~ px(175)) |>
tab_options(
column_labels.hidden = TRUE,
table.font.names = 'Source Sans Pro',
table_body.border.top.style = 'none',
table.border.top.style = 'none',
table_body.border.bottom.style = 'none',
table.border.bottom.style = 'none',
table_body.hlines.style = 'none',
)
}tier_feature_table('Standard')| Beginner Classes | |
| Training Overview | |
| Personal Training | |
| Olympic Weightlifting | |
| Foundation Training |
tier_feature_table('Popular')| Beginner Classes | |
| Training Overview | |
| Personal Training | |
| Olympic Weightlifting | |
| Foundation Training |
tier_feature_table('Golden')| Beginner Classes | |
| Training Overview | |
| Personal Training | |
| Olympic Weightlifting | |
| Foundation Training |
tier_feature_table('Ultimate')| Beginner Classes | |
| Training Overview | |
| Personal Training | |
| Olympic Weightlifting | |
| Foundation Training |
And we can save all tables as HTML in a tibble. For such occasions, {gt} has the function as_raw_html().
tables_tib <- tibble(
level = levels,
table = map_chr(levels, ~as_raw_html(tier_feature_table(.)))
) |>
pivot_wider(names_from = level, values_from = table)
tables_tib
## # A tibble: 1 × 4
## Standard Popular Golden Ultimate
## <chr> <chr> <chr> <chr>
## 1 "<div id=\"cgzirftbov\" style=\"padding-left:0px;padd… "<div … "<div… "<div i…5.1.2 Prices and links
We can create similar tibbles for our prices. Really, this table contains only the HTML-text for the monthly price tag where the price is larger than the rest.
price_tib <- tibble(
level = levels,
price = paste0('$<span style="font-size:40px;">', prices, '</span>/month')
) |>
pivot_wider(names_from = level, values_from = price)
price_tib
## # A tibble: 1 × 4
## Standard Popular Golden Ultimate
## <chr> <chr> <chr> <chr>
## 1 "$<span style=\"font-size:40px;\">15</span>/month" "$<span st… "$<sp… "$<span…Next, we can create yet another similar tibble for our URLs. For this, I use the a() function from {htmltools} here. More precisely, I have wrapped a() into a function style_url() that turns a URL into a colored box.
style_url <- function(link, color) {
htmltools::a(
href = link,
"Book now",
style = glue::glue("border-radius: 5px;color: white;background-color: {color};border-radius: 5px;padding: 8px 20px;display: inline-block;text-decoration:none")
)
}
url_tib <- tibble(
level = levels,
level_colors = level_colors[level],
booking_link = 'https://www.youtube.com/watch?v=dQw4w9WgXcQ'
) |>
mutate(
booking_link = map2(booking_link, level_colors, style_url),
booking_link = map_chr(booking_link, ~as.character(.x))
) |>
select(-level_colors) |>
pivot_wider(names_from = level, values_from = booking_link)
url_tib
## # A tibble: 1 × 4
## Standard Popular Golden Ultimate
## <chr> <chr> <chr> <chr>
## 1 "<a href=\"https://www.youtube.com/watch?v=dQw4w9WgXc… "<a hr… "<a h… "<a hre…5.1.3 Assembling the tables
Now we can put everything together. And in order to get white space between the tiers, we insert a few empty dummy columns.
levels_text_size <- px(30)
unstyled_fitness_table <- bind_rows(price_tib, tables_tib, url_tib) |>
mutate(dummy1 = '', .after = 1) |>
mutate(dummy2 = '', .after = 3) |>
mutate(dummy3 = '', .after = 5) |>
gt(id = 'fitness_table') |>
fmt_markdown(columns = everything()) |>
cols_align(align = 'center') |>
cols_label(
dummy1 = '',
dummy2 = '',
dummy3 = ''
) |>
cols_width(
dummy1 ~ px(15),
dummy2 ~ px(15),
dummy3 ~ px(15)
) |>
tab_header(
title = 'Fitness Pricing Table'
) |>
tab_footnote(
footnote = 'Design/Inspiration: @supacode | {gt} Remake: @rappa753',
placement = 'right'
)
unstyled_fitness_tableAnd the rest is “just” a series of tab_style() calls plus tab_options() and a bit of custom CSS.
Code
unstyled_fitness_table |>
tab_style(
style = list(
cell_fill(color = level_colors['Standard']),
cell_text(color = 'white', weight = 'bold')
),
locations = list(
cells_body(columns = 'Standard', rows = 1),
cells_column_labels(column = 'Standard')
)
) |>
tab_style(
style = list(
cell_fill(color = level_colors['Popular']),
cell_text(color = 'white', weight = 'bold')
),
locations = list(
cells_body(columns = 'Popular', rows = 1),
cells_column_labels(column = 'Popular')
)
) |>
tab_style(
style = list(
cell_fill(color = level_colors['Golden']),
cell_text(color = 'white', weight = 'bold')
),
locations = list(
cells_body(columns = 'Golden', rows = 1),
cells_column_labels(column = 'Golden')
)
) |>
tab_style(
style = list(
cell_fill(color = level_colors['Ultimate']),
cell_text(color = 'white', weight = 'bold')
),
locations = list(
cells_body(columns = 'Ultimate', rows = 1),
cells_column_labels(column = 'Ultimate')
)
) |>
tab_style(
style = cell_text(size = levels_text_size),
locations = cells_column_labels()
) |>
tab_style(
style = list(cell_fill(color = 'white')),
locations = list(
cells_body(columns = contains('dummy')),
cells_column_labels(columns = contains('dummy'))
)
) |>
tab_style(
style = cell_borders(sides = 'bottom', color = '#D3D3D3'),
locations = cells_body(rows = 3, columns = c(1, 3, 5, 7))
) |>
tab_options(
table_body.border.top.style = 'none',
table.border.top.style = 'none',
table_body.border.bottom.style = 'none',
table.border.bottom.style = 'none',
table_body.hlines.style = 'none',
table_body.vlines.style = 'solid',
column_labels.border.top.style = 'none',
column_labels.border.bottom.style = 'none',
column_labels.border.lr.style = 'solid', # not working, set in css
column_labels.border.lr.width = px(1),
column_labels.padding = px(1),
data_row.padding = px(2),
table.font.names = 'Source Sans Pro',
heading.title.font.size = px(45),
heading.padding = px(10),
heading.border.bottom.style = 'none'
) |>
opt_css(
'#fitness_table .gt_footnote {
text-align: right; padding-top: 5px;
}
#fitness_table .gt_title {
font-family:"Oleo Script";
}
#fitness_table .gt_col_heading {
border-left-style:solid;
border-right-style:solid;
}
#fitness_table thead, tbody, tfoot, tr, td, th {
border-color: inherit;
border-style: solid;
border-width: 0;
}
#fitness_table a {
&:hover {
transform: translateY(-3px);
box-shadow: 0 5px 5px rgba(0, 0, 0, 0.4);
}
&:active {
box-shadow: inset 0 -3px 5px rgba(0, 0, 0, 0.4);
}
}
'
)5.2 NYT bestseller
This one is a recreation of an awesome table Tanya Shapiro made with {ggplot2}. It is a huge table, so you’ll probably need to look at this on a large screen. But just to be safe. Here’s a screenshot of the table as well.
| The New York Times Best Selling Authors Top authors by decade. Ranking based on number of weeks author appeared on list. Sparkline depicts total weeks by year (counts multiple books). Top performing book included beneath each author’s name. Data from Post45 Data Collective. |
||
