Case Study

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)
  )