#Load Libraries
library(here)
## here() starts at C:/Users/rwetzel/OneDrive - Granger Waste Services/Documents/Richard Wetzel/Administrative/MGIS/588/Lab 3
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(tweetrmd)
library(treemap)
## Warning: package 'treemap' was built under R version 4.3.3

Introduction

Each year in the National Hockey League, during both the free agency period and time leading up to the trade deadline, there is always a focus on right-handed defensemen. It was while watching my favorite team (the Detroit Red Wings) try, unsuccessfully, to sign a right-handed d-man that I developed the idea for my capstone project. Several of these free agents ended up signing with teams with, arguably, worse outlooks than my own team or signed contracts worth less money than what had reportedly been offered by the Red Wings. Conventional wisdom suggests that the two main drivers for professional athletes are opportunities for success (either at the personal or team level) or money, I began to look at the role that geography might play in free agent decision-making. That is beyond the scope of this lab, though.

tweet_embed("https://twitter.com/TheAthleticNHL/status/1765037096283058593")

For now, I want to explore why right-handed defensemen come at such a premium in the NHL. It’s certainly not that right-handed people are more rare, in fact, quite the opposite is true. According to MedlinePlus (2022), part of the National Library of Medicine, approximately 85 to 90 percent of people in Western countries are right-handed. Why then, are right-handed, and not left-handed, defensemen such a prized commodity in the NHL?

Data Preparation

#Read in Data-----
#Open a csv file containing all NHL players who played at least one game in the
#2022-2023 season. Filter out goalies, as we are only interested in skaters at
#this point. 
PlayerDB <- read_csv(here("PlayerDatabase.csv"))
## Rows: 1060 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (10): Player, DominantHand, Birth City, State/Province, Ctry, Ntnlty, D...
## dbl   (5): Alteryx, Ht, Wt, 1st Season, Player_ID
## date  (1): DOB
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
AllPlayerDB <- PlayerDB %>%
  select(Player_ID, Player, Pos, DominantHand)%>%
  filter(Pos!='G' & Player_ID!='NA')%>%
  mutate_at("Player_ID",as.character)

Analysis

Are right-handed players less common than left-handed players in the NHL?

The National Library of Medicine statistic referenced above indicates that the majority of people in Western countries are right-handed, but the NHL has players from all over the world. Perhaps left-hand dominance is more prevalent in other countries contributing players to the NHL.

PctHandDF_D <- AllPlayerDB %>%
  group_by(DominantHand)%>%
  summarize(n=n())%>%
  mutate(totalDefense=sum(n))%>%
  mutate(PctHand=n/totalDefense)%>%
  mutate(DominantHand =case_when(
    DominantHand=='LH' ~"Left Hand",
    DominantHand=='RH' ~"Right Hand"
  ))%>%
  mutate(PctHandFull=PctHand*100)

ggplot(PctHandDF_D, aes(x="", y=PctHandFull, fill = DominantHand))+
  geom_col() +
  coord_polar(theta="y")+
  theme_void()+
  geom_text(aes(label=format(PctHandFull,digits=3)),
            position =position_stack(vjust=0.5))+
  ggtitle("Dominant Hand (All Skaters)")+
  theme(plot.title=element_text(hjust=0.5))

Maybe there is something to that line of thought. After filtering out goalies, it appears that players do skew more towards left-hand dominance in the NHL. That is for all skaters, though. Do the numbers look similar when looking at defensemen only?

#Create a separate data frame from the PlayerDatabase file containing only 
#defensemen. 
DefenseDB <- PlayerDB %>%
  select(Player_ID, Player, Pos, DominantHand)%>%
  filter(Pos=='D' & Player_ID!='NA')%>%
  mutate_at("Player_ID",as.character)
PctHandDF_D <- DefenseDB %>%
  group_by(DominantHand)%>%
  summarize(n=n())%>%
  mutate(totalDefense=sum(n))%>%
  mutate(PctHand=n/totalDefense)%>%
  mutate(DominantHand =case_when(
    DominantHand=='LH' ~"Left Hand",
    DominantHand=='RH' ~"Right Hand"
  ))%>%
  mutate(PctHandFull=PctHand*100)

ggplot(PctHandDF_D, aes(x="", y=PctHandFull, fill = DominantHand))+
  geom_col() +
  coord_polar(theta="y")+
  theme_void()+
  geom_text(aes(label=format(PctHandFull,digits=3)),
            position =position_stack(vjust=0.5))+
  ggtitle("Dominant Hand (Defensemen)")+
  theme(plot.title=element_text(hjust=0.5))

There is a slightly higher percentage of right-handed defenseman than left when compared to all skaters. While the numbers are surprising, it still does not suggest that right-handed defensemen are significantly more rare than their left-handed counterparts.

Further research (unfortunately it is behind a paywall so I am unable to get all information to cite it properly now) revealed that the idea that a right-shooting player is right-handed dominant isn’t always the case. For many hockey players, especially for those born outside of the United States, they are taught to place their dominant hand at the top of the stick, rather than on the shaft, meaning that a right-hand dominant player would end up with a left-handed shot. That helps explain why there is such a wide variance in the percentage of right- and left-hand dominance between the general population and NHL players, but doesn’t explain why right-shooting defensemen are so valuable.

Further Data Preparation

#Read in Data-----
#Read in NHL play-by-play data and create a pivoted list of all players on the ice for each Event ID
data<- read_csv(here("nhl_pbp_20222023.csv"))
## Rows: 440933 Columns: 57
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (29): Date, Event, Description, Strength, Ev_Zone, Type, Ev_Team, Home_...
## dbl  (27): EV_ID, Game_Id, Period, Seconds_Elapsed, p1_ID, p2_ID, p3_ID, awa...
## time  (1): Time_Elapsed
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
event_list <- data %>%
  filter(Event %in% c("SHOT","MISS","GOAL","BLOCK"))%>%
  unite(col='playerap1',c('awayPlayer1','awayPlayer1_id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerap2',c('awayPlayer2','awayPlayer2_id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerap3',c('awayPlayer3','awayPlayer3_id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerap4',c('awayPlayer4','awayPlayer4_id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerap5',c('awayPlayer5','awayPlayer5_id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerap6',c('awayPlayer6','awayPlayer6_id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerapg',c('Away_Goalie','Away_Goalie_Id',"EV_ID","Away_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhp1',c('homePlayer1','homePlayer1_id',"EV_ID","Home_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhp2',c('homePlayer2','homePlayer2_id',"EV_ID","Home_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhp3',c('homePlayer3','homePlayer3_id',"EV_ID","Home_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhp4',c('homePlayer4','homePlayer4_id',"EV_ID","Home_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhp5',c('homePlayer5','homePlayer5_id',"EV_ID","Home_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhp6',c('homePlayer6','homePlayer6_id',"EV_ID","Home_Team"),sep='/',remove=FALSE)%>%
  unite(col='playerhpg',c('Home_Goalie','Home_Goalie_Id',"EV_ID","Home_Team"),sep='/',remove=TRUE)%>%
  select(playerap1,playerap2,playerap3,playerap4,playerap5,playerap6,playerhp1,
         playerhp2,playerhp3,playerhp4,playerhp5,playerhp6,playerapg,playerhpg)%>%
  pivot_longer(cols=starts_with("player"))%>%
  separate(col='value',into=c('Player','Player_ID','Event_ID','Team'),sep='/')%>%
  select("Event_ID","Player","Player_ID","Team")

#Identify Players Without a Player ID-----
#While using Hockey-Scrapr to pull NHL play-by-play data, some records end up incomplete. One common
#issue is that players are listed as being on the ice for an event but no player ID is associated with them.
#This section filters those players out and writes them to a file where player IDs can be manually added.
#Due to differences in spelling or punctuation (e.g. JT Miller ~ J.T. Miller), it is not recommended
#to try matching players using the name column. 
No_ID <- event_list %>%
  filter(Player_ID=='NA')%>%
  filter(Player!='NA')%>%
  select(Player,Event_ID)%>%
  distinct(Player)%>%
  filter(Player !='NA')

#Add in Player IDs for Players Without A Player ID-----
#Using the No_ID data frame, manually look up the Player IDs and add them to a 
#new table for use in cleaning up the event_list data frame. The new table is 
#saved as MissingPlayerIDs.csv. This file is then joined to the events_list data frame
#to produce an event list with player IDs associated with each player. 
missingPlayerList <-read_csv(here("MissingPlayerIDs.csv"))%>%
  mutate_at("P_ID",as.character)
## Rows: 18 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Player
## dbl (1): P_ID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
clean_events_list <-event_list %>%
  left_join(missingPlayerList)%>%
  filter(Player!='NA')%>%
  mutate_at("P_ID",as.character)
## Joining with `by = join_by(Player)`
#Separate the clean_events_list data into records with the Player ID in the 
#Player_ID column and those with it in the P_ID column. Rename the columns, 
#merge them together, select only the field name containing the Player ID, and
#remove any duplicate values. 
PlayerList1 <- clean_events_list %>%
  filter(Player_ID!='NA')%>%
  select(Event_ID,Player,Player_ID,Team)

PlayerList2 <- clean_events_list %>%
  filter(Player_ID=='NA')%>%
  select(Event_ID,Player,P_ID,Team)%>%
  rename(Player_ID = P_ID)

clean_events_list <-clean_events_list %>%
  bind_rows(PlayerList1,PlayerList2)%>%
  distinct(Event_ID,Player,Player_ID,Team)

#Read in Player Database and join player handedness and position to
#clean_events_list data frame. 
PlayerDB <- read_csv(here("PlayerDatabase.csv"))
## Rows: 1060 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (10): Player, DominantHand, Birth City, State/Province, Ctry, Ntnlty, D...
## dbl   (5): Alteryx, Ht, Wt, 1st Season, Player_ID
## date  (1): DOB
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
PlayerDB <- PlayerDB %>%
  select(Player_ID, Player, Pos, DominantHand)%>%
  filter(Pos=='D' & Player_ID!='NA')%>%
  mutate_at("Player_ID",as.character)

clean_events_list <- clean_events_list %>%
  filter(Player_ID!='NA')%>%
  right_join(PlayerDB,by='Player_ID')%>%
  select(Event_ID,Player.x,Player_ID,DominantHand,Pos,Team)%>%
  rename(Player=Player.x)

#Identify handedness of defensive pairings for each event-----
#Eliminate scenarios where there are not exactly two defensemen on the ice for a 
#given team.
EventPairings <- clean_events_list %>%
  group_by(Event_ID,Team,DominantHand)%>%
  summarize(n=n())
## `summarise()` has grouped output by 'Event_ID', 'Team'. You can override using
## the `.groups` argument.
EPairList <- EventPairings %>%
  pivot_wider(names_from=DominantHand,values_from = n)%>%
  mutate(LH = coalesce(LH,0),
         RH = coalesce(RH,0))%>%
  mutate(TotalD=(RH+LH))%>%
  mutate(Pairing = case_when(
    TotalD != 2 ~ "NoPair",    
    TotalD ==2 & LH ==2 ~ "Left-Handed Pairing",
    TotalD ==2 & RH==2 ~ "Right-Handed Pairing",
    TotalD ==2 & RH==1 & LH ==1 ~ "Mixed-Handed Pairing"))%>%
  filter(Pairing!='NoPair')%>%
  select(Event_ID,Team,Pairing)

#Play-by-play data contains many different events that we are not interested in 
#analyzing. We want to look specifically at scoring opportunities. The relevant
#event types are shots on goal, missed shots, blocked shots, and goals. We then 
#join this data with our defensive pairings to find out whether the defensive 
#pairing on the ice were mixed- or same-handed. To determine the defensive pairings
#on the ice for chances against, we flip the Ev_Team field (denotes the team 
#performing the event) so that we get the opposing players.
shot_events_def <-data %>%
  filter(Event %in% c("SHOT","MISS","GOAL","BLOCK"))%>%
  select(EV_ID,Game_Id,Date,Period,Event,Description,Strength,Ev_Team,xC,yC,Away_Team,Home_Team)%>%
  rename(Event_ID='EV_ID')%>%
  mutate_at("Event_ID",as.character)%>%
  mutate(Ev_Team = case_when(
    Ev_Team == Home_Team ~ Away_Team,
    Ev_Team == Away_Team ~ Home_Team))%>%
  left_join(EPairList)%>%
  filter(Ev_Team!=Team)%>%
  mutate(Pairing = case_when(
    Pairing=="Left-Handed Pairing"~ "Same-Handed Pairing",
    Pairing=="Right-Handed Pairing"~ "Same-Handed Pairing",
    Pairing=="Mixed-Handed Pairing"~ "Mixed-Handed Pairing",
  ))
## Joining with `by = join_by(Event_ID)`

Analysis

Are right- and left-shot defensive pairings better at suppressing shots than

same-handed counterparts?

Commentators and analysts frequently make the argument that pairing a right-shooting defensemen with a left-shooting one provides additional benefits over pairing two defensemen with the same shot. Logically, this makes a degree of sense, as pairing the two opposite-shooting players allows them to be able to corral pucks along the boards without turning their backs in the attacking zone or, by reversing sides, allows them to one-time shots from cross-ice passes easier. Does that actually translate to any measurable benefit in terms of defensive metrics, though?

#Summarize scoring chances (shots on goal, missed shots, blocked shots, and goals)
#by the type of defensive pairing (consisting of a left- and right-shooting defensemen
#or two same-shot players) protecting against the scoring chance. 
shot_events_summary <- shot_events_def %>%
  group_by(Pairing,Event)%>%
  summarize(Value=n())
## `summarise()` has grouped output by 'Pairing'. You can override using the
## `.groups` argument.
PctByEvent <-shot_events_summary %>%
  group_by(Pairing)%>%
  summarize(totalByPair=sum(Value))

DefensiveSummary <- shot_events_summary %>%
  left_join(PctByEvent)%>%
  mutate("EventPct" =Value/totalByPair)%>%
  mutate(EventPctFull = EventPct*100)
## Joining with `by = join_by(Pairing)`
ggplot(DefensiveSummary, aes(x=Event, y=EventPctFull, fill=Pairing))+
  geom_bar(position=position_dodge(), stat='identity')+
  ggtitle("Scoring Chance Against (Pct by Defensive Pairing)")+
  theme(
    axis.title.x=element_blank(),
    axis.title.y=element_blank()
  )

By looking at the scoring chances against, there appears to be little difference in shot suppression between mixed- or same-handed defensive pairings. Does that mean that the benefit of pairing a right-shot defenseman with a left-shot is solely on the offensive side. To understand that, we’ll have to look at who is on the ice for scoring chances for, rather than against.

Data Preparation

#Play-by-play data contains many different events that we are not interested in 
#analyzing. We want to look specifically at scoring opportunities. The relevant
#event types are shots on goal, missed shots, blocked shots, and goals. We then 
#join this data with our defensive pairings to find out whether the defensive 
#pairing on the ice were mixed- or same-handed. This is the same analysis we 
#performed earlier, except that this time we are matching our defensive pairing
#data with an unmodified Ev_Team field to determine the defensive pairings on the 
#ice for chances for, rather than against. 
shot_events_off <-data %>%
  filter(Event %in% c("SHOT","MISS","GOAL","BLOCK"))%>%
  select(EV_ID,Game_Id,Date,Period,Event,Description,Strength,Ev_Team,xC,yC,Away_Team,Home_Team)%>%
  rename(Event_ID='EV_ID')%>%
  mutate_at("Event_ID",as.character)%>%
  left_join(EPairList)%>%
  filter(Ev_Team!=Team)%>%
  mutate(Pairing = case_when(
    Pairing=="Left-Handed Pairing"~ "Same-Handed Pairing",
    Pairing=="Right-Handed Pairing"~ "Same-Handed Pairing",
    Pairing=="Mixed-Handed Pairing"~ "Mixed-Handed Pairing",
  ))
## Joining with `by = join_by(Event_ID)`

Analysis

#Summarize scoring chances (shots on goal, missed shots, blocked shots, and goals)
#by the type of defensive pairing (consisting of a left- and right-shooting defensemen
#or two same-shot players) protecting against the scoring chance. 
shot_events_summary2 <- shot_events_off %>%
  group_by(Pairing,Event)%>%
  summarize(Value=n())
## `summarise()` has grouped output by 'Pairing'. You can override using the
## `.groups` argument.
PctByEvent <-shot_events_summary2 %>%
  group_by(Pairing)%>%
  summarize(totalByPair=sum(Value))

OffensiveSummary <- shot_events_summary2 %>%
  left_join(PctByEvent)%>%
  mutate("EventPct" =Value/totalByPair)%>%
  mutate(EventPctFull = EventPct*100)
## Joining with `by = join_by(Pairing)`
ggplot(OffensiveSummary, aes(x=Event, y=EventPctFull, fill=Pairing))+
  geom_bar(position=position_dodge(), stat='identity')+
  ggtitle("Scoring Chance For (Pct by Defensive Pairing)")+
  theme(
    axis.title.x=element_blank(),
    axis.title.y=element_blank()
  )

Once again, neither mixed-handed nor same-handed defensive pairings contribute to significantly higher percentages of scoring chances for than they did in suppressing scoring chances against. Is the value of right-shooting defensive players overblown by commentators and analysts? Perhaps. Further analysis into the strength of players on the ice, in terms of defensive pairings, forward lines, and competition, as well as an analysis of where these scoring chances take place, may help settle this debate, but that is an issue for another lab assignment.

MedlinePlus [Internet]. Bethesda (MD): National Library of Medicine (US); [updated 2022 Jul 8]. Handedness; Available from: https://medlineplus.gov/genetics/understanding/traits/handedness/