[Code].Rmd

---
title: "Formula 1"
author: "NearAndDistant"
date: "07/09/2021"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

##### Reference
https://brundling.neocities.org/concours.html
http://ergast.com/mrd/
Simplifying Lists: https://cfss.uchicago.edu/notes/simplify-nested-lists/

#### Glue
Glue offers interpreted string literals that are small, fast, and dependency-free. Glue does this by embedding R expressions in curly braces which are then evaluated and inserted into the argument string. We can use this to dynamically call the Ergast API. For instance:

name <- "Fred"
glue::glue('My name is {name}.')

#### Dynamically Import from Ergast API using Glue
```{r}
library(tidyverse)
library(jsonlite)
library(httr)

ergast_url <- "http://ergast.com/api/f1/{api_ask}.json?limit=5000"

api_ask <- "drivers"

raw_json_drivers_info <- 
  httr::GET(glue::glue(ergast_url)) %>% 
  content(type = "text", encoding = "UTF-8") %>% 
  jsonlite::parse_json(simplifyVector = FALSE)

```

#### Rectangling and tidyr
Rectangling is the art and craft of taking a deeply nested list (often sourced from wild caught JSON or XML) and taming it into a tidy data set of rows and columns. There are three functions from tidyr that are particularly useful for rectangling:

unnest_longer() takes each element of a list-column and makes a new row.
unnest_wider()  takes each element of a list-column and makes a new column.
unnest_auto()   guesses whether you want unnest_longer() or unnest_wider().

hoist() is similar to unnest_wider() but only plucks out selected components, and can reach down multiple levels. A very large number of data rectangling problems can be solved by combining these functions with a splash of dplyr.

```{r}
library(listviewer)

# creates interactive json map so we can see where we are
jsonedit(raw_json_drivers_info)

```

#### Driver Info Table
```{r}

# create tibble of list of lists to unnest
json_drivers <- tibble(drivers = raw_json_drivers_info$MRData$DriverTable)

# unnest tibble into unnested lists then widen
drivers_info <- 
json_drivers %>%
  unnest_longer(drivers) %>% 
  unnest_wider(drivers) %>%
  select(-url) # we do not need Wikipedia entries for this project

```

##### Drivers Info: Graphic
```{r}
theme_set(theme_minimal())

drivers_info %>%
  count(nationality) %>%
  ggplot(aes(n , reorder(nationality, n), fill = nationality)) +
  geom_col(show.legend = FALSE) +
  labs(y = NULL)

```

#### F1 Seasons
```{r}

api_ask <- "seasons"

raw_json_seasons <- 
  httr::GET(glue::glue(ergast_url)) %>% 
  content(type = "text", encoding = "UTF-8") %>% 
  jsonlite::parse_json(simplifyVector = FALSE) 

json_seasons <- tibble(season = raw_json_seasons$MRData$SeasonTable)

seasons <- 
json_seasons %>%
  unnest_longer(season) %>% 
  unnest_wider(season) %>%
  select(-url)

seasons_vector <- unlist(seasons)

```

#### Driver Standing Table
```{r}

season_list_master <- tibble()

for(i in seasons_vector){
api_ask <- paste0(i,"/driverStandings")

raw_json_standings <- 
  httr::GET(glue::glue(ergast_url)) %>% 
  content(type = "text", encoding = "UTF-8") %>% 
  jsonlite::parse_json(simplifyVector = FALSE) 

# create tibble of list of lists to unnest
season_list <- tibble(season = raw_json_standings$MRData$StandingsTable$StandingsLists[[1]]$DriverStandings)

# unnest tibble into unnested lists then widen
season_list <- season_list %>% unnest_wider(season) %>% mutate(season = i)

season_list_master <- rbind(season_list_master , season_list)
}

```

#### Unnesting Seasons
```{r}

f1_complete <-
season_list_master %>%
  unnest(Constructors) %>%
  unnest_wider(Constructors) %>%
  select(-url , constructor = name , con_nationality = nationality) %>%
  unnest_wider(Driver) %>%
  select(season , everything(), -url, -positionText) %>%
  mutate(season    = factor(season , ordered = TRUE),
         position  = as.numeric(position),
         points    = as.numeric(points) , 
         wins      = as.numeric(wins)) %>%
  janitor::clean_names()

```

##### F1 Constructor Points
```{r}

levels = c("Ferrari" , "Maserati" , "Matra-Ford" , "Mercedes" , "Team Lotus" , "Red Bull"  , "McLaren" , "Lotus-Climax" , 
           "Williams" , "Benetton" ,  "Alfa Romeo", "BRM" , "Tyrrell" , "Brabham" , "Renault" , "Other")  

f1_tot_points <- 
f1_complete %>%
  mutate(full_name = paste(given_name , family_name , sep = " ")) %>%
  group_by(season , position , constructor , full_name) %>%
  summarise(tot_points = sum(as.numeric(points))) %>%
  group_by(season) %>%
  mutate(pc_point = tot_points / sum(tot_points)) %>%
  ungroup() %>%
  mutate(constructor_lump = if_else(constructor %in% levels , constructor , "Other")) %>%
  mutate(constructor_lump = factor(constructor_lump , levels = levels , ordered = TRUE)) %>%
  filter(pc_point != 0) # valve for controlling how many constructors we see in graphic

f1_season_winners <-
  f1_tot_points %>%
  mutate(constructor_label = paste("Winner:", constructor)) %>%
  mutate(constructor_label = if_else(season == "1954" & constructor == "Maserati", "Joint: Masterati & Mercedes", constructor_label)) %>%
  filter(position == 1, season != "1954" | constructor != "Mercedes")

f1_season_top <-
  f1_tot_points %>%
  mutate(constructor_label = paste("Winner:", constructor)) %>%
  mutate(constructor_label = if_else(season == "1951" & constructor == "Farrari", "Joint: Ferrari & Talbot-Lago", constructor_label)) %>%
  filter(season != "1951" | constructor != "Talbot-Lago") %>%
  filter(season != "1954" | constructor != "Mercedes") %>%
  filter(season != "1955" | constructor != "Lancia") %>%
  filter(season != "1957" | constructor != "Vanwall") %>%
  filter(season != "1958" | constructor != "Cooper") %>%
  filter(season != "1959" | constructor != "Vanwall") %>%
  filter(season != "1959" | constructor != "BRM") %>%
  filter(season != "1960" | constructor != "Team Lotus") %>%
  filter(season != "1961" | constructor != "Ferguson") %>%
  filter(season != "1966" | position != 2 | constructor != "Cooper-Maserati") %>%
  filter(season != "1967" | constructor != "Lotus-Ford" & constructor != "Lotus-Climax") %>%
  filter(season != "1968" | constructor != "McLaren-BRM" & constructor != "McLaren-Ford") %>%
  filter(season != "1971" | constructor != "March-Ford") %>%
  filter(position %in% c(1,2,3))

# Vector of Constructors
constructor_list <- unlist(unique(f1_tot_points$constructor[which(f1_tot_points$pc_point > 0.20)]))

```

### Graphic Design

##### Font & Colors
```{r}
library(showtext); showtext_auto()

font_add_google("Timmana" , "timmana")
text <- "timmana"

# Team color hex
palette <-
c(
"Ferrari"       = colorspace::lighten("#CD212A", 0.25),
"Maserati"      = colorspace::lighten("#141b33", 0.25),
"Matra-Ford"    = colorspace::lighten("#1351D8", 0.25),
"Mercedes"      = colorspace::lighten("#018076", 0.25),
"Team Lotus"    = colorspace::lighten("#c2f002", 0.25),
"Red Bull"      = colorspace::lighten("#0600EF", 0.25),
"McLaren"       = colorspace::lighten("#FF8700", 0.25),
"Lotus-Climax"  = colorspace::lighten("grey30", 0.25),
"Williams"      = colorspace::lighten("#005AFF", 0.25),
"Benetton"      = colorspace::lighten("#008860", 0.25),
"Alfa Romeo"    = colorspace::lighten("#8B0025", 0.25),
"BRM"           = colorspace::lighten("#576c64", 0.25),
"Tyrrell"       = colorspace::lighten("#005fe0", 0.25),
"Brabham"       = colorspace::lighten("#F3EBE1", 0.25),
"Renault"       = colorspace::lighten("#F7D747", 0.25),
"Other"         = "grey90"
)
```

##### F1 Constructor Graphic
```{r}

plot_contructor_points <-
f1_tot_points %>%
  ggplot(aes(pc_point , fct_rev(season) , fill = fct_rev(constructor_lump))) +
  geom_col(position = "stack" ,  show.legend = FALSE) +
  #geom_point(data = f1_season_winners , x = 1.01 , aes(y = season , color = constructor) ,size = 2.5  , show.legend = FALSE) +
  #geom_text(data = f1_season_winners ,  x = 1.02  , aes(y = season , label = constructor_label) , size = 3, hjust = 0 , family = text, show.legend = FALSE) +
  scale_fill_manual(values = palette) +
  scale_color_manual(values = palette) +
  scale_x_continuous(labels = scales::percent) +
  coord_cartesian(clip = "off") + 
  labs(title = NULL , x = NULL , y = NULL) +
  theme(text = element_text(family = text),
        plot.title = element_text(hjust = 0.05 , size = 30),
        panel.grid = element_blank(),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 12 , vjust = -12),
        axis.text.y = element_text(size = 10 , margin = margin(r = -18)),
        plot.margin = margin(3.5,24,0.5,0.5, unit = "cm"))

```

##### GGStream Position
```{r}
library(ggstream)

plot_season_top <-
f1_season_top %>%
  ggplot(aes(season , pc_point)) +
  ggstream::geom_stream(aes(fill = constructor_lump)) +
  scale_fill_manual(values = palette) +
  coord_flip() +
  labs(fill = "Race Team") +
  facet_wrap(~position , nrow = 1) +
  theme(text = element_text(family = text),
        #panel.spacing = unit(-3 , "lines"),
        strip.text = element_blank(),
        panel.grid = element_blank(), 
        axis.text = element_blank() , 
        axis.title = element_blank())

```

##### Podium Plot
```{r}

plot_winner <-
f1_season_top %>%
  mutate(position = factor(position , levels = c(2,1,3))) %>%
  ggplot(aes(position , pc_point , fill = constructor_lump)) +
  geom_col(position = "dodge" ) +
  guides(fill = guide_legend(nrow = 2 , title.position = "top")) +
  geom_text(aes(label = season, x = 2 , y = -.05) , family = text) +
  geom_text(data = f1_season_winners , aes(label = paste0("(",full_name,")"), x = 2) , y = -0.12 , family = text, size = 3) +
  scale_fill_manual(values = palette) +
  coord_cartesian(clip = "off") +
  facet_wrap(~season) +
  labs(fill = "Race Team") +
  theme(text = element_text(family = text),
        legend.title = element_text(hjust = 0 , size = 12),
        legend.position = c(-0.2,1.02),
        legend.justification = c(0,0),
        legend.spacing.x = unit(0.2 , "lines") ,
        strip.text = element_blank(),
        panel.grid = element_blank(),
        axis.title = element_blank(),
        axis.text = element_blank(),
        panel.spacing.y = unit(1, "lines"),
        plot.margin = margin(0.5,1,0,1, unit = "cm"))

```

##### Podium Plot Legend
```{r}

legend_podium <-
f1_season_top %>%
  filter(season == "2001") %>%
  mutate(position = case_when(position == 1 ~"1st" , position == 2 ~ "2nd", position == 3 ~ "3rd")) %>%
  mutate(position = factor(position , levels = c("2nd","1st","3rd"))) %>%
  ggplot(aes(position , pc_point)) +
  geom_col(position = "dodge" , fill = "white" , color = "grey20" , show.legend = FALSE) +
  geom_text(aes(label = season, x = 2 , y = -0.06) , family = text, size = 4) +
  geom_text(label = "(Michael Schumacher)", x = 2 , y = -0.14 , family = text, size = 3) +
  geom_text(aes(label = position), nudge_y = 0.05, family = text , size = 4) +
  geom_curve(x = 2, y = -0.18, xend = 6, yend = -0.20, arrow = arrow(length = unit(0.03, "npc"))) +
  geom_text(x = 6, y = -0.15, label = "Winner", family = text , size = 3) +
  coord_cartesian(clip = "off") +
  theme_void() +
  theme(plot.margin = margin(0,0,2,0, "cm"))

```


##### Final Plot
```{r}
library(cowplot)

legend <- get_legend(plot_contructor_points)

ggdraw(plot_contructor_points) +
  draw_plot(plot_winner , x = 0.35 , y = 0.05 , height = 0.86 , width = 0.66) +
  draw_image("https://www.thedesignfrontier.com/wp-content/uploads/2019/05/f1-logo.png" , 
             x = -0.03 , y = 0.76 , height = 0.35 , width = 0.35) +
  draw_text('"Adding power makes you faster on the straights. Subtracting weight makes you faster everywhere."',
            x = 0.25 , y = 0.9 , hjust = 0 , family = text) +
  draw_text('Race Team Points Per Season (%)', x = 0.03 , y = 0.87 , hjust = 0 , family = text) +
  draw_text('Data: ergast.com/mrd/db | Graphic: @NearAndDistant', x = 0.255 , y = 0.88 , hjust = 0 , family = text , size = 9) +
  draw_plot(legend_podium , x = 0.86 , y = 0.82 , height = 0.15 , width = 0.05) +
  theme(plot.background = element_rect(fill = "white" , color = "white"))

```

#### Saving
```{r}

ggsave(here::here("F1.png"), dpi = 360, height = 10, width = 15)

```