Capstone - Complete Analytics System

# Exercise 9.1 Solution: Progressive Ball Movement
library(StatsBombR)
library(dplyr)

# Load World Cup data
comps <- FreeCompetitions() %>%
  filter(competition_id == 43, season_id == 106)
matches <- FreeMatches(comps)
events <- free_allevents(MatchesDF = matches)

# Progressive passes
prog_passes <- events %>%
  filter(type.name == "Pass", is.na(pass.outcome.name)) %>%
  mutate(
    start_x = location.x,
    end_x = pass.end_location.x,
    progress = end_x - start_x,
    is_progressive = progress >= 10 & end_x > start_x & end_x >= 40
  ) %>%
  filter(is_progressive) %>%
  select(player.name, team.name, match_id, progress, type = type.name)

# Progressive carries
prog_carries <- events %>%
  filter(type.name == "Carry") %>%
  mutate(
    start_x = location.x,
    end_x = carry.end_location.x,
    progress = end_x - start_x,
    is_progressive = progress >= 10 & end_x > start_x & end_x >= 40
  ) %>%
  filter(is_progressive) %>%
  select(player.name, team.name, match_id, progress, type = type.name)

# Combine and aggregate
all_progressive <- bind_rows(prog_passes, prog_carries)

ball_progressors <- all_progressive %>%
  group_by(player.name, team.name) %>%
  summarise(
    matches = n_distinct(match_id),
    prog_passes = sum(type == "Pass"),
    prog_carries = sum(type == "Carry"),
    total_progressive = n(),
    total_yards_progressed = sum(progress),
    .groups = "drop"
  ) %>%
  mutate(
    prog_per_90 = round(total_progressive / matches, 2),
    yards_per_90 = round(total_yards_progressed / matches, 1),
    pass_carry_ratio = round(prog_passes / (prog_carries + 0.1), 2)
  ) %>%
  filter(matches >= 4) %>%
  arrange(desc(prog_per_90))

print("Top Ball Progressors:")
print(head(ball_progressors, 15))

# Categorize style
ball_progressors <- ball_progressors %>%
  mutate(
    style = case_when(
      pass_carry_ratio > 5 ~ "Pass Progressor",
      pass_carry_ratio < 2 ~ "Carry Progressor",
      TRUE ~ "Balanced"
    )
  )

print("\nProgression Style Distribution:")
print(table(ball_progressors$style))

# Exercise 9.2 Solution: Pass Network Visualization
library(StatsBombR)
library(dplyr)
library(igraph)
library(ggplot2)
library(ggsoccer)

# Select a match
team_name <- "Argentina"
match_id <- matches$match_id[1]

match_events <- events %>%
  filter(match_id == !!match_id)

# Get completed passes with recipients
team_passes <- match_events %>%
  filter(team.name == team_name,
         type.name == "Pass",
         is.na(pass.outcome.name),
         !is.na(pass.recipient.name))

# Count pass pairs
pass_pairs <- team_passes %>%
  group_by(player.name, pass.recipient.name) %>%
  summarise(passes = n(), .groups = "drop") %>%
  filter(passes >= 3)

# Average positions
avg_pos <- match_events %>%
  filter(team.name == team_name, !is.na(location.x)) %>%
  group_by(player.name) %>%
  summarise(
    x = mean(location.x),
    y = mean(location.y),
    touches = n()
  )

# Build network
g <- graph_from_data_frame(pass_pairs, vertices = avg_pos, directed = FALSE)

# Calculate centrality
V(g)$degree <- degree(g)
V(g)$betweenness <- betweenness(g, normalized = TRUE)

# Find hub player
hub_player <- V(g)$name[which.max(V(g)$betweenness)]
cat("Team Hub (highest betweenness):", hub_player, "\n")

# Prepare for ggplot
edges_df <- pass_pairs %>%
  left_join(avg_pos, by = c("player.name")) %>%
  rename(x_start = x, y_start = y) %>%
  left_join(avg_pos, by = c("pass.recipient.name" = "player.name")) %>%
  rename(x_end = x, y_end = y)

nodes_df <- data.frame(
  player = V(g)$name,
  x = avg_pos$x[match(V(g)$name, avg_pos$player.name)],
  y = avg_pos$y[match(V(g)$name, avg_pos$player.name)],
  degree = V(g)$degree,
  betweenness = V(g)$betweenness
)

# Plot
ggplot() +
  annotate_pitch(colour = "white", fill = "#1B5E20") +
  geom_segment(data = edges_df,
               aes(x = x_start, y = y_start, xend = x_end, yend = y_end,
                   linewidth = passes),
               color = "white", alpha = 0.6) +
  geom_point(data = nodes_df,
             aes(x = x, y = y, size = degree),
             color = "#75AADB", alpha = 0.9) +
  geom_text(data = nodes_df,
            aes(x = x, y = y + 3,
                label = gsub(".* ", "", player)),  # Last name
            color = "white", size = 3) +
  scale_size_continuous(range = c(5, 15)) +
  scale_linewidth_continuous(range = c(0.5, 3)) +
  labs(title = paste(team_name, "Pass Network"),
       subtitle = paste("Hub:", hub_player)) +
  theme_pitch() +
  coord_flip(xlim = c(0, 120), ylim = c(0, 80))

ggsave("pass_network.png", width = 12, height = 8)

# Exercise 9.3 Solution: Pressure Resistance Score
library(StatsBombR)
library(dplyr)
library(ggplot2)

# Analyze passes with pressure info
passes <- events %>%
  filter(type.name == "Pass") %>%
  mutate(
    under_pressure = !is.na(under_pressure) & under_pressure == TRUE,
    completed = is.na(pass.outcome.name)
  )

# Calculate pressure resistance by player
pressure_resistance <- passes %>%
  group_by(player.name, team.name) %>%
  summarise(
    matches = n_distinct(match_id),
    total_passes = n(),

    # Pressured stats
    pressured_attempts = sum(under_pressure),
    pressured_completed = sum(under_pressure & completed),

    # Unpressured stats
    unpressured_attempts = sum(!under_pressure),
    unpressured_completed = sum(!under_pressure & completed),

    .groups = "drop"
  ) %>%
  filter(pressured_attempts >= 20, total_passes >= 100) %>%
  mutate(
    pressured_rate = round(pressured_completed / pressured_attempts * 100, 1),
    unpressured_rate = round(unpressured_completed / unpressured_attempts * 100, 1),
    pressure_drop = round(unpressured_rate - pressured_rate, 1),

    # Pressure resistance score (inverted: lower drop = higher score)
    resistance_score = round(100 - pressure_drop, 1),

    # Rating
    rating = case_when(
      pressure_drop < 5 ~ "Elite",
      pressure_drop < 10 ~ "Good",
      pressure_drop < 15 ~ "Average",
      TRUE ~ "Poor"
    )
  ) %>%
  arrange(pressure_drop)

print("Pressure Resistance Leaders (lowest drop):")
print(head(pressure_resistance %>%
             select(player.name, pressured_rate, unpressured_rate,
                    pressure_drop, rating), 15))

# Visualization
ggplot(pressure_resistance, aes(x = unpressured_rate, y = pressured_rate)) +
  geom_point(aes(color = rating), size = 3, alpha = 0.7) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray") +
  geom_abline(slope = 1, intercept = -10, linetype = "dotted", color = "red") +
  scale_color_manual(values = c("Elite" = "#1B5E20", "Good" = "#4CAF50",
                                "Average" = "#FFC107", "Poor" = "#F44336")) +
  labs(
    title = "Pressure Resistance Analysis",
    subtitle = "Points above dashed line = better under pressure than average",
    x = "Unpressured Completion %",
    y = "Pressured Completion %",
    color = "Rating"
  ) +
  theme_minimal()

ggsave("pressure_resistance.png", width = 10, height = 8)