atomic SPADL functions to use with {Rteta}, use vaep_get_scores_atomic instead of Rteta::vaep_get_scores

Rteta-atomic.R

#' Calculate the VAEP score for all actions in an atomic spadl df
#' @param spadl A df of spadl events
#' @param scores The name of a col of values calculated for the chance of scoring in next n actions
#' @param concedes The name of a col of values calculated for the chance of conceeding in next n actions
#' @param score_type Whether to score for the attacking contribution or defensive contribution
#' @export vaep_score_actions_atomic
#' @seealso vaep_score_actions
vaep_score_actions_atomic <- function(spadl, scores, concedes, score_type) {
  #inverse formulas for attack and defense score
  if(score_type == "attack") {
    pos_contrib <- unlist(spadl[scores])
    neg_contrib <- unlist(spadl[concedes])
    multiplyer <- 1
  } else if(score_type %in% c("defense", "defence")) {
    pos_contrib <- unlist(spadl[concedes])
    neg_contrib <- unlist(spadl[scores])
    multiplyer <- -1
  } else {
    errorCondition("score_type should be either 'attack' or 'defence'")
  }
  
  #make sure only taking previous action from same game/period/team etc.
  same_game <- spadl$game_id == lag(spadl$game_id)
  same_period <- spadl$period_id == lag(spadl$period_id)
  same_team <- spadl$team_id == lag(spadl$team_id)
  
  #find the value of the previous action
  prev_val <- lag(pos_contrib, default = 0) * (same_game & same_period & same_team) + lag(neg_contrib, default = 0) * (same_game & same_period & !same_team)
  
  #remove where too long between actions (e.g. injury stoppage)
  max_duration = 10
  toolong <- spadl$time_seconds - lag(spadl$time_seconds, default = 0) > max_duration
  prev_val[toolong] <- 0
  
  #remove when last action was a goal so play restarts
  prev_goal <- lag(
    spadl$type_name %in% c("goal", "owngoal"),
    default = FALSE
  )
  prev_val[prev_goal] <- 0
  
  #some hardcoded vals for corners and penalty value
  if(score_type == "attack") {
    pens <- spadl$type_name == "shot_penalty"
    prev_val[pens] <- Rteta::pen_score_frac
    
    corner <- spadl$type_name == "corner"
    prev_val[corner] <- Rteta::corner_score_frac
  }
  
  #calculate attack/defense score
  value_add <- multiplyer * (pos_contrib - prev_val)
  return(value_add)
}

#' Calculate the VAEP score for all actions in an atmoic spadl df
#' @param spadl A df of spadl events
#' @param scores The name of a col of values calculated for the chance of scoring in next n actions
#' @param concedes The name of a col of values calculated for the chance of conceeding in next n actions
#' @export vaep_get_scores_atomic
#' @seealso vaep_get_scores
vaep_get_scores_atomic <- function(spadl, scores, concedes) {
  spadl$attack_score <- offensive_value <- vaep_score_actions_atomic(spadl, scores, concedes, "attack")
  spadl$defence_score <- defensive_value <- vaep_score_actions_atomic(spadl, scores, concedes, "defence")
  
  #calculate the total VAEP of an action
  spadl$vaep_value <- spadl$attack_score + spadl$defence_score
  
  return(spadl)
}