Gundam gt (tidy tuesday)

gundam_gt.r

## Packages
pacman::p_load(tidyverse, scales, janitor, gt, rvest, polite, glue, webshot)

## Data
tidy_anime <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-04-23/tidy_anime.csv")

## get Gundam data
gundam_raw <- tidy_anime %>% 
  select(-related, -background, -premiered, -related, -members, -airing, -favorites,
         -title_synonyms, -title_japanese, -producers, -status, -broadcast, -genre, -source, -rank, -popularity) %>% 
  ## group by title and slice only top... otherwise 4593745 duplicate rows for each genre...
  group_by(title_english) %>% 
  slice(1) %>% 
  ungroup() %>% 
  ## filter for Gundam in title, filter for TV, OVA, Movie
  filter( str_detect(title_english, "Gundam"), type %in% c("TV", "OVA", "Movie")) %>% 
  ## filter out non-main story stuff and random shorts
  filter(!title_english %in% c("Mobile Suit Gundam SEED MSV Astray",
                               "Mobile Suit Gundam 0083: The Afterglow Of Zeon",
                               "Mobile Suit Gundam SEED Destiny Final Plus: The Chosen Future",
                               "Mobile Suit Gundam Unicorn Perfectibility",
                               "Mobile Suit Gundam Unicorn RE:0096",
                               "Mobile Suit Gundam Wing: Operation Meteor",
                               "Mobile Suit SD Gundam's Counterattack",
                               "Mobile Suit SD Gundam Festival",
                               "Musha, Knight, Commando: SD Gundam Emergency Sortie",
                               "Mobile Suit Zeta Gundam: A New Translation - Heir to the Stars",
                               "Mobile Suit Zeta Gundam: A New Translation II - Lovers",
                               "Mobile Suit Zeta Gundam: A New Translation III - Love Is the Pulse of the Stars",
                               "Mobile Suit Gundam 00 Special Edition",
                               "∀ Gundam I: Earth Light",
                               "∀ Gundam II: Moonlight Butterfly")) %>% 
  select(-duration, -scored_by, -synopsis) %>% 
  ## chronological order
  arrange(start_date)
  
## clean Gundam data

gundam_df <- gundam_raw %>% 
  ## calculate mean score for entire-ish franchise
  ## fill in end dates, for movies just fill with start_date
  mutate(avg_score = mean(score) %>% round(digits = 2),
         end_date = case_when(
           title_english == "Gundam Build Fighters Try" ~ as.Date("2015-04-01"),
           title_english == "Mobile Suit Gundam: Iron-Blooded Orphans 2nd Season" ~ as.Date("2017-04-02"),
           title_english == "Mobile Suit Gundam Unicorn" ~ as.Date("2014-06-06"),
           title_english == "Mobile Suit Gundam: The Origin" ~ as.Date("2018-05-05"),
           type == "Movie" ~ start_date,
           TRUE ~ end_date
         ),
         title_english = case_when(
           lubridate::year(end_date) == 2000 ~ "Turn A Gundam",
           TRUE ~ title_english
         )) %>% 
  ## create "decade" groupings for gt subheaders
  ## create html link to MAL webpage
  mutate(newscore = score - avg_score, 
         end_year = lubridate::year(end_date),
         decade = case_when(
           end_year %in% c(1980:1989) ~ "1980's",
           end_year %in% c(1990:1999) ~ "1990's",
           end_year %in% c(2000:2009) ~ "2000's",
           end_year %in% c(2010:2019) ~ "2010's"),
         rating = str_replace(rating, " -.*", ""),
         link = map(animeID, ~paste0("https://myanimelist.net/anime/", .x)) %>% unlist,
         link = glue("[MAL Link]({link})"),
         link = md(link)) %>% 
  arrange(desc(score)) %>% 
  mutate(score_rank = row_number()) %>% 
  arrange(start_date)
  
## gt table 
gundam_df %>% 
  group_by(decade) %>% 
  gt() %>% 
  ## title style
  tab_header(title = "Mobile Suit Gundam", 
             subtitle = md("All major stories in Universal Century and alternate universes")) %>% 
  tab_options(heading.background.color = "red",
              heading.title.font.size = 26,
              heading.subtitle.font.size = 22) %>% 
  tab_style(
    style = cells_styles(text_font = "Roboto Condensed"),
    locations = list(cells_title(groups = "title"))
  ) %>% 
  ## change label names
  cols_label(
    "title_english" = "Title",
    "episodes" = "# of Episodes",
    "studio" = "Studio",
    "start_date" = "From",
    "end_date" = "To",
    "rating" = "Rating",
    "score" = "Score",
    "type" = "Type",
    "score_rank" = "Rank",
    "link" = "Link") %>% 
  ## spanner title
  tab_spanner(
    label = "Airing Dates",
    columns = vars("start_date", "end_date")
  ) %>% 
  ## Color-fill scores
  tab_style(
      style = cells_styles(
        text_color = "green",
        text_weight = "bold"
      ),
      locations = list(cells_data(
        columns = vars(score),
        rows = newscore >= 0.5 & newscore < 1
      ))
    ) %>% 
  tab_style(
      style = cells_styles(
        text_color = "#49f149",
        text_weight = "bold"
      ),
      locations = list(cells_data(
        columns = vars(score),
        rows = newscore >= 0 & newscore < 0.5
      ))
    ) %>% 
  tab_style(
      style = cells_styles(
        text_color = "orange",
        text_weight = "bold"
      ),
      locations = list(cells_data(
        columns = vars(score),
        rows = newscore >= -0.5 & newscore < 0
      ))
    ) %>% 
  tab_style(
      style = cells_styles(
        text_color = "red",
        text_weight = "bold"
      ),
      locations = list(cells_data(
        columns = vars(score),
        rows = newscore >= -1 & newscore < -0.5
      ))
    ) %>% 
  tab_style(
      style = cells_styles(
        text_color = "purple",
        text_weight = "bold"
      ),
      locations = list(cells_data(
        columns = vars(score),
        rows = newscore < -1
      ))
    ) %>% 
  ## Group title style
  tab_style(style = cells_styles(
    text_size = 20,
    text_font = "Roboto Condensed",
    text_color = "white",
    text_decorate = "underline",
    bkgd_color = "blue"),
    locations = list(cells_group("1980's"),
                     cells_group("1990's"),
                     cells_group("2000's"),
                     cells_group("2010's"))) %>% 
  ## Show title
  tab_style(
    style = cells_styles(text_weight = "bolder"),
    locations = cells_data(columns = "title_english")
  ) %>% 
  ## Footnotes
  tab_footnote(
    footnote = "Ranked by Score",
    locations = cells_column_labels(columns = "score_rank")
  ) %>% 
  tab_footnote(
    footnote = "Color-coded based on average rating: 7.61",
    locations = cells_column_labels(columns = "score")
  ) %>% 
  ## Misc.
  cols_align(align = "center") %>% 
  fmt_date(columns = vars(start_date, end_date),
           date_style = 5) %>% 
  cols_hide(columns = vars(newscore, avg_score, end_year, studio, animeID)) %>% 
  fmt_markdown(columns = vars("link")) %>% 
  cols_move_to_end(columns = vars("link")) %>% 
  tab_source_note(source_note = "Source: MyAnimeList, #TidyTuesday by @R_by_Ryo")