A Deeper Dive Into "Three-Point Games"
I was bored
I’m warning everyone now of the following:
This is a very strange topic that I find fascinating
There are no hugely consequential findings here
I’ve had three toddler playdates at my house this week and I needed an excuse to make colorful graphs
Nearly 15 years ago, Ryan Pike penned an article discussing the impact of eliminating ties prior to the 2005-2006 season. In his article he found that nearly a quarter of all games were tied after regulation and necessitated overtime or a shootout to determine a winner. With these games now resulting in three points being awarded (two to the winner, one to the overtime/shootout loser), a new league “average” was ushered in. Now, league average teams were teams that earned ~92 points, nearly 10 more points than before.
Ryan’s piece was published in 2011 so I wanted to revisit the data to see if the trend has changed in any meaningful way.
Picking up in 2013-2014 (first full season after the 2012-2013 lockout), we can see that the percentage of three-point games has ever so slightly dipped from 25% to 20% nearly halfway through this season. For me, there were two natural next questions to ask:
Are games that go beyond regulation ending in overtime or continuing to a shootout at a consistent rate?
Does the percentage of three-point games change over the course of a season?
Tackling question one first, I did uncover an interesting trend - just over four percent of games are ending in a shootout, an all-time low since the introduction of the shootout in 2005-2006.
The above graphic depicts the percentage of games finishing in regulation, overtime, and a shootout. The first thing that jumps out is the substantial drop in shootouts from 2014-2015 (13.8%) to 2015-2016 (8.7%). That can largely be explained by the adoption of 3-on-3 overtime in 2015-2016. However, from 2015-2016 (8.7%) to present (4.3%), the percentage of games resulting in a shootout has been cut in half. I’m not sure if there’s an active reason for this or if teams are pressing harder in overtime to get the win nowadays but I found it interesting nonetheless.
As for my question of if the percentage of three-point games changes over the course of a season - my hypothesis was that there would be a noticeable increase in three-point games over the course of the season as teams opt for a more risk-averse style of play.
Interestingly, there does not appear to be any meaningful trend and if anything there appears to be a very slight decrease in a handful of years.
The last two questions I had on my quest to understand the distribution of three-point games was to see if the prevalence varied by intradivisional or intraconference matchups. Would teams be more “risk-averse” when playing against teams they are competing with for playoff positions and would the result be more three-point games?
The graphic above depicts the variation in three-point games by division, omitting the 2020-2021 year where the divisions were laid out differently and all games were within the division. Comparing these rates to the leaguewide rates from the first graphic we can see that in some years, the intradivisional games yielded more three-point games, with the Atlantic Division being particularly generous last year with nearly 31% of intradivisional games awarding three points. Interestingly, this year that rate is just 10% through 36 intradivisional games. There’s another 70 divisional games to go but it will be interesting to see if that trend holds up. The Atlantic isn’t the only division seeing a significant drop this year as both the Pacific and Metro have seen big drops in intradivisional three-point games.
At the intraconference level, the changes observed in the Atlantic and Metro are reflected here with the significant drop in three-point games in the East. Otherwise, there’s not too much remarkable here.
Overall, I walked into this with a lot of questions and walked away with a lot of shoulder shrugs and audible “mehs”. However in the interest of #science, I felt compelled to put the findings out there in case others were interested. If you made it this far, I commend you and award you three stat nerd points that are not redeemable anywhere. If you’d like additional nonredeemable nerd points, I’ve shared the code to accessing the data and graphs below
library(jsonlite)
library(tidyverse)
library(paletteer)
library(pbapply)
#2024-2025#
## Create URL for Game IDs ##
first <- "https://api-web.nhle.com/v1/score/"
ids <- seq(as.Date("2024-10-04"), as.Date("2024-12-24"), by="days")
## Paste URLs and iterate over ##
game_urls <- paste0(first, ids)
game_data <- pblapply(game_urls, fromJSON)
games_2024 <- game_data %>%
map(~keep(.x, str_detect(names(.x), fixed("games")))) %>%
unlist(recursive = FALSE) %>%
map_dfr(as_tibble, .name_repair = "minimal") %>%
unnest(cols = c(venue, awayTeam, homeTeam, clock, periodDescriptor, gameOutcome), names_sep = "_") %>%
select(season, id, gameScheduleState, gameType, gameDate, awayTeam_abbrev, homeTeam_abbrev, awayTeam_score, homeTeam_score, periodDescriptor_number, gameOutcome_lastPeriodType) %>%
filter(gameScheduleState == 'OK' & gameType == 2)
#2023-2024#
## Create URL for Game IDs ##
first <- "https://api-web.nhle.com/v1/score/"
ids <- seq(as.Date("2023-10-10"), as.Date("2024-04-18"), by="days")
## Paste URLs and iterate over ##
game_urls <- paste0(first, ids)
game_data <- pblapply(game_urls, fromJSON)
games_2023 <- game_data %>%
map(~keep(.x, str_detect(names(.x), fixed("games")))) %>%
unlist(recursive = FALSE) %>%
map_dfr(as_tibble, .name_repair = "minimal") %>%
unnest(cols = c(venue, awayTeam, homeTeam, clock, periodDescriptor, gameOutcome), names_sep = "_") %>%
select(season, id, gameScheduleState, gameType, gameDate, awayTeam_abbrev, homeTeam_abbrev, awayTeam_score, homeTeam_score, periodDescriptor_number, gameOutcome_lastPeriodType) %>%
filter(gameScheduleState == 'OK' & gameType == 2)
#2022-2023#
## Create URL for Game IDs ##
first <- "https://api-web.nhle.com/v1/score/"
ids <- seq(as.Date("2022-10-07"), as.Date("2023-06-13"), by="days")
## Paste URLs and iterate over ##
game_urls <- paste0(first, ids)
game_data <- pblapply(game_urls, fromJSON)
games_2022 <- game_data %>%
map(~keep(.x, str_detect(names(.x), fixed("games")))) %>%
unlist(recursive = FALSE) %>%
map_dfr(as_tibble, .name_repair = "minimal") %>%
unnest(cols = c(venue, awayTeam, homeTeam, clock, periodDescriptor, gameOutcome), names_sep = "_") %>%
select(season, id, gameScheduleState, gameType, gameDate, awayTeam_abbrev, homeTeam_abbrev, awayTeam_score, homeTeam_score, periodDescriptor_number, gameOutcome_lastPeriodType) %>%
filter(gameScheduleState == 'OK' & gameType == 2)
#2021-2022#
## Create URL for Game IDs ##
first <- "https://api-web.nhle.com/v1/score/"
ids <- seq(as.Date("2021-10-12"), as.Date("2022-06-26"), by="days")
## Paste URLs and iterate over ##
game_urls <- paste0(first, ids)
game_data <- pblapply(game_urls, fromJSON)
games_2021 <- game_data %>%
map(~keep(.x, str_detect(names(.x), fixed("games")))) %>%
unlist(recursive = FALSE) %>%
map_dfr(as_tibble, .name_repair = "minimal") %>%
unnest(cols = c(venue, awayTeam, homeTeam, clock, periodDescriptor, gameOutcome), names_sep = "_") %>%
select(season, id, gameScheduleState, gameType, gameDate, awayTeam_abbrev, homeTeam_abbrev, awayTeam_score, homeTeam_score, periodDescriptor_number, gameOutcome_lastPeriodType) %>%
filter(gameScheduleState == 'OK' & gameType == 2)
#2019-2021#
## Create URL for Game IDs ##
first <- "https://api-web.nhle.com/v1/score/"
ids <- seq(as.Date("2019-10-02"), as.Date("2021-07-07"), by="days")
## Paste URLs and iterate over ##
game_urls <- paste0(first, ids)
game_data <- pblapply(game_urls, fromJSON)
games_2019_to_2021 <- game_data %>%
map(~keep(.x, str_detect(names(.x), fixed("games")))) %>%
unlist(recursive = FALSE) %>%
map_dfr(as_tibble, .name_repair = "minimal") %>%
unnest(cols = c(venue, awayTeam, homeTeam, clock, periodDescriptor, gameOutcome), names_sep = "_") %>%
select(season, id, gameScheduleState, gameType, gameDate, awayTeam_abbrev, homeTeam_abbrev, awayTeam_score, homeTeam_score, periodDescriptor_number, gameOutcome_lastPeriodType) %>%
filter(gameScheduleState == 'OK' & gameType == 2)
#2013-2019#
## Create URL for Game IDs ##
first <- "https://api-web.nhle.com/v1/score/"
ids <- seq(as.Date("2013-10-01"), as.Date("2019-06-12"), by="days")
## Paste URLs and iterate over ##
game_urls <- paste0(first, ids)
game_data <- pblapply(game_urls, fromJSON)
games_2013_to_2019 <- game_data %>%
map(~keep(.x, str_detect(names(.x), fixed("games")))) %>%
unlist(recursive = FALSE) %>%
map_dfr(as_tibble, .name_repair = "minimal") %>%
unnest(cols = c(venue, awayTeam, homeTeam, clock, periodDescriptor, gameOutcome), names_sep = "_") %>%
select(season, id, gameScheduleState, gameType, gameDate, awayTeam_abbrev, homeTeam_abbrev, awayTeam_score, homeTeam_score, periodDescriptor_number, gameOutcome_lastPeriodType) %>%
filter(gameScheduleState == 'OK' & gameType == 2)
full_games_data <- games_2013_to_2019 %>%
full_join(games_2019_to_2021) %>%
full_join(games_2021) %>%
full_join(games_2022) %>%
full_join(games_2023) %>%
full_join(games_2024)
## Percent 3-pt games by Season ##
full_games <- full_games_data %>%
mutate(three_pt_game = case_when(gameOutcome_lastPeriodType %in% c('OT', 'SO') ~ 1,
TRUE ~ 0)) %>%
group_by(season) %>%
summarize(tot_games = n(), tot_3_pt = sum(three_pt_game), perc_3_pt = tot_3_pt/tot_games)
ggplot(full_games, aes(x = as.character(season), y = perc_3_pt, group = 1)) +
geom_line(linewidth = 1.25) +
geom_point(shape = 21, fill = 'goldenrod', color = 'black', size = 3) +
scale_y_continuous(limits = c(0, 0.3), breaks = seq(0, 0.3, 0.05)) +
labs(x = '', y = 'Percentage of Games Awarding 3 Points', title = 'The Percentage of 3-Point Games Is Slowly Dwindling') +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu', size = 16, hjust = 1),
axis.text = element_text(family = 'Ubuntu', size = 12),
axis.title = element_text(family = 'Ubuntu-Bold', size = 18))
ggsave(dpi = 700, height = 7, width = 12, device = png, '3ptgames_total.png')
## Percent 3-pt games by Division ##
division <- full_games_data %>%
mutate(home_team_div = case_when(season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & homeTeam_abbrev %in% c('MTL', 'DET', 'BOS', 'BUF', 'TOR', 'TBL', 'FLA', 'OTT') ~ 'ATL',
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & homeTeam_abbrev %in% c('PHI', 'PIT', 'WSH', 'NJD', 'CAR', 'CBJ', 'NYI', 'NYR') ~ 'MET',
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & homeTeam_abbrev %in% c('CHI', 'COL', 'MIN', 'STL', 'DAL', 'WPG', 'NSH') ~ 'CEN',
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & homeTeam_abbrev %in% c('VGK', 'EDM', 'CGY', 'VAN', 'ARI', 'PHX', 'ANA', 'LAK', 'SJS') ~ 'PAC',
season == 20202021 & homeTeam_abbrev %in% c('CAR', 'FLA', 'TBL', 'NSH', 'DAL', 'CHI', 'DET', 'CBJ') ~ 'CEN - COV',
season == 20202021 & homeTeam_abbrev %in% c('COL', 'VGK', 'MIN', 'STL', 'ARI', 'LAK', 'SJS', 'ANA') ~ 'WES',
season == 20202021 & homeTeam_abbrev %in% c('PIT', 'WSH', 'BOS', 'NYI', 'NYR', 'PHI', 'NJD', 'BUF') ~ 'EAS',
season == 20202021 & homeTeam_abbrev %in% c('TOR', 'EDM', 'WPG', 'MTL', 'CGY', 'OTT', 'VAN') ~ 'NOR',
season %in% c(20212022, 20222023, 20232024, 20242025) & homeTeam_abbrev %in% c('FLA', 'TOR', 'TBL', 'BOS', 'BUF', 'DET', 'OTT', 'MTL') ~ 'ATL',
season %in% c(20212022, 20222023, 20232024, 20242025) & homeTeam_abbrev %in% c('CAR', 'NYR', 'PIT', 'WSH', 'NYI', 'CBJ', 'NJD', 'PHI') ~ 'MET',
season %in% c(20212022, 20222023, 20232024, 20242025) & homeTeam_abbrev %in% c('COL', 'MIN', 'STL', 'DAL', 'NSH', 'WPG', 'CHI', 'ARI', 'UTA') ~ 'CEN',
season %in% c(20212022, 20222023, 20232024, 20242025) & homeTeam_abbrev %in% c('CGY', 'EDM', 'LAK', 'VGK', 'VAN', 'SJS', 'ANA', 'SEA') ~ 'PAC'),
away_team_div = case_when(season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & awayTeam_abbrev %in% c('MTL', 'DET', 'BOS', 'BUF', 'TOR', 'TBL', 'FLA', 'OTT') ~ 'ATL',
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & awayTeam_abbrev %in% c('PHI', 'PIT', 'WSH', 'NJD', 'CAR', 'CBJ', 'NYI', 'NYR') ~ 'MET',
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & awayTeam_abbrev %in% c('CHI', 'COL', 'MIN', 'STL', 'DAL', 'WPG', 'NSH') ~ 'CEN',
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020) & awayTeam_abbrev %in% c('VGK', 'EDM', 'CGY', 'VAN', 'ARI', 'PHX', 'ANA', 'LAK', 'SJS') ~ 'PAC',
season == 20202021 & awayTeam_abbrev %in% c('CAR', 'FLA', 'TBL', 'NSH', 'DAL', 'CHI', 'DET', 'CBJ') ~ 'CEN - COV',
season == 20202021 & awayTeam_abbrev %in% c('COL', 'VGK', 'MIN', 'STL', 'ARI', 'LAK', 'SJS', 'ANA') ~ 'WES',
season == 20202021 & awayTeam_abbrev %in% c('PIT', 'WSH', 'BOS', 'NYI', 'NYR', 'PHI', 'NJD', 'BUF') ~ 'EAS',
season == 20202021 & awayTeam_abbrev %in% c('TOR', 'EDM', 'WPG', 'MTL', 'CGY', 'OTT', 'VAN') ~ 'NOR',
season %in% c(20212022, 20222023, 20232024, 20242025) & awayTeam_abbrev %in% c('FLA', 'TOR', 'TBL', 'BOS', 'BUF', 'DET', 'OTT', 'MTL') ~ 'ATL',
season %in% c(20212022, 20222023, 20232024, 20242025) & awayTeam_abbrev %in% c('CAR', 'NYR', 'PIT', 'WSH', 'NYI', 'CBJ', 'NJD', 'PHI') ~ 'MET',
season %in% c(20212022, 20222023, 20232024, 20242025) & awayTeam_abbrev %in% c('COL', 'MIN', 'STL', 'DAL', 'NSH', 'WPG', 'CHI', 'ARI', 'UTA') ~ 'CEN',
season %in% c(20212022, 20222023, 20232024, 20242025) & awayTeam_abbrev %in% c('CGY', 'EDM', 'LAK', 'VGK', 'VAN', 'SJS', 'ANA', 'SEA') ~ 'PAC'),
div_matchup = case_when(home_team_div == away_team_div ~ 1,
TRUE ~ 0),
three_pt_game = case_when(gameOutcome_lastPeriodType %in% c('OT', 'SO') ~ 1,
TRUE ~ 0))
div_3pt <- division %>%
mutate(div_match = case_when(home_team_div == 'ATL' & away_team_div == 'ATL' ~ 'ATL',
home_team_div == 'PAC' & away_team_div == 'PAC' ~ 'PAC',
home_team_div == 'CEN' & away_team_div == 'CEN' ~ 'CEN',
home_team_div == 'MET' & away_team_div == 'MET' ~ 'MET',
TRUE ~ 'COVID'),
season_short = substr(season, 0, 4)) %>%
filter(div_match != 'COVID') %>%
group_by(div_match, season_short) %>%
summarize(tot_games = n(), tot_3pt = sum(three_pt_game), perc_3pt = tot_3pt/tot_games)
ggplot(div_3pt, aes(x = as.character(season_short), y = perc_3pt, group = 1, fill = div_match)) +
geom_line() +
geom_point(shape = 21, size = 3) +
scale_fill_paletteer_d("nationalparkcolors::Acadia") +
scale_y_continuous(limits = c(0, 0.4), breaks = seq(0, 0.4, 0.05)) +
labs(x = '', y = 'Percentage of Games Awarding 3 Points', title = 'Variation in 3 Point Games by Division', caption = 'Note: Divisions were different for 2020-2021\nData via NHL.com') +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu', size = 12, hjust = 1),
axis.text = element_text(family = 'Ubuntu', size = 10),
axis.title = element_text(family = 'Ubuntu-Bold', size = 18),
legend.position = 'bottom',
legend.key.size = unit(1, 'cm'),
legend.title = element_blank(),
legend.text = element_text(family = 'Ubuntu-Bold', size = 14),
strip.background = element_blank(),
strip.text = element_text(family = 'Ubuntu-Bold', size = 16)) +
facet_wrap(~div_match)
ggsave(dpi = 700, height = 7, width = 12, device = png, 'div3pt.png')
## Percent 3-pt games by Conference ##
conf <- full_games_data %>%
filter(season != 20202021) %>%
mutate(home_team_conf = case_when(homeTeam_abbrev %in% c('MTL', 'DET', 'BOS', 'BUF', 'TOR', 'TBL', 'FLA', 'OTT', 'PHI', 'PIT', 'WSH', 'NJD', 'CAR', 'CBJ', 'NYI', 'NYR') ~ 'EAST',
homeTeam_abbrev %in% c('CHI', 'COL', 'MIN', 'STL', 'DAL', 'WPG', 'NSH', 'VGK', 'EDM', 'CGY', 'VAN', 'ARI', 'PHX', 'ANA', 'LAK', 'SJS', 'SEA', 'UTA') ~ 'WEST'),
away_team_conf = case_when(awayTeam_abbrev %in% c('MTL', 'DET', 'BOS', 'BUF', 'TOR', 'TBL', 'FLA', 'OTT', 'PHI', 'PIT', 'WSH', 'NJD', 'CAR', 'CBJ', 'NYI', 'NYR') ~ 'EAST',
awayTeam_abbrev %in% c('CHI', 'COL', 'MIN', 'STL', 'DAL', 'WPG', 'NSH', 'VGK', 'EDM', 'CGY', 'VAN', 'ARI', 'PHX', 'ANA', 'LAK', 'SJS', 'SEA', 'UTA') ~ 'WEST'),
conf_matchup = case_when(home_team_conf == away_team_conf ~ 1,
TRUE ~ 0),
three_pt_game = case_when(gameOutcome_lastPeriodType %in% c('OT', 'SO') ~ 1,
TRUE ~ 0))
conf_3pt <- conf %>%
mutate(conf_match = case_when(home_team_conf == 'EAST' & away_team_conf == 'EAST' ~ 'EAST',
home_team_conf == 'WEST' & away_team_conf == 'WEST' ~ 'WEST',
TRUE ~ 'COVID'),
season_short = substr(season, 0, 4)) %>%
filter(conf_match != 'COVID') %>%
group_by(conf_match, season_short) %>%
summarize(tot_games = n(), tot_3_pt = sum(three_pt_game), perc_3_pt = tot_3_pt/tot_games)
ggplot(conf_3pt, aes(x = as.character(season_short), y = perc_3_pt, group = conf_match, fill = conf_match)) +
geom_line() +
geom_point(shape = 21, size = 3) +
scale_fill_paletteer_d("nationalparkcolors::Acadia") +
scale_y_continuous(limits = c(0, 0.4), breaks = seq(0, 0.4, 0.05)) +
labs(x = '', y = 'Percentage of Games Awarding 3 Points', title = 'Variation in 3 Point Games by Conference', caption = 'Note: Conferences were different for 2020-2021\nData via NHL.com') +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu', size = 12, hjust = 1),
axis.text = element_text(family = 'Ubuntu', size = 10),
axis.title = element_text(family = 'Ubuntu-Bold', size = 18),
legend.position = 'bottom',
legend.key.size = unit(1, 'cm'),
legend.title = element_blank(),
legend.text = element_text(family = 'Ubuntu-Bold', size = 14),
strip.background = element_blank(),
strip.text = element_text(family = 'Ubuntu-Bold', size = 16))
ggsave(dpi = 700, height = 7, width = 12, device = png, 'conf3pt.png')
## Games finishing in REG, OT, SO ##
finish <- full_games_data %>%
group_by(gameOutcome_lastPeriodType, season) %>%
summarize(n = n()) %>%
pivot_wider(names_from = 'gameOutcome_lastPeriodType', values_from = n) %>%
mutate(n = REG + SO + OT,
Reg = REG/n,
OT = OT/n,
SO = SO/n) %>%
pivot_longer(names_to = 'finish',
values_to = 'perc',
cols = c(Reg, OT, SO)) %>%
mutate(finish = factor(finish, levels=c('SO', 'OT', 'Reg')),
season = as.character(season))
ggplot(finish, aes(x = season, y = perc, fill = finish)) +
geom_bar(position = 'stack', stat = 'identity', color = 'black') +
geom_text(aes(label = paste0(round(perc*100, 1),"%"), y = perc), position = position_stack(vjust = 0.5), size = 3, color = 'white') +
scale_fill_paletteer_d("nationalparkcolors::Acadia") +
labs(x = '', y = 'Percentage', caption = 'Data via NHL.com', title = 'NHL Teams Are Slowly Phasing Out The Shootout') +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu', size = 16, hjust = 1),
axis.text = element_text(family = 'Ubuntu', size = 12),
axis.title = element_text(family = 'Ubuntu-Bold', size = 18),
legend.position = 'bottom',
legend.key.size = unit(1, 'cm'),
legend.title = element_blank(),
legend.text = element_text(family = 'Ubuntu', size = 12))
ggsave(dpi = 700, height = 7, width = 12, device = png, 'shootout.png')
## Games finishing in REG, OT, SO by month ##
months <- full_games_data %>%
mutate(gameDate = as.Date(gameDate, fmt = "%Y-%m-%d"),
gameMonth = month(gameDate, label = TRUE),
monthNumber = case_when(season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020, 20212022, 20222023, 20232024, 20242025) & gameMonth == 'Oct' ~ 1,
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020, 20212022, 20222023, 20232024, 20242025) & gameMonth == 'Nov' ~ 2,
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020, 20212022, 20222023, 20232024, 20242025) & gameMonth == 'Dec' ~ 3,
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020, 20212022, 20222023, 20232024) & gameMonth == 'Jan' ~ 4,
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020, 20212022, 20222023, 20232024) & gameMonth == 'Feb' ~ 5,
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20192020, 20212022, 20222023, 20232024) & gameMonth == 'Mar' ~ 6,
season %in% c(20132014, 20142015, 20152016, 20162017, 20172018, 20182019, 20212022, 20222023, 20232024) & gameMonth == 'Apr' ~ 7,
season == 20212022 & gameMonth == 'May' ~ 8,
season == 20202021 & gameMonth == 'Jan' ~ 1,
season == 20202021 & gameMonth == 'Feb' ~ 2,
season == 20202021 & gameMonth == 'Mar' ~ 3,
season == 20202021 & gameMonth == 'Apr' ~ 4,
season == 20202021 & gameMonth == 'May' ~ 5),
three_pt_game = case_when(gameOutcome_lastPeriodType %in% c('OT', 'SO') ~ 1,
TRUE ~ 0)) %>%
group_by(season, monthNumber) %>%
summarize(tot_games = n(), tot_3_pt = sum(three_pt_game), perc_3_pt = tot_3_pt/tot_games)
ggplot(months, aes(x = monthNumber, y = perc_3_pt, fill = as.character(season), group = season)) +
geom_line() +
geom_point(shape = 21, size = 3) +
scale_fill_paletteer_d("colorBlindness::PairedColor12Steps") +
scale_y_continuous(limits = c(0, 0.4), breaks = seq(0, 0.4, 0.1)) +
scale_x_continuous(limits = c(1, 7), breaks = seq(1, 7, 1)) +
labs(x = 'Month Number', y = 'Percentage of Games Awarding 3 Points', title = 'Variation in 3 Point Games by Month of Season', caption = 'Data via NHL.com') +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu', size = 12, hjust = 1),
axis.text = element_text(family = 'Ubuntu', size = 10),
axis.title = element_text(family = 'Ubuntu-Bold', size = 18),
legend.position = 'none',
strip.background = element_blank(),
strip.text = element_text(family = 'Ubuntu-Bold', size = 16)) +
facet_wrap(~season)
ggsave(dpi = 700, height = 8, width = 12, device = png, 'months.png')
I'm not sure if I'm willing to call this a trend, but it's a trend-ish, and that's better than nothing. Three point games suck. They muddle up the standings, make it impossible to make up ground on anybody anywhere, and in the end reward a team for playing for a tie, something that I don't think any sport should ever do. The fewer three point games the better in my opinion. I'd love if we didn't have to reward teams for playing for a tie at all, but it's not my league.
The same goes for shootouts. Shootouts are not an alternative to ties. They are an alternative to hockey, and I'm very happy that they seem to be disappearing. I think the next logical question would be why that is. Are shootouts dependent on skill? Does the better team systematically win the shootout more often than the less good team, or are they entirely luck-based? I'm too much of a novice in hockey numbers to know the answer to that question, but that would be a good place to start. Either way. Two thumbs up to all the teams for getting that junk out of the average game altogether!
Just like three point games, I'd love if we could get from 5% to zero percent of all games featuring a shootout, but for whatever reason the NHL seems to want to cling onto this gimmick for dear life, so it's on the teams to get rid of it themselves, and good on them for that.
It certainly looks like randomness across time. The one part about three point games declining later in seasons might reflect widening disparity between playoff teams and non playoff teams as the season progresses. Non-playoff rosters are weaker after the trade deadline redistribution of talent upward and non-playoff teams have more reasons to just “mail it in”