Me, Exceedingly Briefly

1️⃣  I work in higher ed as a data manager.

2️⃣  I dabble in hockey analysis.

3️⃣  I use R a lot, thanks to 1️⃣ and 2️⃣, and love helping other people learn.

The Plan for Today

Do you need to know anything about hockey?

No.

The Plan for Today

Do you need to know anything about hockey?

No.

Do you need to know anything about coding?

Eh.

The Plan for Today

GOAL: "Level up your R programming and make your analysis more efficient."

1️⃣  Data manipulation with tidyr and dplyr (and stringr and lubridate and purrr!)

2️⃣  User-defined functions

3️⃣  Custom ggplot2 themes

🕗  5-minute breaks at 5:00 and 5:30

❓  Questions!

HOW: Let's examine the composition of a power play.

Two questions

1️⃣  How does the positional composition change over the time of the power play?

(Is the four-forward configuration maybe more common at the beginning or the end of the power play?)

2️⃣  Does a four-forward power play unit have a higher rate of zone exits?

If you want to follow along

# Load the package
devtools::install_github("meghall06/betweenthepipes")
library(betweenthepipes)
# Load the data
pbp <- pbp_example
bio <- bio_example
tracking <- track_example

Data sources

Play-by-play data

• pbp: NHL play-by-play data
• Four Philadelphia Flyers games in November 2019
• Scraped via the Evolving-Hockey R scraper

Data sources

Data sources

Data sources

Data sources

Data sources

pbp %>% 
  count(game_id, game_date, home_team, away_team)

Data sources

Play-by-play data

• pbp: NHL play-by-play data
• Four Philadelphia Flyers games in November 2019
• Scraped via the Evolving-Hockey R scraper

Skater Data

• bio: Demographic and position data for these players from 2019
• Downloaded from Natural Stat Trick

Data sources

Data sources

Data sources

Play-by-play data

• pbp: NHL play-by-play data
• Four Philadelphia Flyers games in November 2019
• Scraped via the Evolving-Hockey R scraper

Skater Data

• bio: Demographic and position data for these players from 2019
• Downloaded from Natural Stat Trick

Tracking Data

• tracking: Zone exit data on the power play in these four games
• Personally tracked by me!

Data sources

Data sources

Data sources

Play-by-play data

• pbp: NHL play-by-play data
• Four Philadelphia Flyers games in November 2019
• Scraped via the Evolving-Hockey R scraper

Skater Data

• bio: Demographic and position data for these players from 2019
• Downloaded from Natural Stat Trick

Tracking Data

• tracking: Zone exit data on the power play in these four games
• Personally tracked by me!

Plan of attack

🧐  Study your different data sources

🔎  Find the relationships

📝  Sketch out how you want your data to look at the end

Problems we get to solve

❌  Player position data is in a different place

❌  Zone exit data is in a different place

❌  One row per event instead of one row per second 🤔

Packages we'll be using

⭐  My package (where the data is)

library(betweenthepipes)

❤️  The tidyverse (aka dplyr, tidyr, ggplot2, stringr)

library(tidyverse)

🕦  For dealing with time (also part of the tidyverse)

library(lubridate)

🧹  For some data cleaning help

library(janitor)

🔂  For padding out our data

library(padr)

Play by play data

power <- pbp %>%
  # filter to only the power play strength states
  filter(game_strength_state %in% c("5v4", "4v5")) %>%
  # filter to only events that have time associated with them
  filter(event_length > 0) %>%
  # create a new variable that designates the PP team
  mutate(PP_team = ifelse(game_strength_state == "5v4", 
                          home_team, away_team)) %>%
  # create a new set of variables to determine who the PP players are
  mutate(PP_1 = ifelse(home_team == PP_team, home_on_1, away_on_1),
         PP_2 = ifelse(home_team == PP_team, home_on_2, away_on_2),
         PP_3 = ifelse(home_team == PP_team, home_on_3, away_on_3),
         PP_4 = ifelse(home_team == PP_team, home_on_4, away_on_4),
         PP_5 = ifelse(home_team == PP_team, home_on_5, away_on_5),
         PP_6 = ifelse(home_team == PP_team, home_on_6, away_on_6))

Play by play data

power <- pbp %>%
  # filter to only the power play strength states
  filter(game_strength_state %in% c("5v4", "4v5")) %>%
  # filter to only events that have time associated with them
  filter(event_length > 0) %>%
  # create a new variable that designates the PP team
  mutate(PP_team = ifelse(game_strength_state == "5v4", 
                          home_team, away_team)) %>%
  # create a new set of variables to determine who the PP players are
  mutate(PP_1 = ifelse(home_team == PP_team, home_on_1, away_on_1),
         PP_2 = ifelse(home_team == PP_team, home_on_2, away_on_2),
         PP_3 = ifelse(home_team == PP_team, home_on_3, away_on_3),
         PP_4 = ifelse(home_team == PP_team, home_on_4, away_on_4), 
         PP_5 = ifelse(home_team == PP_team, home_on_5, away_on_5),
         PP_6 = ifelse(home_team == PP_team, home_on_6, away_on_6))

Play by play data

power <- pbp %>%
  # filter to only the power play strength states
  filter(game_strength_state %in% c("5v4", "4v5")) %>% 
  # filter to only events that have time associated with them
  filter(event_length > 0) %>%
  # create a new variable that designates the PP team
  mutate(PP_team = ifelse(game_strength_state == "5v4", 
                          home_team, away_team)) %>%
  # create a new set of variables to determine who the PP players are
  mutate(PP_1 = ifelse(home_team == PP_team, home_on_1, away_on_1),
         PP_2 = ifelse(home_team == PP_team, home_on_2, away_on_2),
         PP_3 = ifelse(home_team == PP_team, home_on_3, away_on_3),
         PP_4 = ifelse(home_team == PP_team, home_on_4, away_on_4), 
         PP_5 = ifelse(home_team == PP_team, home_on_5, away_on_5),
         PP_6 = ifelse(home_team == PP_team, home_on_6, away_on_6))

Play by play data

power <- pbp %>%
  # filter to only the power play strength states
  filter(game_strength_state %in% c("5v4", "4v5")) %>% 
  # filter to only events that have time associated with them
  filter(event_length > 0) %>% 
  # create a new variable that designates the PP team
  mutate(PP_team = ifelse(game_strength_state == "5v4",
                          home_team, away_team)) %>%
  # create a new set of variables to determine who the PP players are
  mutate(PP_1 = ifelse(home_team == PP_team, home_on_1, away_on_1),
         PP_2 = ifelse(home_team == PP_team, home_on_2, away_on_2),
         PP_3 = ifelse(home_team == PP_team, home_on_3, away_on_3),
         PP_4 = ifelse(home_team == PP_team, home_on_4, away_on_4), 
         PP_5 = ifelse(home_team == PP_team, home_on_5, away_on_5),
         PP_6 = ifelse(home_team == PP_team, home_on_6, away_on_6))

Play by play data

power <- pbp %>%
  # filter to only the power play strength states
  filter(game_strength_state %in% c("5v4", "4v5")) %>% 
  # filter to only events that have time associated with them
  filter(event_length > 0) %>% 
  # create a new variable that designates the PP team
  mutate(PP_team = ifelse(game_strength_state == "5v4", 
                          home_team, away_team)) %>%
  # create a new set of variables to determine who the PP players are
  mutate(PP_1 = ifelse(home_team == PP_team, home_on_1, away_on_1),
         PP_2 = ifelse(home_team == PP_team, home_on_2, away_on_2),
         PP_3 = ifelse(home_team == PP_team, home_on_3, away_on_3),
         PP_4 = ifelse(home_team == PP_team, home_on_4, away_on_4),
         PP_5 = ifelse(home_team == PP_team, home_on_5, away_on_5),
         PP_6 = ifelse(home_team == PP_team, home_on_6, away_on_6))

Play by play data

Play by play data

pivot <- power %>%
  # pick the variables that we want
  select(game_id, event_index, PP_team, game_seconds, event_length,
         home_goalie, away_goalie, PP_1:PP_6) %>%
  # pivot the six player variables
  pivot_longer(PP_1:PP_6, 
               names_to = "on_ice", 
               values_to = "player") %>%
  # filter out the goalies
  filter(player != home_goalie & player != away_goalie) %>%
  # remove the now-unnecessary goalie variables
  select(-c(home_goalie, away_goalie, on_ice))

Play by play data

pivot <- power %>%
  # pick the variables that we want
  select(game_id, event_index, PP_team, game_seconds, event_length,
         home_goalie, away_goalie, PP_1:PP_6) %>%                   
  # pivot the six player variables
  pivot_longer(PP_1:PP_6,
               names_to = "on_ice",
               values_to = "player") %>%
  # filter out the goalies
  filter(player != home_goalie & player != away_goalie) %>%
  # remove the now-unnecessary goalie variables
  select(-c(home_goalie, away_goalie, on_ice))

Play by play data

Play by play data

Play by play data

Play by play data

pivot <- power %>%
  # pick the variables that we want
  select(game_id, event_index, PP_team, game_seconds, event_length,
         home_goalie, away_goalie, PP_1:PP_6) %>%                   
  # pivot the six player variables
  pivot_longer(PP_1:PP_6, 
               names_to = "on_ice", 
               values_to = "player") %>% 
  # filter out the goalies
  filter(player != home_goalie & player != away_goalie) %>%
  # remove the now-unnecessary goalie variables
  select(-c(home_goalie, away_goalie, on_ice))

Play by play data

pivot <- power %>%
  # pick the variables that we want
  select(game_id, event_index, PP_team, game_seconds, event_length,
         home_goalie, away_goalie, PP_1:PP_6) %>%                   
  # pivot the six player variables
  pivot_longer(PP_1:PP_6,
               names_to = "on_ice",
               values_to = "player") %>% 
  # filter out the goalies
  filter(player != home_goalie & player != away_goalie) %>%
  # remove the now-unnecessary goalie variables
  select(-c(home_goalie, away_goalie, on_ice))

Play by play data

Skater data

bio <- bio %>%
  # reformat the variable names
  clean_names() %>%
  # use two stringr functions to convert our player names to all 
  # uppercase and replace the first space with a period
  mutate(player = str_to_upper(player),
         player = str_replace(player, " ", ".")) %>%
  # record our position variable into a 0/1 variable for forward
  mutate(forward = ifelse(position == "D", 0, 1)) %>%
  # select only these two variables
  select(player, forward)

Skater data

bio <- bio %>%
  # reformat the variable names
  clean_names() %>%
  # use two stringr functions to convert our player names to all 
  # uppercase and replace the first space with a period
  mutate(player = str_to_upper(player),
         player = str_replace(player, " ", ".")) %>%
  # record our position variable into a 0/1 variable for forward
  mutate(forward = ifelse(position == "D", 0, 1)) %>%
  # select only these two variables
  select(player, forward)

Skater data

Skater data

Skater data

bio <- bio %>%
  # reformat the variable names
  clean_names() %>%
  # use two stringr functions to convert our player names to all 
  # uppercase and replace the first space with a period
  mutate(player = str_to_upper(player),
         player = str_replace(player, " ", ".")) %>%
  # record our position variable into a 0/1 variable for forward
  mutate(forward = ifelse(position == "D", 0, 1)) %>%
  # select only these two variables
  select(player, forward)

Skater data

Skater data

Skater data

bio <- bio %>%
  # reformat the variable names
  clean_names() %>%
  # use two stringr functions to convert our player names to all 
  # uppercase and replace the first space with a period
  mutate(player = str_to_upper(player),
         player = str_replace(player, " ", ".")) %>% 
  # record our position variable into a 0/1 variable for forward
  mutate(forward = ifelse(position == "D", 0, 1)) %>%
  # select only these two variables
  select(player, forward)

Skater data

bio <- bio %>%
  # reformat the variable names
  clean_names() %>%
  # use two stringr functions to convert our player names to all 
  # uppercase and replace the first space with a period
  mutate(player = str_to_upper(player),
         player = str_replace(player, " ", ".")) %>% 
  # record our position variable into a 0/1 variable for forward
  mutate(forward = ifelse(position == "D", 0, 1)) %>% 
  # select only these two variables
  select(player, forward)

Skater data

Skater data

pivot_position <- pivot %>%
  left_join(bio, by = "player")

Skater data

pivot_position %>%
  get_dupes(game_id, event_index, player)

## # A tibble: 0 x 8
## # … with 8 variables: game_id <dbl>, event_index <dbl>, player <chr>,
## #   dupe_count <int>, PP_team <chr>, game_seconds <dbl>, event_length <dbl>,
## #   forward <dbl>

Skater data

fixes <- pivot_position %>%
  filter(is.na(forward)) %>%
  count(player) %>%
  arrange(player)

Skater data

bio %>%
  filter(str_detect(player, 'EDLER|WENNBERG|TANEV'))

Skater data

bio <- bio %>%
  mutate(player = case_when(
                      player == "ALEXANDER.EDLER" ~ "ALEX.EDLER",
                      player == "ALEXANDER.WENNBERG" ~ "ALEX.WENNBERG",
                      player == "CHRISTOPHER.TANEV" ~ "CHRIS.TANEV",
                      TRUE ~ player))

pivot_position <- pivot %>%
  left_join(bio, by = "player")
fixes <- pivot_position %>%
  filter(is.na(forward)) %>%
  count(player) %>%
  arrange(player)

Play by play

Play by play

data <- pivot_position %>%
  # first create a basic count variable for each player within a PP
  group_by(game_id, event_index) %>%
  mutate(on_ice = row_number()) %>%
  ungroup() %>%
  # pivot the players and positions
  pivot_wider(names_from = "on_ice", 
              values_from = c("player", "forward")) %>%
  # create a variable to count the number of forwards
  mutate(PP_fwds = select(., forward_1:forward_5) %>% 
           rowSums(na.rm = TRUE)) %>%
  # remove the now-unnecessary variables
  select(-c(player_1:forward_5))

Play by play

data <- pivot_position %>%
  # first create a basic count variable for each player within a PP
  group_by(game_id, event_index) %>%
  mutate(on_ice = row_number()) %>%
  ungroup() %>%
  # pivot the players and positions
  pivot_wider(names_from = "on_ice", 
              values_from = c("player", "forward")) %>%
  # create a variable to count the number of forwards
  mutate(PP_fwds = select(., forward_1:forward_5) %>% 
           rowSums(na.rm = TRUE)) %>%
  # remove the now-unnecessary variables
  select(-c(player_1:forward_5))

Play by play

Play by play

data <- pivot_position %>%
  # first create a basic count variable for each player within a PP
  group_by(game_id, event_index) %>%
  mutate(on_ice = row_number()) %>%
  ungroup() %>% 
  # pivot the players and positions
  pivot_wider(names_from = "on_ice",
              values_from = c("player", "forward")) %>%
  # create a variable to count the number of forwards
  mutate(PP_fwds = select(., forward_1:forward_5) %>% 
           rowSums(na.rm = TRUE)) %>%
  # remove the now-unnecessary variables
  select(-c(player_1:forward_5))

Play by play

Play by play

data <- pivot_position %>%
  # first create a basic count variable for each player within a PP
  group_by(game_id, event_index) %>%
  mutate(on_ice = row_number()) %>%
  ungroup() %>% 
  # pivot the players and positions
  pivot_wider(names_from = "on_ice", 
              values_from = c("player", "forward")) %>%
  # create a variable to count the number of forwards
  mutate(PP_fwds = select(., forward_1:forward_5) %>%
           rowSums(na.rm = TRUE)) %>%
  # remove the now-unnecessary variables
  select(-c(player_1:forward_5))

Play by play

data <- pivot_position %>%
  # first create a basic count variable for each player within a PP
  group_by(game_id, event_index) %>%
  mutate(on_ice = row_number()) %>%
  ungroup() %>% 
  # pivot the players and positions
  pivot_wider(names_from = "on_ice", 
              values_from = c("player", "forward")) %>%
  # create a variable to count the number of forwards
  mutate(PP_fwds = select(., forward_1:forward_5) %>% 
           rowSums(na.rm = TRUE)) %>%
  # remove the now-unnecessary variables
  select(-c(player_1:forward_5))

Play by play

Problems we get to solve

✅  Player position data is in a different place

❌  Zone exit data is in a different place

❌  One row per event instead of one row per second 🤔

Tracking data

Tracking data

tracking <- tracking %>%
  # create a new variable that converts to m:s
  mutate(time_new = str_sub(time, 1, 5),
         time_new = ms(time_new),
         # create a new variable for total seconds
         seconds = minute(time_new)*60 + second(time_new),
         # create a game_seconds variable to match what's in pbp data
         game_seconds = case_when(
                            game_period == 1 ~ 1200 - seconds,
                            game_period == 2 ~ 2400 - seconds,
                            game_period == 3 ~ 3600 - seconds)) %>%
  # remove now-unnecessary variables
  select(-c(time, time_new, seconds, game_period))

Tracking data

tracking <- tracking %>%
  # create a new variable that converts to m:s
  mutate(time_new = str_sub(time, 1, 5),
         time_new = ms(time_new),
         # create a new variable for total seconds
         seconds = minute(time_new)*60 + second(time_new),
         # create a game_seconds variable to match what's in pbp data
         game_seconds = case_when(
                            game_period == 1 ~ 1200 - seconds,
                            game_period == 2 ~ 2400 - seconds,
                            game_period == 3 ~ 3600 - seconds)) %>%
  # remove now-unnecessary variables
  select(-c(time, time_new, seconds, game_period))

Tracking data

Tracking data

tracking <- tracking %>%
  # create a new variable that converts to m:s
  mutate(time_new = str_sub(time, 1, 5),
         time_new = ms(time_new), 
         # create a new variable for total seconds
         seconds = minute(time_new)*60 + second(time_new),
         # create a game_seconds variable to match what's in pbp data
         game_seconds = case_when(
                            game_period == 1 ~ 1200 - seconds,
                            game_period == 2 ~ 2400 - seconds,
                            game_period == 3 ~ 3600 - seconds)) %>%
  # remove now-unnecessary variables
  select(-c(time, time_new, seconds, game_period))

Tracking data

Tracking data

tracking <- tracking %>%
  # create a new variable that converts to m:s
  mutate(time_new = str_sub(time, 1, 5),
         time_new = ms(time_new), 
         # create a new variable for total seconds
         seconds = minute(time_new)*60 + second(time_new), 
         # create a game_seconds variable to match what's in pbp data
         game_seconds = case_when(
                            game_period == 1 ~ 1200 - seconds,
                            game_period == 2 ~ 2400 - seconds,
                            game_period == 3 ~ 3600 - seconds)) %>%
  # remove now-unnecessary variables
  select(-c(time, time_new, seconds, game_period))

Tracking data

What's the goal?

We want to expand our data: one row per event ➡️  one row per second

So we can more easily:

1️⃣  Examine the average composition of a power play per second

2️⃣  Join in our manually-tracked data

Thankfully, we have the padr package.

Padding our data

data <- data %>%
  # create an 0/1 variable to identify a new power play
  # and a power_play_count variable
  mutate(new_power_play = ifelse(lag(game_seconds + event_length) == 
                                   game_seconds & lag(PP_team) == 
                                   PP_team, 0, 1),
         new_power_play = ifelse(is.na(new_power_play), 
                                 1, new_power_play),
         power_play_count = cumsum(new_power_play)) %>%
  select(power_play_count, everything())

Padding our data

data <- data %>%
  # create an 0/1 variable to identify a new power play
  # and a power_play_count variable
  mutate(new_power_play = ifelse(lag(game_seconds + event_length) ==
                                   game_seconds & lag(PP_team) ==
                                   PP_team, 0, 1),
         new_power_play = ifelse(is.na(new_power_play),
                                 1, new_power_play),
         power_play_count = cumsum(new_power_play)) %>%
  select(power_play_count, everything())

Padding our data

Padding our data

data <- data %>%
  # create an 0/1 variable to identify a new power play
  # and a power_play_count variable
  mutate(new_power_play = ifelse(lag(game_seconds + event_length) == 
                                   game_seconds & lag(PP_team) ==
                                   PP_team, 0, 1), 
         new_power_play = ifelse(is.na(new_power_play), 
                                 1, new_power_play), 
         power_play_count = cumsum(new_power_play)) %>%
  select(power_play_count, everything())

Padding our data

Padding our data

data <- data %>%
  # create an 0/1 variable to identify a new power play
  # and a power_play_count variable
  mutate(new_power_play = ifelse(lag(game_seconds + event_length) == 
                                   game_seconds & lag(PP_team) ==
                                   PP_team, 0, 1), 
         new_power_play = ifelse(is.na(new_power_play), 
                                 1, new_power_play), 
         power_play_count = cumsum(new_power_play)) %>% 
  select(power_play_count, everything())

Padding our data

Let's do a test

sample <- data %>%
  filter(power_play_count == 1) %>%
  pad_int('game_seconds',
          start_val = 234,
          end_val = 283) %>%
  fill(power_play_count, game_id, PP_team, PP_fwds, 
       .direction = "down")

Let's do a test

sample <- data %>%
  filter(power_play_count == 1) %>%
  pad_int('game_seconds',
          start_val = 234,
          end_val = 283) %>%
  fill(power_play_count, game_id, PP_team, PP_fwds, 
       .direction = "down")

Let's do a test

Let's do a test

Let's do a test

Let's do a test

sample <- data %>%
  filter(power_play_count == 1) %>% 
  pad_int('game_seconds',
          start_val = 234,
          end_val = 283) %>%
  fill(power_play_count, game_id, PP_team, PP_fwds, 
       .direction = "down")

Let's do a test

Let's do a test

Let's do a test

sample <- data %>%
  filter(power_play_count == 1) %>% 
  pad_int('game_seconds', 
          start_val = 234,
          end_val = 283) %>% 
  fill(power_play_count, game_id, PP_team, PP_fwds,
       .direction = "down")

Let's do a test

Let's do a test

When is it time for a function?

😬  (Don't be scared like me.)

📝  You've copied and pasted code more than twice.

🔁  You need to run multiple lines of code on different segments of data.

# basic syntax of a function
name_of_function <- function(needed_value) {
  # all the code goes here
}

Padding our data

padding_function <- function(count) {
  each_power_play <- data %>%
    filter(power_play_count == count)
  minimum <- min(each_power_play$game_seconds)
  maximum <- max(each_power_play$game_seconds + 
                   each_power_play$event_length - 1)
  padded <- each_power_play %>%
    pad_int('game_seconds',
            start_val = minimum,
            end_val = maximum) %>%
    fill(power_play_count, game_id, PP_team, PP_fwds, 
         .direction = "down")
}

Padding our data

padding_function <- function(count) {
  each_power_play <- data %>%
    filter(power_play_count == count)
  minimum <- min(each_power_play$game_seconds)
  maximum <- max(each_power_play$game_seconds + 
                   each_power_play$event_length - 1)
  padded <- each_power_play %>%
    pad_int('game_seconds',
            start_val = minimum,
            end_val = maximum) %>%
    fill(power_play_count, game_id, PP_team, PP_fwds, 
         .direction = "down")
}

Padding our data

padding_function <- function(count) { 
  each_power_play <- data %>%
    filter(power_play_count == count)
  minimum <- min(each_power_play$game_seconds)
  maximum <- max(each_power_play$game_seconds + 
                   each_power_play$event_length - 1)
  padded <- each_power_play %>%
    pad_int('game_seconds',
            start_val = minimum,
            end_val = maximum) %>%
    fill(power_play_count, game_id, PP_team, PP_fwds, 
         .direction = "down")
}

Padding our data

padding_function <- function(count) { 
  each_power_play <- data %>% 
    filter(power_play_count == count)
  minimum <- min(each_power_play$game_seconds)
  maximum <- max(each_power_play$game_seconds +
                   each_power_play$event_length - 1)
  padded <- each_power_play %>%
    pad_int('game_seconds',
            start_val = minimum,
            end_val = maximum) %>%
    fill(power_play_count, game_id, PP_team, PP_fwds, 
         .direction = "down")
}

Padding our data

padding_function <- function(count) { 
  each_power_play <- data %>% 
    filter(power_play_count == count)
  minimum <- min(each_power_play$game_seconds) 
  maximum <- max(each_power_play$game_seconds +
                   each_power_play$event_length - 1)
  padded <- each_power_play %>%
    pad_int('game_seconds',
            start_val = minimum,
            end_val = maximum) %>%
    fill(power_play_count, game_id, PP_team, PP_fwds,
         .direction = "down")
}

Padding our data

A common scenario:

✂️  Split the data into pieces

🔁  Apply a function to each piece

➕  Put it back together

We can do this with the map() family of functions in the purrr package.

Padding our data

data_padded <- 
  map_df(unique(data$power_play_count), padding_function)

map_df has two arguments: the data and the function

unique(data$power_play_count)

We're telling it to perform the function for each unique value of power_play_count in the data data frame

It will apply our padding_function and return a data frame with the data padded

Padding our data

Padding our data

Padding our data

data_final <- data_padded %>%
  group_by(power_play_count) %>%
  # add in a new variable for the second of 
  # each power play, counting up from 1
  mutate(power_play_second = row_number()) %>%
  ungroup()

Padding our data

data_final <- data_padded %>%
  group_by(power_play_count) %>%
  # add in a new variable for the second of 
  # each power play, counting up from 1
  mutate(power_play_second = row_number()) %>%
  ungroup()

Padding our data

max(data_final$power_play_second)

## [1] 120

Problems we get to solve

✅  Player position data is in a different place

❌  Zone exit data is in a different place

✅  One row per event instead of one row per second 🤔

Tracking data

data_final <- data_final %>%
  left_join(tracking, by = c("game_id", "game_seconds"))

Tracking data

data_final %>% 
  get_dupes(game_id, game_seconds)

## # A tibble: 0 x 11
## # … with 11 variables: game_id <dbl>, game_seconds <dbl>, dupe_count <int>,
## #   power_play_count <dbl>, event_index <dbl>, PP_team <chr>,
## #   event_length <dbl>, PP_fwds <dbl>, new_power_play <dbl>,
## #   power_play_second <int>, event_type <chr>

Problems we get to solve

✅  Player position data is in a different place

✅  Zone exit data is in a different place

✅  One row per event instead of one row per second 🤔

Summarizing our data

summary <- data_final %>%
  group_by(PP_fwds) %>%
  summarize(time_on_ice = sum(event_length, na.rm = TRUE) / 60,
            exits = sum(!is.na(event_type))) %>%
  mutate(exit_rate = exits * 60 / time_on_ice)

Summarizing our data

summary <- data_final %>% 
  group_by(PP_fwds) %>%
  summarize(time_on_ice = sum(event_length, na.rm = TRUE) / 60,
            exits = sum(!is.na(event_type))) %>%
  mutate(exit_rate = exits * 60 / time_on_ice)

Summarizing our data

summary <- data_final %>%
  group_by(PP_fwds) %>%
  summarize(time_on_ice = sum(event_length, na.rm = TRUE) / 60,
            exits = sum(!is.na(event_type))) %>%
  mutate(exit_rate = exits * 60 / time_on_ice)

Summarizing our data

summary <- data_final %>%
  group_by(PP_fwds) %>%
  summarize(time_on_ice = sum(event_length, na.rm = TRUE) / 60, 
            exits = sum(!is.na(event_type))) %>%
  mutate(exit_rate = exits * 60 / time_on_ice)

Summarizing our data

summary <- data_final %>%
  group_by(PP_fwds) %>%
  summarize(time_on_ice = sum(event_length, na.rm = TRUE) / 60, 
            exits = sum(!is.na(event_type))) %>% 
  mutate(exit_rate = exits * 60 / time_on_ice)

Summarizing our data

summary <- data_final %>%
  group_by(PP_fwds) %>%
  summarize(time_on_ice = sum(event_length, na.rm = TRUE) / 60, 
            exits = sum(!is.na(event_type))) %>% 
  mutate(exit_rate = exits * 60 / time_on_ice)

The simplest graph

summary %>%
  ggplot(aes(x = as.character(PP_fwds), y = exit_rate)) +
  geom_bar(stat="identity")

A little better

summary %>%
  ggplot(aes(x = as.character(PP_fwds), y = exit_rate)) +
  geom_bar(stat="identity") +
  labs(title = "Rate of zone exits on the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Number of forwards on the power play",
       y = "Zone exits per 60 minutes") +
  geom_text(aes(label = round(exit_rate, 2)), vjust = 1.6,
            color = "white", size = 4)

A little better

With color!

summary %>%
  ggplot(aes(x = as.character(PP_fwds), y = exit_rate, 
             fill = as.character(PP_fwds))) +
  geom_bar(stat="identity") +
  labs(title = "Rate of zone exits on the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Number of forwards on the power play", 
       y = "Zone exits per 60 minutes") +
  geom_text(aes(label = round(exit_rate, 2)), vjust = 1.6, 
            color = "white", size = 4) +
  scale_fill_manual(values = c("#808080", "#5C164E")) +
  theme(legend.position = "none")

With color!

Much better

summary %>%
  ggplot(aes(x = as.character(PP_fwds), y = exit_rate, 
             fill = as.character(PP_fwds))) +
  geom_bar(stat="identity") +
  labs(title = "Rate of zone exits on the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Number of forwards on the power play", 
       y = "Zone exits per 60 minutes") +
  geom_text(aes(label = round(exit_rate, 2)), vjust = 1.6, 
            color = "white", size = 4) +
  scale_fill_manual(values = c("#808080", "#912919")) +
  CMSAC_theme() +
  theme(legend.position = "none")

Much better

What are the benefits of creating a custom theme?

🕥  Saves time!

⭐  Helps establish your #brand.

❤️  Looks way prettier than a standard ggplot2 graph.

Custom theme how-to

📝  Use Google fonts

library(showtext)
font_add_google("Open Sans", "opensans")

📓  Design your theme

CMSAC_theme <- function () { 
  theme_linedraw(base_size=11, base_family="opensans") %+replace% 
    theme(
    axis.ticks = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_blank(),
    plot.title = element_text(size = 15, hjust = 0, vjust = 0.5, 
                              margin = margin(b = 0.2, unit = "cm")),
    plot.subtitle = element_text(size = 9, face = "italic", hjust = 0, 
                  vjust = 0.5, margin = margin(b = 0.2, unit = "cm")),
    axis.title = element_text(face = "bold"))
  }

Custom theme how-to

📝  Use Google fonts

library(showtext)
font_add_google("Open Sans", "opensans")

📓  Design your theme

CMSAC_theme <- function () { 
  theme_linedraw(base_size=11, base_family="opensans") %+replace%
    theme(
    axis.ticks = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_blank(),
    plot.title = element_text(size = 15, hjust = 0, vjust = 0.5, 
                              margin = margin(b = 0.2, unit = "cm")),
    plot.subtitle = element_text(size = 9, face = "italic", hjust = 0, 
                  vjust = 0.5, margin = margin(b = 0.2, unit = "cm")),
    axis.title = element_text(face = "bold"))
  }

Custom theme how-to

📝  Use Google fonts

library(showtext)
font_add_google("Open Sans", "opensans")

📓  Design your theme

CMSAC_theme <- function () { 
  theme_linedraw(base_size=11, base_family="opensans") %+replace% 
    theme(
    axis.ticks = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_blank(),
    plot.title = element_text(size = 15, hjust = 0, vjust = 0.5, 
                              margin = margin(b = 0.2, unit = "cm")),
    plot.subtitle = element_text(size = 9, face = "italic", hjust = 0, 
                  vjust = 0.5, margin = margin(b = 0.2, unit = "cm")),
    axis.title = element_text(face = "bold"))
  }

Custom theme how-to

📝  Use Google fonts

library(showtext)
font_add_google("Open Sans", "opensans")

📓  Design your theme

CMSAC_theme <- function () { 
  theme_linedraw(base_size=11, base_family="opensans") %+replace% 
    theme(
    axis.ticks = element_blank(), 
    panel.grid.minor = element_blank(), 
    panel.grid.major = element_blank(), 
    plot.title = element_text(size = 15, hjust = 0, vjust = 0.5,
                              margin = margin(b = 0.2, unit = "cm")),
    plot.subtitle = element_text(size = 9, face = "italic", hjust = 0,
                  vjust = 0.5, margin = margin(b = 0.2, unit = "cm")),
    axis.title = element_text(face = "bold"))
  }

Custom theme how-to

1️⃣  Start with an existing theme: theme_linedraw(), theme_classic(), theme_light(), theme_minimal(), etc.

2️⃣  Use the ggplot2 theme reference page to find your arguments.

3️⃣  Investigate the options within those arguments.

theme_minimal <- theme_minimal()
theme_minimal$plot.subtitle

## List of 11
##  $ family       : NULL
##  $ face         : NULL
##  $ colour       : NULL
##  $ size         : NULL
##  $ hjust        : num 0
##  $ vjust        : num 1
##  $ angle        : NULL
##  $ lineheight   : NULL
##  $ margin       : 'margin' num [1:4] 0pt 0pt 5.5pt 0pt
##   ..- attr(*, "valid.unit")= int 8
##   ..- attr(*, "unit")= chr "pt"
##  $ debug        : NULL
##  $ inherit.blank: logi TRUE
##  - attr(*, "class")= chr [1:2] "element_text" "element"

Summarizing our data

time <- data_final %>%
  group_by(power_play_second, PP_fwds) %>%
  summarize(n = n()) %>%
  add_tally(n, name = "total") %>%
  mutate(percent = n / total)

Summarizing our data

time <- data_final %>%
  group_by(power_play_second, PP_fwds) %>%
  summarize(n = n()) %>%
  add_tally(n, name = "total") %>%
  mutate(percent = n / total)

Summarizing our data

Summarizing our data

time <- data_final %>%
  group_by(power_play_second, PP_fwds) %>%
  summarize(n = n()) %>% 
  add_tally(n, name = "total") %>%
  mutate(percent = n / total)

Summarizing our data

Summarizing our data

time <- data_final %>%
  group_by(power_play_second, PP_fwds) %>%
  summarize(n = n()) %>% 
  add_tally(n, name = "total") %>% 
  mutate(percent = n / total)

Summarizing our data

Making an area graph

time %>%
  mutate(PP_fwds = ifelse(PP_fwds == 3, 
                          "3 forwards", "4 forwards")) %>%
  ggplot(aes(x = power_play_second, y = percent, fill = PP_fwds)) + 
  geom_area() +
  labs(title = "Composition of the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Second of the power play") +
  scale_fill_manual(values = c("#808080", "#912919")) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1),
                     expand = c(0, 0)) +
  scale_x_continuous(limits = c(1, 120),
                     breaks = seq(0, 120, 20),
                     expand = c(0, 0)) +
  CMSAC_theme() +
  theme(legend.position = c(0.87, 1.106),
        legend.title = element_blank(),
        axis.title.y = element_blank())

Making an area graph

Making an area graph

time %>%
  mutate(PP_fwds = ifelse(PP_fwds == 3,
                          "3 forwards", "4 forwards")) %>%
  ggplot(aes(x = power_play_second, y = percent, fill = PP_fwds)) + 
  geom_area() +
  labs(title = "Composition of the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Second of the power play") +
  scale_fill_manual(values = c("#808080", "#912919")) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1),
                     expand = c(0, 0)) +
  scale_x_continuous(limits = c(1, 120),
                     breaks = seq(0, 120, 20),
                     expand = c(0, 0)) +
  CMSAC_theme() +
  theme(legend.position = c(0.87, 1.106),
        legend.title = element_blank(),
        axis.title.y = element_blank())

Making an area graph

time %>%
  mutate(PP_fwds = ifelse(PP_fwds == 3, 
                          "3 forwards", "4 forwards")) %>%
  ggplot(aes(x = power_play_second, y = percent, fill = PP_fwds)) + 
  geom_area() +
  labs(title = "Composition of the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Second of the power play") +
  scale_fill_manual(values = c("#808080", "#912919")) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1),
                     expand = c(0, 0)) +
  scale_x_continuous(limits = c(1, 120),
                     breaks = seq(0, 120, 20),
                     expand = c(0, 0)) +
  CMSAC_theme() +
  theme(legend.position = c(0.87, 1.106),
        legend.title = element_blank(),
        axis.title.y = element_blank())

Making an area graph

time %>%
  mutate(PP_fwds = ifelse(PP_fwds == 3, 
                          "3 forwards", "4 forwards")) %>%
  ggplot(aes(x = power_play_second, y = percent, fill = PP_fwds)) + 
  geom_area() + 
  labs(title = "Composition of the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Second of the power play") +
  scale_fill_manual(values = c("#808080", "#912919")) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1),
                     expand = c(0, 0)) +
  scale_x_continuous(limits = c(1, 120),
                     breaks = seq(0, 120, 20),
                     expand = c(0, 0)) +
  CMSAC_theme() +
  theme(legend.position = c(0.87, 1.106),
        legend.title = element_blank(),
        axis.title.y = element_blank())

Making an area graph

Making an area graph

time %>%
  mutate(PP_fwds = ifelse(PP_fwds == 3, 
                          "3 forwards", "4 forwards")) %>%
  ggplot(aes(x = power_play_second, y = percent, fill = PP_fwds)) + 
  geom_area() + 
  labs(title = "Composition of the power play",
       subtitle = "5v4 only, 4 NHL games November 2019",
       x = "Second of the power play") +
  scale_fill_manual(values = c("#808080", "#912919")) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1),
                     expand = c(0, 0)) +
  scale_x_continuous(limits = c(1, 120),
                     breaks = seq(0, 120, 20),
                     expand = c(0, 0)) + 
  CMSAC_theme() +
  theme(legend.position = c(0.87, 1.106),
        legend.title = element_blank(),
        axis.title.y = element_blank())