Get access to all lessons in this course.
- Get Data Into the Right Format to Create your First Table
- Use better column names and a title
- Align columns
- Use groups instead of repetitive columns
- Format your table's numbers
- Add summaries
- Add additional horizontal lines
- Add background colors
- Change the text appearance
- Change cell properties
- Export Your Tables
- Heat map columns
- Adding Charts with Flextable
- Add your own ggplot
- Case Study
Making Beautiful Tables with R
Case Study
This lesson is locked
This lesson is called Case Study, part of the Making Beautiful Tables with R course. This lesson is called Case Study, part of the Making Beautiful Tables with R course.
Transcript
Click on the transcript to go to that point in the video. Please note that transcripts are auto generated and may contain minor inaccuracies.
View code shown in video
library(officer)
library(flextable)
library(tidyverse)
library(lubridate)
big_tech_stock_prices <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-02-07/big_tech_stock_prices.csv')
big_tech_companies <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-02-07/big_tech_companies.csv')
stocks <- big_tech_stock_prices |>
left_join(big_tech_companies) |>
arrange(company, date)
covid_period <- stocks |>
filter(date %in% c(make_date(2020, 1, 2), make_date(2022, 12, 29)))
covid_changes <- covid_period |>
group_by(stock_symbol, company) |>
nest() |>
mutate(
change_abs = map_dbl(data, \(x) (x$open[2] - x$open[1])),
change_rel = map_dbl(data, \(x) (x$open[2]/x$open[1] - 1)),
percent = scales::percent(change_rel, accuracy = 0.01)
) |>
ungroup() |>
arrange(change_rel) |>
select(-data)
open_prices <- covid_period |>
select(stock_symbol, open, date) |>
mutate(date = as.character(year(date))) |>
pivot_wider(
id_cols = stock_symbol,
names_from = date,
names_prefix = 'open',
values_from = 'open'
)
chart_line_color <- 'grey20'
chart_segment_color_pos <- 'seagreen'
chart_segment_color_neg <- 'firebrick4'
tbl_data <- covid_changes |>
left_join(open_prices) |>
select(company, open2020, open2022, change_abs, percent, stock_symbol) |>
mutate(
company = if_else(stock_symbol == 'IBM', 'IBM', company),
company = str_remove(company, '(,)? Inc\\.'),
company = str_remove(company, ' (Corporation|Platforms|Systems)'),
company = str_remove(company, '\\.com')
)
plot_stock_evolution <- function(stock_symbol) {
single_stock <- stocks |>
filter(
date %within% interval(make_date(2020, 1, 2), make_date(2022, 12, 29)),
stock_symbol == !!stock_symbol
)
single_covid_period <- covid_period |>
filter(stock_symbol == !!stock_symbol)
single_covid_change <- covid_changes |>
filter(stock_symbol == !!stock_symbol) |>
pull(change_abs)
segment_color <- if (single_covid_change > 0) chart_segment_color_pos else chart_segment_color_neg
single_stock |>
ggplot(aes(date, open)) +
geom_line(col = chart_line_color, linewidth = 1) +
geom_line(data = single_covid_period, color = segment_color, linewidth = 1.25) +
theme_void()
}
list_of_ggplots <- map(tbl_data$stock_symbol, plot_stock_evolution)
default_font <- 'Source Sans Pro'
default_font_color <- 'grey20'
default_font_size <- 12
set_flextable_defaults(
font.family = default_font,
font.color = default_font_color,
font.size = default_font_size,
border.color = 'grey40',
)
tbl_data |>
flextable() |>
set_header_labels(
stock_symbol = 'Opening prices over time',
company = '',
logo = '',
open2020 = 'Jan 02, 2020',
open2022 = 'Dec 29, 2022',
change_abs = 'abs.',
percent = 'rel.'
) |>
add_header_row(
values = c('', 'Opening Prices', 'Change', ''),
colwidths = c(1, 2, 2, 1)
) |>
add_header_lines(
values = c('Not all tech companies are COVID winners',
'During the pandemic, tech companies were hyped as COVID winners. Their stock prices surged while most other companies struggled. But not every tech company was so lucky in the end.')
) |>
align(j = 'percent', align = 'right', part = 'header') |>
align(j = 'percent', align = 'right', part = 'body') |>
align(i = 3, part = 'header', align = 'center') |>
flextable::compose(
j = 'stock_symbol',
value = as_paragraph(
gg_chunk(
value = list_of_ggplots,
width = 7,
height = 1,
unit = 'cm'
)
)
) |>
autofit() |>
width(j = 'stock_symbol', width = 6, unit = 'cm') |>
set_formatter(
open2020 = function(x) scales::dollar(x),
open2022 = function(x) scales::dollar(x),
change_abs = function(x) scales::dollar(x)
) |>
border(
i = 1:3,
part = 'header',
border.bottom = fp_border_default(width = 1),
border.top = fp_border_default(width = 1)
) |>
border(
i = 14,
border.bottom = fp_border_default(width = 1.5)
) |>
border(i = 1, border.bottom = fp_border_default(width = 0), part = 'header') |>
border(i = 2, border.top = fp_border_default(width = 0), part = 'header') |>
border(i = 3, j = c(1, 6), border.bottom = fp_border_default(width = 0), part = 'header') |>
border(i = 4, j = c(1, 6), border.top = fp_border_default(width = 0), part = 'header') |>
style(
i = 3, j = 2:5,
pr_t = fp_text_default(
bold = TRUE
),
part = 'header'
) |>
style(
i = 4, j = 6, part = 'header',
pr_t = fp_text_default(bold = TRUE)
) |>
style(
i = ~ change_abs < 0,
j = c('change_abs', 'percent'),
pr_t = fp_text_default(
bold = TRUE,
color = chart_segment_color_neg
)
) |>
style(
i = ~ change_abs >= 0,
j = c('change_abs', 'percent'),
pr_t = fp_text_default(
bold = TRUE,
color = chart_segment_color_pos
)
) |>
style(
i = 1, part = 'header',
pr_t = fp_text_default(
font.size = 24,
font.family = 'Merriweather',
bold = TRUE
)
) |>
style(
i = 2, part = 'header',
pr_t = fp_text_default(
font.size = 16,
font.family = 'Source Sans Pro'
)
) |>
border(
i = 1:13,
border.bottom = fp_border_default(color = 'grey80', width = 0.5)
)
You need to be signed-in to comment on this post. Login.