R/xTable.R

Defines functions concatenate_strength_attack_defense calculate_defense_strength_for_each_team calculate_attack_strength_for_each_team .last_xGol .half_mean get_strength_streak_defense get_strength_streak_attack extract_goal_attack_from_league extract_goal_defense_from_league extract_xgoal_defense_from_league extract_date_from_league extract_xpoint_from_league extract_point_from_league extract_xgoal_attack_from_league get_strength_defense get_strength_atack previous_season add_xpoints_and_points away_Points_all_matches home_Points_all_matches away_xPoints_all_matches home_xPoints_all_matches summarize_xpoints_played_match summarize_points_played_match point_team_place xpoint_team_place goal_team_place xgoal_team_place cli_calculate_xgoals cli_calculate_xpoints calculate_xpoints calculate_xgoal_kp calculate_xgoal check_league_season xgoal_from_league_season calculate_diff_goals add_away_shots_outsidebox add_home_shots_outsidebox calculate_points

library(tidyverse)
library(optparse)

calculate_points <- function(home_xGol, away_xGol) {
  diff_goals <- home_xGol - away_xGol
  points <- sum(diff_goals > 0) * 3 + sum(diff_goals == 0)
  return(points)
}

add_home_shots_outsidebox <- function(datos) {
  salida <- datos %>% mutate("home_shots_outsidebox" = home_total_shots - home_shots_insidebox)
  return(salida)
}

add_away_shots_outsidebox <- function(datos) {
  salida <- datos %>% mutate("away_shots_outsidebox" = away_total_shots - away_shots_insidebox)
  return(salida)
}

calculate_diff_goals <- function(home_xGol, away_xGol) {
  n_sample <- 2000
  diff_goals <- rpois(n_sample, home_xGol) - rpois(n_sample, away_xGol)
  return(diff_goals)
}

xGoal_all_league <- list(
  "262_2021" = list(inside = 0.096171, outside = 0.045958, penalty = 0.785234),
  "262_2022" = list(inside = 0.096171, outside = 0.045958, penalty = 0.785234),
  "253_2021" = list(inside = 0.089624, outside = 0.069169, penalty = 0.8),
  "140_2020" = list(inside = 0.117440, outside = 0.043654, penalty = 0.744681),
  "140_2021" = list(inside = 0.117440, outside = 0.043654, penalty = 0.744681),
  "140_2021_kp" = list(inside_kp = 0.25451, inside_nkp = 0, outside_kp = -0.0595, outside_nkp = 0.17376, penalty = 0.75),
  "140_2022" = list(inside = 0.094918, outside = 0.054087, penalty = 0.750000),
  "140_2023" = list(inside = 0.094918, outside = 0.054087, penalty = 0.750000),
  "78_2020" = list(inside = 0.110081, outside = 0.037332, penalty = 0.774774),
  "78_2021" = list(inside = 0.110081, outside = 0.037332, penalty = 0.774774),
  "78_2022" = list(inside = 0.097148, outside = 0.066833, penalty = 0.833333),
  "78_2023" = list(inside = 0.097148, outside = 0.066833, penalty = 0.833333),
  "39_2021" = list(inside = 0.107191, outside = 0.052831, penalty = 0.809524),
  "39_2021_kp" = list(inside_kp = 0.2520, outside_nkp = 0.20548, penalty = 0.809524),
  "39_2022" = list(inside = 0.105447, outside = 0.039568, penalty = 0.815534),
  "39_2023" = list(inside = 0.105447, outside = 0.039568, penalty = 0.815534),
  "61_2020" = list(inside = 0.108780, outside = 0.065102),
  "61_2021" = list(inside = 0.107191, outside = 0.052831, penalty = 0.878049),
  "61_2022" = list(inside = 0.106431, outside = 0.045077, penalty = 0.878049),
  "61_2023" = list(inside = 0.106431, outside = 0.045077, penalty = 0.878049),
  "88_2021" = list(inside = 0.097606, outside = 0.059503, penalty = 0.785714),
  "88_2021_kp" = list(inside_kp = 0.28746, inside_nkp = -0.09923, outside_kp = 0, outside_nkp = 0.16179, penalty = 0.846666),
  "88_2020" = list(inside = 0.097606, outside = 0.059503, penalty = 0.815126),
  "88_2022" = list(inside = 0.087388, outside = 0.065923, penalty = 0.815384),
  "88_2023" = list(inside = 0.087388, outside = 0.065923, penalty = 0.815384),
  "94_2021" = list(inside = 0.102894, outside = 0.056361, penalty = 0.718182),
  "94_2022" = list(inside = 0.087118, outside = 0.058670, penalty = 0.794393),
  "94_2023" = list(inside = 0.087118, outside = 0.058670, penalty = 0.794393),
  "135_2021" = list(inside = 0.104484, outside = 0.054466, penalty = 0.846666),
  "135_2021_kp" = list(inside_kp = 0.17922, inside_nkp = 0.18334, outside_kp = 0.04407, outside_nkp = 0, penalty = 0.846666),
  "135_2022" = list(inside = 0.091804, outside = 0.057613, penalty = 0.777778),
  "135_2023" = list(inside = 0.091804, outside = 0.057613, penalty = 0.777778)
)

xgoal_from_league_season <- function(league_season) {
  xGoal <- xGoal_all_league[[league_season]]
  check_league_season(league_season)
  return(xGoal)
}

check_league_season <- function(league_season) {
  leagues <- names(xGoal_all_league)
  rlang::arg_match0(league_season, leagues)
}

calculate_xgoal <- function(xGol, shots_outsidebox, shots_insidebox, total_penalties) {
  xgoal <- shots_outsidebox * xGol$outside + shots_insidebox * xGol$inside + total_penalties * xGol$penalty
  return(xgoal)
}

calculate_xgoal_kp <- function(xGol, shots_insidebox_kpnb, shots_outsidebox_nkpnb, shots_insidebox_nkpnb, shots_outsidebox_kpnb, total_penalties) {
  xgoal <- shots_outsidebox_nkpnb * xGol$outside_nkp + shots_insidebox_kpnb * xGol$inside_kp +
    shots_outsidebox_kpnb * xGol$outside_kp + shots_insidebox_nkpnb * xGol$inside_nkp +
    total_penalties * xGol$penalty
  return(xgoal)
}

calculate_xpoints <- function(home_xGol, away_xGol) {
  diff_goals <- calculate_diff_goals(home_xGol, away_xGol)
  xpoints <- sum(diff_goals > 0) * 3 / 2000 + sum(diff_goals == 0) / 2000
  return(xpoints)
}


cli_calculate_xpoints <- function() {
  listaOpciones <- list(
    make_option(
      c("-l", "--league-season"),
      default = "262_2021",
      help = "League and season like 78_2020: \n
        Bundesliga id is 78 \n
        Premier id is 39 \n",
      metavar = "character",
      type = "character"
    ),
    make_option(
      c("-d", "--directory"),
      default = "results",
      help = "Directory where are the files `statistics_{league}_{season}.csv`",
      metavar = "character",
      type = "character"
    )
  )
  opt_parser <- OptionParser(option_list = listaOpciones)
  opciones <- parse_args(opt_parser)
  return(opciones)
}

cli_calculate_xgoals <- function() {
  listaOpciones <- list(
    make_option(
      c("-i", "--input-file"),
      default = "results/statistics_88_2021.csv",
      help = "Datos de la estadística de la liga",
      metavar = "character",
      type = "character"
    )
  )
  opt_parser <- OptionParser(option_list = listaOpciones)
  opciones <- parse_args(opt_parser)
  return(opciones)
}
#' @export
xgoal_team_place <- function(league) {
  league %>%
    dplyr::select(home_xGol, away_xGol, home_id, away_id, match_id) %>%
    unite(col = "home", c(home_xGol, home_id), sep = "--") %>%
    unite(col = "away", c(away_xGol, away_id), sep = "--") %>%
    gather(key = "local", value = "xGol-d", -match_id) %>%
    separate(col = "xGol-d", into = c("xGol", "team_id"), sep = "--") %>%
    mutate(xGol = as.numeric(xGol))
}

goal_team_place <- function(league) {
  league %>%
    dplyr::select(home, away, home_id, away_id, match_id) %>%
    unite(col = "home", c(home, home_id), sep = "--") %>%
    unite(col = "away", c(away, away_id), sep = "--") %>%
    gather(key = "local", value = "Gol-d", -match_id) %>%
    separate(col = "Gol-d", into = c("Gol", "team_id"), sep = "--") %>%
    mutate(Gol = as.numeric(Gol))
}

xpoint_team_place <- function(league) {
  league %>%
    select(home_xPoints, away_xPoints, home_id, away_id) %>%
    unite(col = "home", c(home_xPoints, home_id), sep = "--") %>%
    unite(col = "away", c(away_xPoints, away_id), sep = "--") %>%
    gather(key = "local", value = "xPoint-d") %>%
    separate(col = "xPoint-d", into = c("xPoints", "team_id"), sep = "--") %>%
    mutate(xPoints = as.numeric(xPoints))
}

point_team_place <- function(league) {
  league %>%
    select(home_Points, away_Points, home_id, away_id) %>%
    unite(col = "home", c(home_Points, home_id), sep = "--") %>%
    unite(col = "away", c(away_Points, away_id), sep = "--") %>%
    gather(key = "local", value = "Point-d") %>%
    separate(col = "Point-d", into = c("Points", "team_id"), sep = "--") %>%
    mutate(Points = as.numeric(Points))
}

summarize_points_played_match <- function(league) {
  league %>%
    group_by(team_id) %>%
    summarize(
      puntos = sum(Points),
      jj = n()
    )
}

summarize_xpoints_played_match <- function(league) {
  league %>%
    group_by(team_id) %>%
    summarize(
      xpuntos = sum(xPoints),
      jj = n()
    )
}

home_xPoints_all_matches <- function(league) {
  number_of_matches <- nrow(league)
  home_xPoints <- to_vec(
    for (match in 1:number_of_matches) {
      calculate_xpoints(league[match, ]$home_xGol, league[match, ]$away_xGol)
    }
  )
}

away_xPoints_all_matches <- function(league) {
  number_of_matches <- nrow(league)
  away_xPoints <- to_vec(
    for (match in 1:number_of_matches) {
      calculate_xpoints(league[match, ]$away_xGol, league[match, ]$home_xGol)
    }
  )
}

home_Points_all_matches <- function(league) {
  number_of_matches <- nrow(league)
  home_Points <- to_vec(
    for (match in 1:number_of_matches) {
      calculate_points(league[match, ]$home, league[match, ]$away)
    }
  )
}

away_Points_all_matches <- function(league) {
  number_of_matches <- nrow(league)
  away_Points <- to_vec(
    for (match in 1:number_of_matches) {
      calculate_points(league[match, ]$away, league[match, ]$home)
    }
  )
}

add_xpoints_and_points <- function(league) {
  number_of_matches <- nrow(league)
  home_xPoints <- home_xPoints_all_matches(league)
  away_xPoints <- away_xPoints_all_matches(league)
  home_Points <- home_Points_all_matches(league)
  away_Points <- away_Points_all_matches(league)
  league <- cbind(league, tibble(home_xPoints, away_xPoints, home_Points, away_Points))
}

previous_season <- function(id_season) {
  id <- str_split(id_season, "_")[[1]][1]
  previous_season <- as.character(as.numeric(str_split(id_season, "_")[[1]][2]) - 1)
  id_previous_season <- paste(id, previous_season, sep = "_")
  return(id_previous_season)
}

get_strength_atack <- function(league, id) {
  attack <- extract_xgoal_attack_from_league(league, id)
  return(mean(attack))
}

get_strength_defense <- function(league, id) {
  attack <- extract_xgoal_defense_from_league(league, id)
  return(mean(attack))
}

extract_xgoal_attack_from_league <- function(league, id) {
  attack <- c(league %>% filter(home_id == id) %>% .$home_xGol, league %>% filter(away_id == id) %>% .$away_xGol)
}

extract_point_from_league <- function(league, id) {
  attack <- c(league %>% filter(home_id == id) %>% .$home_Points, league %>% filter(away_id == id) %>% .$away_Points)
}

extract_xpoint_from_league <- function(league, id) {
  attack <- c(league %>% filter(home_id == id) %>% .$home_xPoints, league %>% filter(away_id == id) %>% .$away_xPoints)
}

extract_date_from_league <- function(league, id) {
  attack <- c(league %>% filter(home_id == id) %>% .$date, league %>% filter(away_id == id) %>% .$date)
}

extract_xgoal_defense_from_league <- function(league, id) {
  attack <- c(league %>% filter(home_id == id) %>% .$away_xGol, league %>% filter(away_id == id) %>% .$home_xGol)
}

extract_goal_defense_from_league <- function(league, id) {
  received_goal <- c(league %>% filter(home_id == id) %>% .$away, league %>% filter(away_id == id) %>% .$home)
}

extract_goal_attack_from_league <- function(league, id) {
  noted_goal <- c(league %>% filter(home_id == id) %>% .$home, league %>% filter(away_id == id) %>% .$away)
}

get_strength_streak_attack <- function(league, id) {
  home_xGol <- league %>%
    filter(home_id == id) %>%
    .$home_xGol
  away_xGol <- league %>%
    filter(away_id == id) %>%
    .$away_xGol
  expected_attack <- c(home_xGol, away_xGol)
  expected_streak_attack <- .last_xGol(home_xGol, away_xGol)
  .half_mean(expected_attack, expected_streak_attack)
}

get_strength_streak_defense <- function(league, id) {
  away_xGol <- league %>%
    filter(home_id == id) %>%
    .$away_xGol
  home_xGol <- league %>%
    filter(away_id == id) %>%
    .$home_xGol
  expected_defense <- c(home_xGol, away_xGol)
  expected_streak_defense <- .last_xGol(home_xGol, away_xGol)
  .half_mean(expected_defense, expected_streak_defense)
}

.half_mean <- function(expected_defense, streak_defense) {
  half_mean <- mean(expected_defense) / 2 + mean(streak_defense) / 2
  return(half_mean)
}

.last_xGol <- function(home_xGol, away_xGol) {
  c(home_xGol %>% tail(3), away_xGol %>% tail(3))
}

GET_STRENGTH_DEFENSE <- list(
  "streak" = get_strength_streak_defense,
  "mean" = get_strength_defense
)

GET_STRENGTH_ATTACK <- list(
  "streak" = get_strength_streak_attack,
  "mean" = get_strength_atack
)

calculate_attack_strength_for_each_team <- function(ids, league, mode = "mean") {
  comprehenr::to_vec(for (id in ids) GET_STRENGTH_ATTACK[[mode]](league, id))
}

calculate_defense_strength_for_each_team <- function(ids, league, mode = "mean") {
  comprehenr::to_vec(for (id in ids) GET_STRENGTH_DEFENSE[[mode]](league, id))
}

concatenate_strength_attack_defense <- function(names, league, mode = "mean") {
  ids <- names[["ids"]]
  attack <- calculate_attack_strength_for_each_team(ids, league, mode)
  defense <- calculate_defense_strength_for_each_team(ids, league, mode)
  strength <- tibble(ids = ids, attack = attack, deffense = defense)
}
nepito/calculator-trs documentation built on Feb. 20, 2024, 10:56 a.m.