The Red Wings Depend Heavily On Their Stars
The Sunday 1 pm games were boring and I needed something to do
After their 4-2 victory over Winnipeg with goals from Dylan Larkin (2), Lucas Raymond, and Alex DeBrincat, one thing that caught my eye was the fact that those three accounted for 49 of Detroit’s 106 goals on the season. To me, that felt quite “top-heavy” relative to other teams around the league so I decided to take a look at the following:
How the Wings’ top-heaviness compared to the rest of the league
The correlation between “top-heaviness” and overall team performance
I started by taking all skaters, grouping them by their teams, and then summing their goal totals to give the total goals scored for the team (Note: Minnesota has one goal scored by a goalie this year). I then colored the team’s top-3 goal scorers blue (sorted by goals scored with ties broken by fewer minutes played, i.e. higher goals per 60) and the remaining goal scorers orange. From this graphic you can see that Detroit’s trio has been one of the most prolific trios in the league, behind only Winnipeg, Tampa, Edmonton, Toronto, and Minnesota in total goals scored.
Looking at it by percentage of goals scored by each team’s top trio, we see that Detroit is the most top-heavy team in the league with 46.2% of their goals coming from Larkin, DeBrincat, and Raymond. That 46.2% would be the 2nd highest percentage of goals from a team’s top trio over the last four seasons (22-23 Edmonton, 47.1%).
To the naked eye, there doesn’t appear to be much of a trend between a team’s standings rank and their top-heaviness. To check the relationship, I plotted each team’s “top-heaviness” vs. their standings points percentage for each of the last three years.
From the graphic above, there’s only a weak correlation between top-heaviness and standings points% as expected because there are a number of different ways to construct a successful team.
What does all of this mean for the Wings? For starters, it’s great that they have their big guns rolling. Your best players have to be your best players and the Wings have had that so far. What will be key moving forward is if the changes made by new head coach Todd McLellan can bolster offense from guys like Patrick Kane, Jonatan Berggren, J.T. Compher, and Andrew Copp. We’ve already seen some good early returns from the new 2nd and 3rd lines under McLellan so if that trend continues and the Wings’ big guns keep scoring, they may be able to mount a serious charge to get back in the playoff race.
In continuation with my previous post, please find the code I used below. I’m not directly providing the data I used as I obtained it from Evolving-Hockey where downloads require a subscription but a similar analysis could be done with data from NHL.com.
library(tidyverse)
library(paletteer)
library(ggpmisc)
data <- read_csv(file.choose())
teams <- data %>%
group_by(Team) %>%
summarize(team_GF = sum(G))
skaters <- data %>%
left_join(teams) %>%
mutate(team_GF = case_when(Team == 'MIN' ~ 119,
TRUE ~ team_GF)) %>%
group_by(Team) %>%
arrange(desc(G), TOI) %>%
mutate(team_rank = row_number(),
top_3 = case_when(team_rank %in% c(1:3) ~ '1',
TRUE ~ '0')) %>%
arrange(Team, top_3)
## All Scorers ##
ggplot(skaters, aes(x = G, y = reorder(Team, team_GF), color = team_rank, fill = factor(top_3, levels = c('0', '1')))) +
geom_col(position = 'stack', color = 'black') +
guides(fill = 'none', color = 'none') +
labs(x = 'Team Goals Scored', y = '', title = 'Where Goals Come From For Each NHL Team', subtitle = 'Each teams top-3 goal scorers colored in blue, remaining skaters colored in orange', caption = 'Data via Evolving-Hockey') +
scale_fill_manual(values = c('#F7AA14FF', '#172869FF')) +
scale_x_continuous(limits = c(0, 150), breaks = seq(0, 150, 25)) +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.subtitle = element_text(family = 'Ubuntu-LightItalic', size = 18),
plot.caption = element_text(family = 'Ubuntu-LightItalic', 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 = 8, width = 12, device = png, 'goalcomp.png')
## Top-Heaviness ##
top_heavy <- data %>%
left_join(teams) %>%
mutate(team_GF = case_when(Team == 'MIN' ~ 119,
TRUE ~ team_GF)) %>%
group_by(Team) %>%
arrange(desc(G), TOI) %>%
mutate(team_rank = row_number(),
top_3 = case_when(team_rank %in% c(1:3) ~ '1',
TRUE ~ '0')) %>%
group_by(Team, top_3) %>%
summarize(tot_goals = sum(G)) %>%
pivot_wider(id_cols = Team, names_from = top_3, values_from = tot_goals) %>%
rename('bottom' = '0',
'top_3' = '1') %>%
ungroup() %>%
mutate(team_GF = bottom + top_3,
perc_top3 = round(top_3/team_GF * 100, 1))
cols <- c('DET' = '#ce1126',
'EDM' = '#FF4C00',
'TOR' = '#00205b',
'T.B' = '#002868',
'MIN' = '#154734',
'WPG' = '#004C97',
'OTT' = '#DA1A32',
'CGY' = '#FAAF19',
'L.A' = '#A2AAAD',
'NSH' = '#FFB81C',
'NYI' = '#f47d30',
'COL' = '#6F263D',
'NYR' = '#0038A8',
'BOS' = '#FFB81C',
'N.J' = '#CE1126',
'BUF' = '#003087',
'FLA' = '#c8102E',
'DAL' = '#006847',
'WSH' = '#041E42',
'VAN' = '#00843d',
'MTL' = '#AF1E2D',
'PIT' = '#FCB514',
'STL' = '#002F87',
'S.J' = '#006D75',
'UTA' = '#71AFE5',
'PHI' = '#F74902',
'CHI' = '#CF0A2C',
'CBJ' = '#002654',
'CAR' = '#CE1126',
'SEA' = '#355464',
'VGK' = '#B4975A',
'ANA' = '#00685e')
ggplot(top_heavy, aes(x = perc_top3, fill = Team, y = reorder(Team, perc_top3))) +
geom_col(color = 'black') +
scale_fill_manual(values = cols) +
guides(fill = 'none') +
labs(x = "% of Goals Scored By Team's Top 3 Goal Scorers", y = '', title = 'The Most Top-Heavy Teams In The NHL', caption = 'Data via Evolving-Hockey') +
scale_x_continuous(limits = c(0, 50), breaks = seq(0, 50, 5)) +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu-LightItalic', 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 = 8, width = 12, device = png, 'heavy.png')
## Top Heaviness By Season ##
data <- read_csv(file.choose())
teams <- read_csv(file.choose())
teams_fix <- teams %>%
select(Name, Team, Season, GF, `Points%`)
top_heavy <- data %>%
left_join(teams_fix) %>%
group_by(Team, Season) %>%
arrange(desc(G), TOI) %>%
mutate(team_rank = row_number(),
top_3 = case_when(team_rank %in% c(1:3) ~ '1',
TRUE ~ '0')) %>%
group_by(Team, Season, top_3) %>%
reframe(tot_goals = sum(G), team_GF = GF, `Points%` = `Points%`) %>%
distinct(Team, Season, top_3, .keep_all = TRUE) %>%
pivot_wider(id_cols = c(Team, Season, team_GF, `Points%`), names_from = top_3, values_from = tot_goals) %>%
rename('bottom' = '0',
'top_3' = '1') %>%
mutate(perc_top3 = round(top_3/team_GF * 100, 1))
cols <- c('DET' = '#ce1126',
'EDM' = '#FF4C00',
'TOR' = '#00205b',
'T.B' = '#002868',
'MIN' = '#154734',
'WPG' = '#004C97',
'OTT' = '#DA1A32',
'CGY' = '#FAAF19',
'L.A' = '#A2AAAD',
'NSH' = '#FFB81C',
'NYI' = '#f47d30',
'COL' = '#6F263D',
'NYR' = '#0038A8',
'BOS' = '#FFB81C',
'N.J' = '#CE1126',
'BUF' = '#003087',
'FLA' = '#c8102E',
'DAL' = '#006847',
'WSH' = '#041E42',
'VAN' = '#00843d',
'MTL' = '#AF1E2D',
'PIT' = '#FCB514',
'STL' = '#002F87',
'S.J' = '#006D75',
'UTA' = '#71AFE5',
'PHI' = '#F74902',
'CHI' = '#CF0A2C',
'CBJ' = '#002654',
'CAR' = '#CE1126',
'SEA' = '#355464',
'VGK' = '#B4975A',
'ANA' = '#00685e')
ggplot(top_heavy, aes(x = perc_top3, y = `Points%`)) +
labs(x = "% of Goals Scored By Team's Top 3 Goal Scorers", y = 'Standings Points%', title = 'Weak Correlation Between Top-Heaviness And Team Performance', subtitle = 'Data from 2021-22 to present', caption = 'Data via Evolving-Hockey') +
stat_poly_line(se = FALSE) +
stat_correlation(use_label(c("r", "p"))) +
geom_point(aes(fill = Team), shape = 21, size = 3, color = 'black') +
scale_fill_manual(values = cols) +
guides(fill = 'none') +
theme_bw() +
theme(plot.title = element_text(family = 'Ubuntu-Bold', size = 22),
plot.caption = element_text(family = 'Ubuntu-LightItalic', size = 16, hjust = 1),
plot.subtitle = element_text(family = 'Ubuntu-LightItalic', size = 18),
axis.text = element_text(family = 'Ubuntu', size = 12),
axis.title = element_text(family = 'Ubuntu-Bold', size = 18))
ggsave(dpi = 700, height = 8, width = 12, device = png, 'heavyseason.png')