Visualisation Portfolio

Creating shot maps for the 2012 Champions League Final (Bayern Munich vs Chelsea)

Retrieve match data for Champions League 2011/2012 season, filtering for the final (match_id 18237)

competition <- FreeCompetitions() %>% 
  filter(competition_name == "Champions League" & season_name == "2011/2012")

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

competition_data <- FreeMatches(competition) %>% 
  filter(match_id == 18237)

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

# Extract detailed match data
single_match_data <- get.matchFree(competition_data) %>% allclean()

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(period, match_id)`

Filter data for shots taken by Bayern Munich in this match

single_team <- single_match_data %>% 
  filter(team.name == "Bayern Munich", type.name == "Shot") %>% 
  select(period, minute, type.name, pass.length, pass.angle, player.name, 
         location.x, location.y, shot.statsbomb_xg, shot.technique.name, 
         shot.body_part.name, shot.type.name, shot.outcome.name, 
         shot.end_location.x, shot.end_location.y, shot.end_location.z) %>%
  mutate(goal = case_when(shot.outcome.name == "Goal" ~ "True", TRUE ~ "False")) %>% 
  filter(period != 5)

# Preview processed shot data for Bayern Munich
head(single_team)

## # A tibble: 6 × 17
##   period minute type.name pass.length pass.angle player.name          location.x
##    <int>  <int> <chr>           <dbl>      <dbl> <chr>                     <dbl>
## 1      1      4 Shot               NA         NA Bastian Schweinstei…         98
## 2      1      4 Shot               NA         NA Toni Kroos                  100
## 3      1      7 Shot               NA         NA Arjen Robben                106
## 4      1     12 Shot               NA         NA Mario Gómez García          111
## 5      1     17 Shot               NA         NA Arjen Robben                109
## 6      1     20 Shot               NA         NA Arjen Robben                109
## # ℹ 10 more variables: location.y <dbl>, shot.statsbomb_xg <dbl>,
## #   shot.technique.name <chr>, shot.body_part.name <chr>, shot.type.name <chr>,
## #   shot.outcome.name <chr>, shot.end_location.x <dbl>,
## #   shot.end_location.y <dbl>, shot.end_location.z <dbl>, goal <chr>

Plotting Shot Map for Bayern Munich - 2012 CL Final

Create shot map visualization

create_Pitch(grass_colour = "gray10", background_colour = "black", line_colour = "gray50") +
  geom_point(data = single_team, aes(x = location.x, y = location.y, fill = goal, size = shot.statsbomb_xg), 
             color = "gray75", pch = 21) +
  scale_size_continuous(limits = c(0, 1), breaks = c(0.25, 0.5, 0.75, 1), labels = c("0.25", "0.5", "0.75", "1")) +
  scale_fill_manual(breaks = c("True", "False"), values = c("limegreen", "gray30"), labels = c("Goal", "No Goal")) +
  scale_x_continuous(limits = c(0, 120)) +
  scale_y_continuous(limits = c(0, 80)) +
  theme(
    plot.background = element_rect(fill = "black"), 
    plot.title = element_text(color = "white", hjust = 0.5, size = 22, face = "bold", family = "Arial"),
    plot.subtitle = element_text(color = "white", hjust = 0.5, size = 14, face = "italic"),
    legend.position = "bottom", 
    legend.background = element_rect(fill = "black", color = NA),
    legend.key = element_rect(fill = "black", color = NA),
    legend.title = element_text(color = "white", face = "bold"),
    legend.text = element_text(color = "white")
  ) +
  labs(
    title = "Bayern Munich - 2012 CL Final Shot Map",
    subtitle = "Total xG = 3.49",
    fill = "Outcome",
    size = "xG"
  ) +
  coord_flip(xlim = c(60, 120), ylim = c(0, 80)) +
  guides(
    fill = guide_legend(order = 1),
    size = guide_legend(order = 2)
  )

## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Analyzing Johan Cruyff’s Carries in 1970/71 European Cup Final

# Retrieve 1970/1971 European Cup data and filter for Johan Cruyff's carries
competition2 <- FreeCompetitions() %>% 
  filter(competition_name == "Champions League" & season_name == "1970/1971")

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

competition2_data <- FreeMatches(competition2)

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

Ajax_Ucl_Events <- get.matchFree(competition2_data) %>% allclean()

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(period, match_id)`

# Filter for Johan Cruyff's carry events
Cruyff_UCL_Carries <- Ajax_Ucl_Events %>% 
  filter(player.name == "Johan Cruyff" & type.name == "Carry")

# Plot Cruyff's carries in the match
create_Pitch(grass_colour = "gray10", background_colour = "black", line_colour = "gray50") +
  geom_segment(data = Cruyff_UCL_Carries, 
               aes(x = location.x, y = location.y, xend = carry.end_location.x, yend = carry.end_location.y), 
               color = "red", arrow = arrow(length = unit(0.025, "npc"), type = "closed"), linewidth = 0.8) +
  labs(
    title = "Johan Cruyff Carries - 1970/71 European Cup Final", 
    subtitle = "Ajax vs Panathinaikos | 2nd June 1971 | Wembley Stadium"
  ) +
  theme(
    plot.background = element_rect(fill = "black"), 
    plot.title = element_text(color = "white", hjust = 0.5, size = 20, face = "bold", family = "Arial"),
    plot.subtitle = element_text(color = "lightgray", hjust = 0.5, size = 14, face = "italic"),
    panel.grid = element_blank()
  )

Diego Maradona’s Carries with Boca Juniors (1981)

Load and filter Diego Maradona’s carries for Boca Juniors in the 1981 Argentine League

Argentina <- FreeCompetitions() %>% filter(competition_name == "Liga Profesional" & season_name == "1981")

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

Argentina_Data <- FreeMatches(Argentina)

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

Maradona_Data <- get.matchFree(Argentina_Data) %>% allclean()

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(period, match_id)`

Maradona_Carries <- Maradona_Data %>% filter(type.name == "Carry", player.name == "Diego Armando Maradona")

Plot Maradona’s carries

# Plot Maradona's carries
create_Pitch(grass_colour = "gray10", background_colour = "black", line_colour = "gray50") +
  geom_segment(data = Maradona_Carries, 
               aes(x = location.x, y = location.y, xend = carry.end_location.x, yend = carry.end_location.y), 
               color = "lightblue", arrow = arrow(length = unit(0.025, "npc"), type = "closed"), size = 0.8) +
  labs(
    title = "Diego Maradona Carries - 1981 Argentine League", 
    subtitle = "Boca Juniors"
  ) +
  theme(
    plot.background = element_rect(fill = "black"), 
    plot.title = element_text(color = "white", hjust = 0.5, size = 20, face = "bold", family = "Arial"),
    plot.subtitle = element_text(color = "lightgray", hjust = 0.5, size = 14, face = "italic"),
    panel.grid = element_blank()
  )

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Brazil’s Shot Map in the 1958 World Cup Final

Load data for the 1958 World Cup Final and filter for Brazil’s shots

competition <- FreeCompetitions() %>% filter(competition_name == "FIFA World Cup" & season_name == "1958")

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

competition_data <- FreeMatches(competition) %>% filter(match_id == 3888705)

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

single_match_data <- get.matchFree(competition_data) %>% allclean()

## [1] "Whilst we are keen to share data and facilitate research, we also urge you to be responsible with the data. Please credit StatsBomb as your data source when using the data and visit https://statsbomb.com/media-pack/ to obtain our logos for public use."

## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(id)`
## Joining with `by = join_by(period, match_id)`

single_team_shots <- single_match_data %>% filter(team.name == "Brazil", type.name == "Shot")

Create the shot map for Brazil with customized pitch

# Process and plot Brazil's shot map
single_team_shots <- single_team_shots %>% 
  mutate(goal = case_when(shot.outcome.name == "Goal" ~ "True", TRUE ~ "False"))

create_Pitch(grass_colour = "gray10", background_colour = "black", line_colour = "gray50") +
  geom_point(data = single_team_shots, 
             mapping = aes(x = location.x, y = location.y, fill = goal, size = shot.statsbomb_xg), 
             color = "gray70", pch = 21) +
  scale_size_continuous(limits = c(0, 1), breaks = c(0.25, 0.5, 0.75, 1), labels = c("0.25", "0.5", "0.75", "1")) +
  scale_fill_manual(breaks = c("True", "False"), values = c("limegreen", "gray30"), labels = c("Goal", "No Goal")) +
  labs(
    title = "1958 World Cup Final Shot Map - Brazil", 
    subtitle = "Total xG = 3.34", 
    fill = "Outcome", 
    size = "xG"
  ) +
  coord_flip(xlim = c(60, 120), ylim = c(0, 80)) +
  theme(
    plot.background = element_rect(fill = "black"),
    plot.title = element_text(color = "white", hjust = 0.5, size = 20, face = "bold"),
    plot.subtitle = element_text(color = "lightgray", hjust = 0.5, size = 14, face = "italic"),
    legend.position = "right",
    legend.background = element_rect(fill = "gray20", color = NA),
    legend.key = element_rect(fill = "black", color = NA),
    legend.title = element_text(color = "white", face = "bold"),
    legend.text = element_text(color = "white")
  ) +
  guides(fill = guide_legend(order = 1), size = guide_legend(order = 2))

Filter and plot Pele’s carries in the 1958 World Cup Final

# Filter and plot Pele's carries
Pele_Carries <- single_match_data %>% 
  filter(type.name == "Carry", player.name == "Édson Arantes do Nascimento")

create_Pitch(grass_colour = "gray10", background_colour = "black", line_colour = "gray50") +
  geom_segment(data = Pele_Carries, 
               aes(x = location.x, y = location.y, xend = carry.end_location.x, yend = carry.end_location.y), 
               color = "limegreen", arrow = arrow(length = unit(0.025, "npc"), type = "closed"), size = 0.8) +
  labs(
    title = "Pele Carries - 1958 World Cup Final", 
    subtitle = "Brazil vs Sweden"
  ) +
  theme(
    plot.background = element_rect(fill = "black"),
    plot.title = element_text(color = "white", hjust = 0.5, size = 24, face = "bold"),
    plot.subtitle = element_text(color = "lightgray", hjust = 0.5, size = 14, face = "italic"),
    panel.grid = element_blank()
  )