What is Dangerousity?

You may have heard the term ‘expected goals’ being thrown around a number of different sports in recent years. For those who are not familiar with the term, it is a statistical metric used primarily in soccer to measure the quality of scoring chances. It quantifies how likely a shot is to result in a goal based on various factors. It takes into account shot location, type of shot, defensive pressure and game context such as match score and time remaining.

The downfall of expected goals is it fails to measure how likely a goal is to occur at all times, not just during a goal scoring opportunity. Shifting our focus to AFL, if the ball is 100m from goal, a player is not thinking about shooting, however may be travelling at speed with a number of open teammates open ahead of the ball. A lot of players, coaches and fans would consider this a dangerous situation despite the immediate ball player not being in a goal scoring situation.

That is what we are going to doing today. Measuring how dangerous any given moment is in an AFL game. We will attribute a value ranging from 0 - 1 to do so. This value is what will be known as our ‘Dangerousity’ score. The closer this value is to 1, the more likely a play is to result in a goal.

Load Data and Packages

The AFL data we are using for today includes 102 different plays from real AFL games. We are given x and y coordinates of all players on the field, information on what player has possession of the ball, what team each player is playing for and the velocity at which they are travelling at. As well as this, each play is labeled as either a set play or general play. From this we have to calculate how dangerous each situation is. The code below loads the required packages needed for the analysis as well as the AFL data we just mentioned.

library(tidyverse)
library(ggplot2)
afl<- read.csv("AT2_afl_data.csv", stringsAsFactors = F)
head(afl, 1)
##   id_play player_id team clock        x        y        v on_ball   play_phase
## 1    2240    250267  att  89.6 51.24058 2.879112 3.533272       0 GENERAL_PLAY

Plotting Plays

The code snippet below plots any play on an AFL oval, as long as you feed it the unique play id.

plot_play <- 4468 # Insert Play ID

# Plots play on AFL Oval
ground <- c(160, 129)
angle <- seq(-pi, pi, length = 50)
oval <- data.frame(y = ground[2]/2 * cos(angle), x = ground[1]/2 * sin(angle))


ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  ggtitle(plot_play)

Our Dangerousity Formula

Our Dangerousity formula has been created through domain knowledge of AFL in an attempt to measure dangerous situations in a way that has not been done before.

This formula calculates what our dangerousity score for each play is. However, we do not yet know what all these variables mean. Below is a guide to what they mean:

  • LongR = Longitude Rating

  • LatR = Latitude Rating

  • Set = 1 IF play is in general play & 0 IF play is a set play

  • Velocity = Rating of speed in comparison to closest opponent

  • PhaseR = Rating of phase of play, how well is the ground set up for a goal scoring chance

  • TOA = Teammates Open Ahead

  • Control = Control of space ahead of the ball = 1, no control = 0

  • PressureR = Pressure Rating

  • MaxDenom = The max value of the equation that takes place as the denominator. This gives us a value that ranges from 0 - 1

The Following Code is how we completed this study

# LongR & LatR Calculation ----
# Calculate Distance and Angle from goal for ball player 
afl<- afl |> 
  mutate(long = ifelse(on_ball == 1, 80 - x, NA),
         lat = ifelse(on_ball == 1, abs(0 - y),NA))

# Give rating of each distance metric based off of rating system created in report
afl<- afl |>  # LongR
  mutate(longR = case_when(
    long >=0 & long <=10 ~ 1,
    long >=10.01 & long <=20 ~ 0.9,
    long >=20.01 & long <=30 ~ 0.8,
    long >=30.01 & long <=40 ~ 0.7,
    long >=40.01 & long <=45 ~ 0.6,
    long >=45.01 & long <=50 ~ 0.5,
    long >=50.01 & long <=60 ~ 0.4,
    long >=60.001 & long <=70 ~ 0.3,
    long >=70.01 & long <=80 ~ 0.2,
    long >=80.01 ~ 0.1
  ))

afl<- afl |> # LatR
  mutate(latR = case_when(
    lat >= 0 & lat <=3.2 ~ 1, # Width of AFL Goal Posts = 6.4m
    lat >= 3.21 & lat <=9.6 ~ 0.9,
    lat >= 9.61 & lat <=15.6 ~ 0.8,
    lat >= 15.61 & lat <=21.6 ~ 0.7,
    lat >= 21.61 & lat <=27.6 ~ 0.6,
    lat >= 27.61 & lat <=33.6 ~ 0.5,
    lat >= 33.61 & lat <=39.6 ~ 0.4,
    lat >= 39.61 & lat <=45.6 ~ 0.3,
    lat >= 45.61 & lat <=51.6 ~ 0.2,
    lat >= 51.61 ~ 0.1,
  ))

# Set or Open Play ----
afl<- afl |> 
  mutate(
    set = ifelse(play_phase == "SET", 0,1)
  )

# Distance from ball player ----
calculate_distance<- function(x1,y1,x2,y2){
  sqrt((x2 - x1)^2 + (y2 - y1)^2)
}

afl<- afl |> 
  group_by(id_play) |> 
  mutate(
    dist_ball_x = x[on_ball == 1],
    dist_ball_y = y[on_ball == 1],
    dist_to_ball_player = calculate_distance(x,y, dist_ball_x, dist_ball_y)
  ) |> 
  ungroup()

# Label players as behind or infront of the ball 
afl<- afl |> 
  group_by(id_play) |> 
  mutate(
    position_to_ball = case_when(
      on_ball == 0 & x < dist_ball_x ~ "behind",
      on_ball == 0 & x > dist_ball_x ~ "ahead",
      T ~ NA_character_
    )
  ) |> 
  ungroup()

# Pressure Rating ----
# Give pressure scores to player on the ball
# Create Function
calculate_pressure_score<- function(afl){
  score <- 0
  if(any(afl$team == "def" & afl$dist_to_ball_player <1)){
    if (sum(afl$team == "def" & afl$dist_to_ball_player < 1) >=2){
      score <- 3
    } else{
      score<-2
    }
  } 
  else if (any(afl$team == "def" & afl$dist_to_ball_player < 2)){
    if (any(afl$team == "def" & afl$dist_to_ball_player < 2 & afl$position_to_ball == "behind")){
      score <- max(score, 1.25)
    }
    if (any(afl$team == "def" & afl$dist_to_ball_player < 2 & afl$position_to_ball == "ahead")){
      score <- max(score, 1.5)
    }
  } else if (any(afl$team == "def" & afl$dist_to_ball_player < 5)){
    score <- 0.5
  } else if (any(afl$team == "opp")){
    score<- 0
  }
  return(score)
}

# Code
afl<- afl |> 
  group_by(id_play) |> 
  mutate(
    pressureR = ifelse(on_ball == 1, calculate_pressure_score(cur_data()), NA_real_)
  ) |> 
  ungroup()
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `pressureR = ifelse(on_ball == 1,
##   calculate_pressure_score(cur_data()), NA_real_)`.
## ℹ In group 1: `id_play = 400`.
## Caused by warning:
## ! `cur_data()` was deprecated in dplyr 1.1.0.
## ℹ Please use `pick()` instead.
# Change all SET plays to 0 pressure scores
afl<- afl |> 
  mutate(
    pressureR = case_when(
      on_ball == 0 ~ NA_real_,
      play_phase == "SET" ~ 0,
      T ~ pressureR
    )
)

# Phase Rating ----
# Calculate Phase of play Rating
afl<- afl |> 
  mutate(
    phaseR = case_when(
      set == 0 & longR >= 0.8 ~ 0,
      set == 0 & longR %in% c(0.1, 0.2)~ 0.5,
      set == 0 & longR %in% c(0.3, 0.4, 0.5, 0.6,0.7)~ 1,
      set == 1 & longR < 0.5 & pressureR > 1 ~ 0,
      set == 1 & longR %in% c(0.5, 0.6, 0.7, 0.8) & pressureR > 1 ~ 1,
      set == 1 & longR %in% c(0.3, 0.4, 0.5, 0.6) & pressureR < 1 ~ 1.5,
      set == 1 & longR %in% c(0.1, 0.2) & pressureR < 1 ~ 1,
      set == 1 & longR >= 0.9 & pressureR > 1 ~ 1.5,
      set == 1 & longR >= 0.7 & pressureR < 1 ~ 2,
      T ~ NA_real_
    )
  )

# Distance to Opponent ----
# Caclulating distance of each attacker to their closest opponent
calc_closest_opp <- function(afl_play) {
  att <- afl_play |>  filter(team == "att")
  def <- afl_play |>  filter(team == "def")
  afl_play <- afl_play |>  mutate(dist_opp = NA_real_)
  if (nrow(att) > 0 & nrow(def) > 0) {
    afl_play <- afl_play |> 
      rowwise() |> 
      mutate(
        dist_opp = if (team == "att") {
          att_x <- x
          att_y <- y
          if (is.na(att_x) | is.na(att_y)) {
            return(NA_real_)
          }
          distances <- sqrt((att_x - def$x)^2 + (att_y - def$y)^2)
          if (length(distances) == 0 || all(is.na(distances))) {
            return(NA_real_)
          }
          min(distances, na.rm = TRUE)
        } else {
          NA_real_
        }
      ) |> 
      ungroup()
  }
  
  return(afl_play)
}

# Code for distance to closest opponent
afl <- afl %>%
  group_by(id_play) %>%
  group_modify(~ calc_closest_opp(.x)) %>%
  ungroup()

# TMOA ----
# Calculating how many teammates a player has open inside forward 50 of the ground
players_ahead_count<- function(afl_play){
  ahead_players<- afl_play |> 
    filter(team == "att",
           position_to_ball == "ahead",
           dist_opp >= 10,
           x >= 30,
           x<= 80)
  afl_play <- afl_play |> mutate(players_ahead = NA_real_)
  if(any(afl_play$on_ball == 1)){
    ball_player <- afl_play |> filter(on_ball == 1)
    if (nrow(ball_player)> 0){
      afl_play<- afl_play |> 
        rowwise() |> 
        mutate(TMOA = if (on_ball == 1){
          sum(ahead_players$x > x, na.rm = T)
        }else{
          NA_real_
        }) |> 
        ungroup()
    }
  }
  return(afl_play)
}

afl<- afl |> 
  group_by(id_play) |> 
  group_modify(~ players_ahead_count(.x)) |> 
  ungroup()

# Velocity Rating ----
# Calculate if ball player is faster than their closest opponent
play_function <- function(afl_play) {
  ball_players <- afl_play |> 
    filter(on_ball == 1)
  result <- ball_players |> 
    rowwise() |> 
    mutate(
      closest_def_velocity = {
        opponents <- afl_play |> 
          filter(team == "def" & !player_id %in% ball_players$player_id)
        if (nrow(opponents) > 0) {
          closest_def <- opponents |> 
            filter(dist_to_ball_player == min(dist_to_ball_player)) |> 
            slice(1)
          closest_def$v  
        } else {
          NA
        }
      },
      velocityR = ifelse(v > closest_def_velocity, 1, -1)
    )
  return(result)
}

## Ground Control ----
# Calculate for only space ahead of the ball
players_ahead_only<- afl |> 
  group_by(id_play) |> 
  filter(on_ball == 1) |> 
  select(id_play, ball_x = x) |> 
  inner_join(afl, by = "id_play") |> 
  filter(x >= ball_x) |> 
  select(-ball_x)

# Add column for ball x and y
players_ahead_only<- players_ahead_only |> 
  group_by(id_play) |> 
  mutate(ball_x = ifelse(on_ball == 1, x, NA),
         ball_y = ifelse(on_ball == 1, y, NA)) |> 
  fill(ball_x, ball_y, .direction = "updown") |> 
  ungroup()


# Space Metrics - Create area of play around ball
space_metrics<- players_ahead_only |> 
  group_by(id_play, team) |> 
  summarise(
    id_play = id_play[1],
    ball_x = ball_x[1],
    ball_x = ball_x[1],
    n_player = n(),
    mean_x = mean(x),
    mean_y = mean(y),
    length = max(x) - min(x),
    width = max(y)- min(y)
  )
## `summarise()` has grouped output by 'id_play'. You can override using the
## `.groups` argument.
# Check
space_metrics |> 
  filter(team == "att" & id_play == 400)
## # A tibble: 1 × 8
## # Groups:   id_play [1]
##   id_play team  ball_x n_player mean_x mean_y length width
##     <int> <chr>  <dbl>    <int>  <dbl>  <dbl>  <dbl> <dbl>
## 1     400 att     22.3       10   42.0   6.06   46.1  45.3
# Test on one play before creating fucntion
library(splancs)
## Loading required package: sp
## 
## Spatial Point Pattern Analysis Code in S-Plus
##  
##  Version 2 - Spatial and Space-Time analysis
## 
## 
## Attaching package: 'splancs'
## 
## The following object is masked from 'package:dplyr':
## 
##     tribble
## 
## The following object is masked from 'package:tidyr':
## 
##     tribble
## 
## The following object is masked from 'package:tibble':
## 
##     tribble
play_400<- players_ahead_only |> 
  filter(team == "att" & id_play == 400)

hull_rows<- chull(play_400$x, play_400$y)
hull_pts<- play_400[hull_rows, c('x', 'y')]
hull_pts
## # A tibble: 6 × 2
##       x      y
##   <dbl>  <dbl>
## 1  63.7  -3.17
## 2  24.0 -18.7 
## 3  22.3   9.23
## 4  29.0  26.6 
## 5  58.5  16.0 
## 6  68.3   9.72
areapl(as.matrix(hull_pts))
## [1] 1303.804
# Make function for entire dataset
hull_area<- function(x,y){
  hull_rows<- chull(x,y)
  hull_pts<- cbind(x[hull_rows], y[hull_rows])
  surf_area <- areapl(hull_pts)
  return(surf_area)
}

# Check
hull_area(play_400$x, play_400$y)
## [1] 1303.804
# Get hull area of each frame
team_areas<- players_ahead_only |> 
  group_by(id_play, team) |> 
  summarise(
    area = hull_area(x,y)
  )
## `summarise()` has grouped output by 'id_play'. You can override using the
## `.groups` argument.
# Bind with original Data
afl <- afl |> 
  left_join(team_areas, by = c("id_play", "team"))

# Give 1 or 0 to ball player if their team is controlling the space in front of them
# Calculate each play if the attacking team is controlling ahead space
space_control<- afl |> 
  group_by(id_play) |> 
  summarise(
    att_area = area[team == "att"],
    def_area = area[team == "def"],
    ball_player = player_id[on_ball == 1]) |> 
  mutate(control = ifelse(att_area>def_area, 1, 0)) |> 
  ungroup()
## Warning: Returning more (or less) than 1 row per `summarise()` group was deprecated in
## dplyr 1.1.0.
## ℹ Please use `reframe()` instead.
## ℹ When switching from `summarise()` to `reframe()`, remember that `reframe()`
##   always returns an ungrouped data frame and adjust accordingly.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `summarise()` has grouped output by 'id_play'. You can override using the
## `.groups` argument.
# Merge with orignal data
space_control<- space_control |> 
  group_by(id_play) |> 
  slice(1) |> 
  ungroup()

afl<- afl |> 
  left_join(space_control, by = "id_play")

# Create final table
afl_final <- afl %>%
  group_by(id_play) %>%
  do(play_function(.)) %>%
  ungroup()

# Data clean
# Max of 2 TOA
afl_final<- afl_final |> 
  mutate(TMOA = case_when(
    TMOA > 2 ~ 2,
    T ~ TMOA
  ))

# Control only applicable if ball is outside 50
afl_final<- afl_final |> 
  mutate(control = ifelse(longR > 0.4, 0, control))

# Dangerousity Calculation ----
# Caclulating Dangerousity score for each play based on formula created
afl_dangerousity<- afl_final |> 
  mutate(
    dangerousity = (((longR+latR) * 10) + (set * velocityR) + (phaseR * TMOA) + control - pressureR)/23
  )

# Round dangerousity values
afl_dangerousity<- afl_dangerousity |> 
  mutate(dangerousity = round(dangerousity, 2))

# Plotting For Report ----
## Position Dangerousity ----
afl_position_ratings<- afl |> 
  select(x,y,longR,latR) |> 
  filter(latR>0) |> 
  mutate(posR = ((longR + latR) *10)/20)


ground <- c(160, 129)
angle <- seq(-pi, pi, length = 50)
oval <- data.frame(y = ground[2]/2 * cos(angle), x = ground[1]/2 * sin(angle))


ggplot(subset(afl_position_ratings), aes(x=x,y=y)) +
  # players
  geom_point(aes(size = posR, color = posR)) +
  scale_color_gradient(low = "red", high = "green", name = "Dangerousity")+
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  labs(title = 'Dangerousity Score', subtitle = "Ball Position ONLY")+
  guides(size = "none")+
  coord_equal()

# Velocity Effect
# Play 19391

plot_play<- 19391

a<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #19391", subtitle = "VelocityR = 1     Dangerousity Score = 0.52")

# Play 5828
plot_play<- 5828

b<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #5828", subtitle = "VelocityR = -1     Dangerousity Score = 0.41")

library(patchwork)
a

b

# Effect of TOA
# Plat 27853
plot_play<- 27853

c<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #27853 - GENERAL PLAY", subtitle = "PhaseR = 1   TOA = 2     Dangerousity Score = 0.59")

# Play 12026
plot_play<- 12026

d<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #12026 - SET", subtitle = "PhaseR = 1.5    TOA = 1     Dangerousity Score = 0.48")

c

d

# Effect of PressureR
# Comparing Similar plays with different levels of pressure
# Play 12026
plot_play<- 36919

e<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #36919", subtitle = "PressureR = 1.5      Dangerousity Score = 0.33")

# Play 28710
plot_play<- 28710

f<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #28710", subtitle = "PressureR = 0     Dangerousity Score = 0.43")

e

f

# Plotting importance of Control
# Dangerousity before control factor
control_effect<- afl_dangerousity |> 
  filter(id_play == 41396|id_play == 12001)

control_effect<- control_effect |> 
  mutate(
    dangerousity_no_control = (((longR+latR) * 10) + (set * velocityR) + (phaseR * TMOA) - pressureR)/23
  )
# Both 0.26

# Creat Convex hull polygons to show space control
play_12001<- players_ahead_only |> 
  filter(id_play == 12001)
hull_indices_12001<- chull(play_12001$x, play_12001$y)
hull_12001<- play_12001[hull_indices_12001, ]

play_41396<- players_ahead_only |> 
  filter(id_play == 41396)
hull_indices_41396<- chull(play_41396$x, play_41396$y)
hull_41396<- play_41396[hull_indices_41396, ]

# Plot actual dangerousity after control effect
# Play 41396
plot_play<- 41396

g<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  geom_polygon(data = hull_41396, aes(x = x, y = y), fill = "red", alpha = 0.2)+
  theme_bw() +
  coord_equal() +
  labs(title = "Play #41396", subtitle = "Attackers Controlling Area Ahead - Dangerousity Score = 0.30")

# Play 12001
plot_play<- 12001

h<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  geom_polygon(data = hull_12001, aes(x = x, y = y), fill = "blue", alpha = 0.2)+
  theme_bw() +
  coord_equal() +
  labs(title = "Play #12001", subtitle = "Opposition Controlling Area Ahead - Dangerousity Score = 0.26")

g

h

# Testing Model ----
## Guaranteed Goals - Dangerousity = 1 ----
plot_play<- 12176

i<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #12176", subtitle = "Dangerousity Score = 1.00")

i

## Very Dangerous
plot_play<- 31090

j<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #31090", subtitle = "Dangerousity Score = 0.91")

plot_play<- 2050

k<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #2050", subtitle = "Dangerousity Score = 0.87")

plot_play<- 9087

l<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #9087", subtitle = "Dangerousity Score = 0.89")

plot_play<- 8929

m<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #8929", subtitle = "Dangerousity Score = 0.87")

plot_play<- 23336

n<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #23336", subtitle = "Dangerousity Score = 0.83")

j

k

l

m

n

## Highly Dangerous  ----
plot_play<- 6253

o<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #6253", subtitle = "Dangerousity Score = 0.78")


plot_play<- 9128

p<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #9128", subtitle = "Dangerousity Score = 0.76")

plot_play<- 12995

q<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #12995", subtitle = "Dangerousity Score = 0.74")

plot_play<- 2240

r<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #2240", subtitle = "Dangerousity Score = 0.72")

plot_play<- 1725

s<-ggplot(subset(afl, id_play == plot_play), aes(x=x,y=y)) +
  # players
  geom_point(aes(col = team)) +
  geom_point(data = subset(afl, id_play == plot_play & on_ball == 1), aes(col = 'ball'), size = 2) +
  # ground
  geom_polygon(data = oval, aes(x = x, y = y), alpha = 0.1, fill = '#4DBD33') +
  # goal and centre squares
  geom_rect(aes(xmin = -25, xmax = 25, ymin = -25, ymax = 25), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = 71, xmax = 80, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  geom_rect(aes(xmin = -80, xmax = -71, ymin = -3.2, ymax = 3.2), fill = "transparent", color = 'black') +
  # looks
  theme_bw() +
  coord_equal() +
  labs(title = "Play #1725", subtitle = "Dangerousity Score = 0.70")


o

p

q

r

s

# All plays - Dangerousity score ----
danger<- afl_dangerousity |> 
  select(id_play,dangerousity)

danger
## # A tibble: 102 × 2
##    id_play dangerousity
##      <int>        <dbl>
##  1     400         0.63
##  2     525         0.33
##  3     572         0.28
##  4     889         0.57
##  5    1263         0.65
##  6    1275         0.39
##  7    1725         0.7 
##  8    2006         0.7 
##  9    2050         0.87
## 10    2124         0.26
## # ℹ 92 more rows