Uma introdução à modelagem de partidas de futebol em R (parte 2)

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br


[Esteartigofoipublicadopelaprimeiravezem[Thisarticlewasfirstpublishedon rstats em Robert Hickman, e gentilmente contribuiu para os R-blogueiros]. (Você pode relatar um problema sobre o conteúdo desta página aqui)


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.

Escrevi este muito rapidamente em comparação com a parte 1 (que se aprofunda muito mais nos conceitos matemáticos), e só percebi depois de quanta semelhança ele tem com muitos dos Ben Torvaney’s posts sobre o assunto. Provavelmente não é uma coincidência, considerando o quanto eu usei o trabalho dele anteriormente em postagens neste blog. Qualquer imitação aqui deve ser lisonjeada. O objetivo deste post é realmente uma ponte entre o que eu realmente quero escrever sobre – a matemática por trás dos modelos na parte 1 e extensões desses modelos em outras distribuições nas partes 3-n, para que possa ser um pouco derivado de coisas escrito em outro lugar.

Neste blog, gosto de explicar vários conceitos do lado mais acadêmico da análise de futebol. Um dos meus resultados favoritos desse campo são os trabalhos de previsão de partidas futuras de futebol com base em informações limitadas sobre partidas passadas. Há cerca de um ano, publiquei a parte 1 de uma série disso e nunca cheguei a escrever a parte 2 (espero que 2 ou 3 mais).

No primeiro post, vimos como podemos usar a distribuição de Poisson para estimar as forças relativas das equipes em uma liga hipotética de verão entre o Arsenal, o Blackburn Rovers, a Coventry City, a Dover Athletic, a Dover Athletic, a Enfield Town e a Frimley Green. Agora queremos passar para a verdade usando essas estimativas para prever correspondências e, eventualmente, ligas inteiras.

Uma boa maneira de resumir este post em uma linha é uma citação (mis) atribuída a Niels Bohr:

“É difícil fazer previsões, especialmente sobre o futuro”

Fizemos nossas previsões sobre o passado (estimando os pontos fortes relativos das equipes com base nos resultados passados), agora precisamos prever o futuro. Eu acho que também capta muito bem que mesmo nossas previsões sobre o passado são barulhentas – nunca podemos realmente conhecer as forças exatas dos times de futebol; o trabalho da análise é estimar com precisão o máximo possível. Mas qualquer ruído nessas previsões passadas será levado adiante e amplificado ao prever o futuro.

Em frente ao código, primeiro como sempre, carregando bibliotecas e configurando uma semente para reprodutibilidade:

library(tidyverse)
library(ggrepel)

set.seed(3459)

Em seguida, carregaremos todas as coisas que preparamos e previmos na última postagem. Lembre-se de que o parâmetro α abaixo refere-se a uma força de ataque de equipes (o número relativo de gols que eles devem marcar), e o parâmetro β se refere à força de ataque (o inverso do número relativo de gols que eles devem conceder). Finalmente, γ refere-se à vantagem extra de jogar em casa.

(todos esses arquivos estão no repositório do github para este site)

fixtures <- readRDS("../../static/files/dc_2/dc_fixtures.rds")
results <- readRDS("../../static/files/dc_2/dc_results.rds")

model <- readRDS("../../static/files/dc_2/dc_model.rds")

model
## $alpha
##          Arsenal Blackburn_Rovers    Coventry_City   Dover_Athletic 
##        1.1106558        0.6370160        0.3023048       -0.2875353 
##     Enfield_Town    Frimley_Green 
##       -0.3767038       -1.3857376 
## 
## $beta
##          Arsenal Blackburn_Rovers    Coventry_City   Dover_Athletic 
##        0.6457175        0.4289270        0.3647815       -0.1362931 
##     Enfield_Town    Frimley_Green 
##       -0.3852812       -0.9178517 
## 
## $gamma
##    gamma 
## 0.189462

Definiremos uma função rápida para fazer nossa previsão. Para uma explicação rápida de exatamente por que ele foi codificado como apresentado, consulte a postagem anterior, sob o título 'Tinkering'.

Para uma determinada sequência de uma equipe da casa e uma equipe ausente, a função encontra os parâmetros relevantes de um terceiro argumento (param_list) e calcula a meta esperada para cada equipe.

predict_results <- function(home, away, param_list) {
  e_goals_home <- exp(param_list$alpha[home] - param_list$beta[away] + param_list$gamma)
  e_goals_away <- exp(param_list$alpha[away] - param_list$beta[home])
  
  df <- data.frame(home = home, away = away,
                   e_hgoal = as.numeric(e_goals_home), 
                   e_agoal = as.numeric(e_goals_away))
  
  return(df)
}

Se executarmos isso para dois exemplos de equipes, por exemplo:

#two example teams
home <- "Blackburn_Rovers"
away <- "Arsenal"

prediction <- predict_results(home, away, model) 
prediction
##               home    away  e_hgoal  e_agoal
## 1 Blackburn_Rovers Arsenal 1.198128 1.977293

Podemos ver que isso dá ao Arsenal (a equipe visitante) uma chance um pouco mais otimista do que o Blackburn. Os objetivos esperados para cada equipe, é claro, podem ser reescritos como a média e, no nosso modelo de Poisson, se refere a λ (lambda) - a média de vezes que um evento (objetivo) acontece por um intervalo de tempo (partida). Também definimos um número máximo de metas possíveis (7 neste caso *) para limitar a área sob a distribuição, para que não amostremos para sempre.

* leitores afiados podem perceber que isso é realmente mais baixo do que o lambda para nossos casos mais extremos (por exemplo, o Arsenal em casa, com Frimley Green), mas para jogos realistas (mesmo entre times profissionais muito diferentes), essa é uma suposição justa o suficiente.

Em seguida, usamos dpois () para calcular a probabilidade dessa função de Poisson retornar um valor (metas de 0: 7), devido ao seu valor lambda. Portanto, se analisarmos a previsão que fizemos para o Blackburn Rovers x Arsenal, obtemos:

#set a limit of where we'll calculate across
max_goals <- 7

#calculate the probability of scoring x goals for either team
blackburn_goal_probs <- lapply(0:max_goals, dpois, lambda = prediction$e_hgoal)
arsenal_goal_probs <- lapply(0:max_goals, dpois, lambda = prediction$e_agoal)

#bind together in a df
df <- data.frame(goals = rep(0:max_goals, 2),
                 team = rep(c(home, away), each = max_goals+1),
                 p = c(unlist(blackburn_goal_probs), unlist(arsenal_goal_probs)))

#plot the p of scoring x goals for either team
p1 <- ggplot(df, aes(x = goals, y = p, fill = team)) +
  geom_density(stat = "identity", alpha = 0.5) +
  scale_fill_manual(values = c("red", "blue")) +
  labs(title = "Predicted goals for Blackburn Rovers and Arsenal",
       y = "probability") +
  theme_minimal()

p1

Por causa de como a matemática funciona, essas curvas são o mesmo resultado que obteríamos se rodássemos rpois () (amostragem da função Poisson) muitas vezes. Faremos isso rapidamente, porque prepara o cenário para o que virá mais tarde.

#sample from the function lots of times for each team
n <- 100000
blackburn_goals_samples <- rpois(n, lambda = prediction$e_hgoal)
arsenal_goals_samples <- rpois(n, lambda = prediction$e_agoal)

df <- data.frame(team = rep(c(home, away), each = n),
                 sampled_goals = c(blackburn_goals_samples, arsenal_goals_samples))

#look its the same plot!
p2 <- ggplot(df, aes(x = sampled_goals, fill = team)) +
  geom_bar(stat = "count", position = "dodge", colour = "black", alpha = 0.5) +
  geom_line(aes(colour = team), stat = "count", size = 3) +
  scale_fill_manual(values = c("red", "blue"), guide = FALSE) +
  scale_colour_manual(values = c("red", "blue"), guide = FALSE) +
  labs(title = "Predicted goals for Blackburn Rovers and Arsenal",
       y = "probability",
       x = "sampled goals") +
  theme_minimal() +
  theme(axis.text.y = element_blank())

p2

Ok, ótimo !, em termos de previsão do resultado, o deslocamento para a direita da curva vermelha (Arsenal) aqui é a diferença na capacidade das equipes de gerar um diferencial positivo de objetivos - aumenta a probabilidade de que, se provarmos um evento, o Arsenal terá marcou mais gols do que o Blackburn Rovers no final da partida. Claro, também é óbvio que, embora a curva do Arsenal esteja com a direita alterada, as barras para o Arsenal marcar 0 gols e o Blackburn 6 se manterem suficientemente grandes para que não fiquem fora do campo de possibilidade.

Leia Também  Como otimizar um portfólio baseado em metas

Essa é uma boa maneira de apresentar a chance de cada equipe marcar n gols, mas não nos ajuda a prever o resultado de uma partida, já que isso depende da interação de ambas as distribuições (precisamos saber quantos gols Arsenal AND Blackburn marcará).

Para calcular isso, podemos fazer um produto externo das probabilidades para ambas as equipes marcando n gols. Podemos então traçar a probabilidade de cada pontuação como um gráfico de blocos:

#calculate matrix of possible results and probabilities of those
matrix %
  as.data.frame() %>%
  gather() %>%
  #add in scorelines
  mutate(hgoals = rep(0:max_goals, max_goals+1),
         agoals = rep(0:max_goals, each = max_goals+1))

#make the tile plot
p3 <- ggplot(matrix, aes(x = hgoals, y = agoals, fill = value)) +
  geom_tile() +
  geom_text(aes(label = paste(hgoals, agoals, sep = "-"))) +
  scale_fill_gradient2(low = "white", high = "red", guide = FALSE) +
  theme_minimal()

p3

Onde podemos ver que as pontuações mais comuns são de baixa pontuação (o futebol é um jogo de baixa pontuação) e um pouco tendencioso em relação aos objetivos fora de casa (ou seja, o Arsenal tem mais chances de ganhar do que de perder). As peças mais escuras (provavelmente) sendo 1-1 ou uma vitória por 2-1 no Arsenal parecem muito plausíveis, considerando nossos λs calculados anteriormente.

Podemos então fazer isso para todos os equipamentos e criar um grande gráfico dos resultados esperados para cada um deles usando um map2_ apply simples. Por causa do grande enredo, restringi-o aqui a uma matriz 3 × 3 dos resultados para Arsenal, Coventry City e Enfield Town, mas se você clicar, deverá ser vinculado à imagem completa.

#want to predict over the whole fixture space
all_fixtures %
  filter(!duplicated(paste(home, away), fromLast = TRUE))

#get the lambda for each team per game
predictions <- map2_df(all_fixtures$home, all_fixtures$away, 
                       predict_results,
                       model)

#calc out probabilities and bind up
all_predictions <- map2_df(
  predictions$e_hgoal, predictions$e_agoal, 
  function(lambda_home, lambda_away, max_goals) {
    hgoal_prob % `names<-`(0:max_goals)
    agoal_prob % `names%
      as.data.frame() %>% 
      gather() %>% 
      rownames_to_column("row") %>%
      mutate(hgoal = as.numeric(row) %% (max_goals+1)-1) %>% 
      mutate(hgoal = case_when(hgoal %
      select(sample_hgoal = hgoal, sample_agoal = agoal, prob = value)
}, max_goals) %>%
  cbind(all_fixtures[rep(seq_len(nrow(all_fixtures)), each=(max_goals+1)^2),], .) %>%
  group_by(home, away) %>%
  mutate(prob = prob / sum(prob)) %>%
  ungroup()

#plot again
p3 %
  #filter only a few out to scale plot 
  filter(home %in% c("Arsenal", "Coventry_City", "Enfield_Town"),
         away %in% c("Arsenal", "Coventry_City", "Enfield_Town")) %>%
  ggplot(aes(x = sample_hgoal, y = sample_agoal, fill = prob)) +
  geom_tile() +
  geom_point(aes(x = hgoal, y = agoal), 
             colour = "blue", size = 5, alpha = 0.5 / max_goals^2) +
  geom_text(aes(label = paste(sample_hgoal, sample_agoal, sep = "-")), size = 2.3) +
  scale_fill_gradient2(low = "white", high = "red", guide = FALSE) +
  labs(
    title = "predictions for final score across all fixtures",
    y = "away goals",
    x = "home goals") +
  theme_minimal() +
  facet_grid(away~home, scales = "free")

p3

Para toda a matriz, clique aqui

E daí?

Esses gráficos são bons, mas o importante é o que eles mostram: temos uma maneira de quantificar a probabilidade de qualquer resultado em uma partida entre duas equipes. Por que isso é útil

  • Em primeiro lugar, podemos usar a saída disso para criar modelos de apostas. Dadas as probabilidades nas pontuações finais de qualquer partida, podemos proteger efetivamente apostando (por exemplo) nos cinco resultados mais prováveis.
  • Em segundo lugar, podemos simular ligas. Talvez isso seja especialmente interessante devido ao contexto de redação deste post. Vou focar neste aplicativo porque não apostei no futebol e também porque é difícil obter um bom banco de dados de probabilidades no momento, dada a situação mencionada acima.

A Verve - Monte Carlo

Podemos fazer isso usando uma técnica chamada simulação de Monte Carlo. Há muitas boas explicações da técnica na internet, mas basicamente se resume a isso:

“Se os eventos seguirem uma distribuição conhecida *, você poderá amostrá-los várias vezes para obter estimativas estocásticas, mas em muitas amostras você reproduzirá exatamente essa distribuição”

* uma distribuição de Poisson para o número esperado de gols marcados no nosso caso

Para o futebol, isso significa que, enquanto em um nível de jogo individual, os resultados são barulhentos (às vezes, melhores equipes perdem!), Se simularmos jogos muitas e muitas vezes, eles devem convergir para a "verdade" *

* conforme definido por nossa distribuição de Poisson (que pode ou não ser uma 'verdade' boa / exata, mas que deve ser usada por enquanto).

Para trabalhar com esses dados altamente repetitivos, primeiro queremos "aninhar" as probabilidades de cada correspondência. Isso basicamente significa armazenar um DF de todos os resultados possíveis e suas probabilidades como uma coluna dentro de um DF maior, para que possamos mover os dados dessas duas estruturas com mais facilidade.

Por exemplo, as informações de probabilidade dos resultados da partida ninho para a próxima partida a ser disputada (Coventry City e casa do Arsenal):

nested_probabilities %
  filter(is.na(hgoal)) %>%
  select(-hgoal, -agoal) %>%
  nest(probabilities = c(sample_hgoal, sample_agoal, prob))

nested_probabilities$probabilities[[1]] %>%
  rename("Coventry City" = sample_hgoal, "Arsenal" = sample_agoal) %>%
  arrange(-prob) %>%
  #show first 15 rows
  .[1:15,]
## # A tibble: 15 x 3
##    `Coventry City` Arsenal   prob
##                   
##  1               0       2 0.115 
##  2               0       1 0.109 
##  3               1       2 0.0983
##  4               1       1 0.0933
##  5               0       3 0.0806
##  6               1       3 0.0691
##  7               0       0 0.0516
##  8               1       0 0.0442
##  9               0       4 0.0425
## 10               2       2 0.0422
## 11               2       1 0.0400
## 12               1       4 0.0364
## 13               2       3 0.0296
## 14               2       0 0.0190
## 15               0       5 0.0179

A probabilidade de um único resultado é pequena (caso contrário, as apostas por partida seriam fáceis), mas as probabilidades de vitória do Arsenal por 2-0 e 1-0 são mais altas (como descobrimos anteriormente). De fato, todos os resultados mais prováveis ​​estão dentro de uma ou duas metas para ambos os lados.

Para garantir que essas probabilidades façam sentido, podemos soma-las e ver se o espaço de resultados de 0: max_goals para ambos os lados soma 1

sum(nested_probabilities$probabilities[[1]]$prob)
## [1] 1

Em seguida, podemos facilmente usar esses dados para simular resultados. Amostramos uma única linha (um 'resultado' da correspondência) ponderada pela probabilidade de ocorrência. Por exemplo, quando assistimos ao jogo entre Coventry City e Arsenal, obtemos uma vitória fora do Arsenal por 3-1 (não é o resultado mais provável, mas também o mais improvável).

nested_probabilities$probabilities[[1]] %>%
  rename("Coventry_City" = sample_hgoal, "Arsenal" = sample_agoal) %>%
  sample_n(1, weight = prob)
## # A tibble: 1 x 3
##   Coventry_City Arsenal   prob
##                
## 1             1       3 0.0691

É claro que podemos repetir isso em todas as partidas e ver que as probabilidades dos resultados escolhidos variam (porque estamos amostrando aleatoriamente, nem sempre escolhemos o resultado mais provável ou mesmo provável), mas todos estão dentro de um intervalo razoável dado o time jogando:

nested_probabilities %>%
    mutate(sampled_result = map(probabilities, sample_n, 1, weight = prob)) %>%
    select(-probabilities) %>%
    unnest(cols = c(sampled_result))
## # A tibble: 6 x 6
##   home             away             gameweek sample_hgoal sample_agoal   prob
##                                                
## 1 Coventry_City    Arsenal                 9            0            5 0.0179
## 2 Blackburn_Rovers Dover_Athletic          9            1            1 0.0575
## 3 Frimley_Green    Enfield_Town            9            0            4 0.0418
## 4 Arsenal          Blackburn_Rovers       10            2            1 0.0966
## 5 Coventry_City    Frimley_Green          10            3            0 0.170 
## 6 Dover_Athletic   Enfield_Town           10            2            1 0.0839

Mas quando estamos prevendo o que acontecerá, queremos encontrar o provavelmente resultado. Como mencionado anteriormente, se fizermos uma amostragem suficiente, nossa média convergirá para isso, para que possamos repetir essa técnica de amostragem n vezes (aqui eu fiz 10 vezes), dependendo de quanto tempo queremos esperar para que ela seja processada.

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br

Você pode ver que, ao fazer isso muitas vezes, os resultados com maior probabilidade aparecem mais do que outros - como seria de esperar (por exemplo) jogar Blackburn Rovers x Arsenal muitas vezes.

rerun(10, nested_probabilities %>%
    filter(home == "Coventry_City" & away == "Arsenal") %>%
    mutate(sampled_result = map(probabilities, sample_n, 1, weight = prob)) %>%
    select(-probabilities) %>%
    unnest(cols = c(sampled_result))
) %>%
  bind_rows() %>%
  arrange(-prob)
## # A tibble: 10 x 6
##    home          away    gameweek sample_hgoal sample_agoal   prob
##                                     
##  1 Coventry_City Arsenal        9            0            2 0.115 
##  2 Coventry_City Arsenal        9            1            2 0.0983
##  3 Coventry_City Arsenal        9            1            1 0.0933
##  4 Coventry_City Arsenal        9            0            3 0.0806
##  5 Coventry_City Arsenal        9            1            3 0.0691
##  6 Coventry_City Arsenal        9            1            0 0.0442
##  7 Coventry_City Arsenal        9            0            4 0.0425
##  8 Coventry_City Arsenal        9            0            4 0.0425
##  9 Coventry_City Arsenal        9            0            4 0.0425
## 10 Coventry_City Arsenal        9            1            5 0.0154

Se fizermos isso mais algumas vezes por jogo (aqui 100, para uma estimativa melhor, aconselho pelo menos 10000- deve levar apenas alguns minutos), poderemos começar a atribuir pontos e diferença de objetivo a cada equipe com base no resultado que amostramos. Por exemplo. se uma amostra predizer que o Arsenal venceu o Blackburn Rovers por 4-0, atribuímos 3 pontos ao Arsenal e 0 pontos ao Blackburn Rovers para essa simulação e diferença de golos de +4 e -4, respectivamente.

n <- 100
fixture_sims %
    mutate(sampled_result = map(probabilities, sample_n, 1, weight = prob)) %>%
    select(-probabilities) %>%
    unnest(cols = c(sampled_result)) %>%
  select(-gameweek, -prob) %>%
  pivot_longer(c(home, away), names_to = "location", values_to = "team") %>%
  mutate(points = case_when(
    location == "home" & sample_hgoal > sample_agoal ~ 3,
    location == "away" & sample_agoal > sample_hgoal ~ 3,
    sample_hgoal == sample_agoal ~ 1,
    TRUE ~ 0
  )) %>%
  mutate(gd = case_when(
    location == "home" ~ sample_hgoal - sample_agoal,
    location == "away" ~ sample_agoal - sample_hgoal
  )))

fixture_sims[1]
## [[1]]
## # A tibble: 12 x 6
##    sample_hgoal sample_agoal location team             points    gd
##                                      
##  1            0            0 home     Coventry_City         1     0
##  2            0            0 away     Arsenal               1     0
##  3            4            0 home     Blackburn_Rovers      3     4
##  4            4            0 away     Dover_Athletic        0    -4
##  5            0            0 home     Frimley_Green         1     0
##  6            0            0 away     Enfield_Town          1     0
##  7            3            0 home     Arsenal               3     3
##  8            3            0 away     Blackburn_Rovers      0    -3
##  9            6            1 home     Coventry_City         3     5
## 10            6            1 away     Frimley_Green         0    -5
## 11            1            1 home     Dover_Athletic        1     0
## 12            1            1 away     Enfield_Town          1     0

Podemos então calcular a média de pontos e diferenças de golos ganhos nesses sims em cada equipe e ver quais equipes deverão vencer em seus jogos.

fixture_sims %>%
  bind_rows() %>%
  group_by(team) %>%
  summarise(av_points = sum(points)/n,
            av_gd = sum(gd) / n)
## # A tibble: 6 x 3
##   team             av_points av_gd
##                    
## 1 Arsenal               4.19  2.44
## 2 Blackburn_Rovers      3.16  0.7 
## 3 Coventry_City         3.61  2.42
## 4 Dover_Athletic        2.26 -1.26
## 5 Enfield_Town          2.95  0.23
## 6 Frimley_Green         0.6  -4.53

Onde podemos ver que esperamos que o Arsenal ganhe 4,19 dos 6 pontos possíveis (com os jogos restantes contra Coventry e Blackburn Rovers, espera-se que eles diminuam pontos, mas vencam pelo menos um e provavelmente empatam o outro). Espera-se que Coventry City também se dê bem, provavelmente porque seu último jogo é em casa para Frimley Green, enquanto o Blackburn tem jogos mais difíceis fora do Arsenal e do Dover Athletic.

Podemos então adicionar isso aos pontos calculados que as equipes têm acumulados para obter uma previsão de onde as equipes terminarão a posição da temporada:

table %
  pivot_longer(c(home, away), names_to = "location", values_to = "team") %>%
  mutate(points = case_when(
    location == "home" & hgoal > agoal ~ 3,
    location == "away" & agoal > hgoal ~ 3,
    hgoal == agoal ~ 1,
    TRUE ~ 0
  )) %>%
  mutate(gd = case_when(
    location == "home" ~ hgoal - agoal,
    location == "away" ~ agoal - hgoal
  )) %>%
  group_by(team) %>%
  summarise(points = sum(points),
            gd = sum(gd))

predicted_finishes %
    select(team, points, gd) %>%
    bind_rows(., table) %>%
    group_by(team) %>%
    summarise(points = sum(points),
              gd = sum(gd)) %>%
    arrange(-points, -gd) %>%
    mutate(predicted_finish = 1:n())
}, table) %>%
  group_by(team, predicted_finish) %>%
  summarise(perc = n() / n)

predicted_finishes
## # A tibble: 10 x 3
## # Groups:   team [6]
##    team             predicted_finish  perc
##                            
##  1 Arsenal                         1  0.82
##  2 Arsenal                         2  0.18
##  3 Blackburn_Rovers                1  0.18
##  4 Blackburn_Rovers                2  0.82
##  5 Coventry_City                   3  0.97
##  6 Coventry_City                   4  0.03
##  7 Dover_Athletic                  3  0.03
##  8 Dover_Athletic                  4  0.97
##  9 Enfield_Town                    5  1   
## 10 Frimley_Green                   6  1

O que dá ao Arsenal uma chance de 82% de terminar os campeões, com apenas 18% de chance do Blackburn conseguir saltar para o primeiro lugar. Dado que restam apenas duas partidas com equipes projetadas para ter grandes abismos, não é de surpreender que a maioria das posições finais seja acertada - por exemplo. Enfield Town termina em 5º em cada simulação:

p4 <- ggplot(predicted_finishes, aes(x = predicted_finish, y = perc, fill = team)) +
  geom_bar(stat = "identity", colour = "black") +
  scale_fill_manual(values = c("red", "blue", "skyblue", "white", "dodgerblue4", "blue")) +
  labs(
    title = "Predicted finish position of teams",
    subtitle = "with two gameweeks left to play",
    y = "fraction of finishes",
    x = "final position"
  ) +
  theme_minimal() +
  facet_wrap(~team)

p4

Na realidade

Agora estamos no estágio em que podemos começar a analisar dados reais. Uma das forças motivadoras que me atraiu de volta a essa série de blogs foi a situação atual do futebol - com a temporada terminando com os jogos restantes.

Podemos usar o conhecimento que adquirimos nessas últimas postagens para ver o que esperamos que ocorra nesses jogos não jogados, se não puderem ser concluídos.

Para tornar o código mais conciso, usei o código de Ben Torvaney em seu pacote regista (ele também tem alguns bons blogs de uso semelhantes a esta postagem em seu blog). A matemática subjacente é exatamente a mesma do meu post anterior, embora com algumas opções de design diferentes. Se executarmos as simulações usando o código da postagem anterior, obteremos exatamente a mesma resposta.

O código a seguir também é extremamente semelhante aos blocos finais de um dos meus posts anteriores na análise das conquistas da equipe atual do Liverpool.

library(rvest)
library(regista)

Primeiro, precisamos baixar os dados da atual temporada da Premier League inglesa. Quando tivermos isso, podemos dividi-lo em partidas jogadas (onde sabemos 100% do resultado) e partidas não jogadas das quais precisamos prever o resultado. Com base nas estimativas de força de equipe, usei o xg criado e permitido por jogo, pois acredito que eles fornecem uma estimativa melhor da força de equipe (na verdade, Ben Torvaney tem um bom post sobre o uso do xg de tiro por tiro para modelos Dixon-Coles).

#download the match data from 2019/2020
fixtures_2020 %
  read_html() %>%
  html_nodes("#sched_ks_3232_1") %>%
  html_table() %>%
  as.data.frame() %>%
  separate(Score, into = c("hgoal", "agoal"), sep = "–") %>%
  #only care about goals and expected goals
  select(home = Home, away = Away, home_xg = xG, away_xg = xG.1, hgoal, agoal) %>%
  filter(home != "") %>%
  mutate(home = factor(home), away = factor(away)) %>%
  #round expected goals to nearest integer
  mutate_at(c("home_xg", "away_xg", "hgoal", "agoal"), .funs = funs(round(as.numeric(.))))

#matches with a known result
#used for modelling
played_matches %
  filter(!is.na(home_xg))

#matches with an unknown result
#used for simulation
unplayed_matches %
  filter(is.na(home_xg)) %>%
  select_if(negate(is.numeric))

#fit the dixon coles model
#use xg per game, not 'actual' goals
fit_2020 <- dixoncoles(home_xg, away_xg, home, away, data = played_matches)

Para dar uma olhada em como são os parâmetros da equipe em uma liga da vida real, podemos extraí-los do modelo e plotá-los:

#extract Dixon-Coles team strenth parameters
pars_2020 %
  .[grepl("def_|off_", names(.))] %>%
  matrix(., ncol = 2) %>%
  as.data.frame() %>%
  rename(attack = V1, defence = V2)
pars_2020$team <- unique(gsub("def_*|off_*", "", names(fit_2020$par)))[1:20]

#plot as before
p5 %
  mutate(defence = 1 - defence) %>%
  ggplot(aes(x = attack, y = defence, colour = attack + defence, label = team)) +
  geom_point(size = 3, alpha = 0.7) +
  geom_text_repel() +
  scale_colour_continuous(guide = FALSE) +
  labs(title = "Dixon-Coles parameters for the 2019/2020 EPL",
       x = "attacking strength",
       y = "defensive strength") +
  theme_minimal()

p5

Pode surpreender alguns que o Manchester City esteja previsto para ser melhor que o Liverpool por esse modelo, mas não deve fornecer os números subjacentes para ambas as equipes. O Liverpool está muito quente e o Manchester City está muito frio nesta temporada.

Finalmente, podemos calcular a tabela atual da Premier League e simular os jogos restantes para prever onde as equipes terminarão a temporada se o restante dos jogos for jogado. Eu escolhi 1000 sims apenas por uma questão de tempo de processamento, mas você pode aumentar e diminuir conforme desejado.

#calculate the current EPL table
current_epl_table %
  select(home, away, hgoal, agoal) %>%
  pivot_longer(c(home, away), names_to = "location", values_to = "team") %>%
  mutate(points = case_when(
    location == "home" & hgoal > agoal ~ 3,
    location == "away" & agoal > hgoal ~ 3,
    hgoal == agoal ~ 1,
    TRUE ~ 0
  )) %>%
  mutate(gd = case_when(
    location == "home" ~ hgoal - agoal,
    location == "away" ~ agoal - hgoal
  )) %>%
  group_by(team) %>%
  summarise(points = sum(points),
            gd = sum(gd))

#the number of sims to run
n <- 10000

#simulate remaining matches
fixture_sims_2020 %                     
    mutate(sampled_result = map(.scorelines, sample_n, 1, weight = prob)) %>%
    select(-.scorelines) %>%
    unnest(cols = c(sampled_result)) %>%
  pivot_longer(c(home, away), names_to = "location", values_to = "team") %>%
  mutate(points = case_when(
    location == "home" & hgoal > agoal ~ 3,
    location == "away" & agoal > hgoal ~ 3,
    hgoal == agoal ~ 1,
    TRUE ~ 0
  )) %>%
  mutate(gd = case_when(
    location == "home" ~ hgoal - agoal,
    location == "away" ~ agoal - hgoal
  )) %>%
    select(team, points, gd))

#calculate final EPL tables
predicted_finishes_2020 %
    select(team, points, gd) %>%
    bind_rows(., table) %>%
    group_by(team) %>%
    summarise(points = sum(points),
              gd = sum(gd)) %>%
    arrange(-points, -gd) %>%
    mutate(predicted_finish = 1:n())
}, current_epl_table) %>%
  group_by(team, predicted_finish) %>%
  summarise(perc = n() / n) %>%
  group_by(team) %>%
  mutate(mean_finish = mean(predicted_finish)) %>%
  arrange(mean_finish) %>%
  ungroup() %>%
  mutate(team = factor(team, levels = unique(team)))

Se traçarmos essas finalizações previstas (ordenadas pela chance da maior posição final), podemos ter uma idéia de onde esperamos que as equipes terminem a temporada:

#list of team colours
team_cols <- c("red", "skyblue", "darkblue", "darkblue", "darkred",
               "orange", "red", "white", "red", "blue", "maroon", 
               "blue", "white", "red", "dodgerblue", "yellow", 
               "maroon", "red", "maroon", "yellow")

#plot the finishing position by chance based on these simualtions
p6 <- ggplot(predicted_finishes_2020, 
             aes(x = predicted_finish, y = perc, fill = team)) +
  geom_bar(stat = "identity", colour = "black") +
  scale_fill_manual(values = team_cols, guide = FALSE) +
  labs(
    title = "Predicted finish position of teams",
    subtitle = "for incomplete 2019/2020 EPL season",
    y = "fraction of finishes",
    x = "final position"
  ) +
  theme_minimal() +
  facet_wrap(~team)

p6

São ótimas notícias para os fãs do Liverpool que o modelo acredita ter 100% de chance de terminar em primeiro lugar. O Leicester também pode estar feliz com o 3º lugar, com o Chelsea ou o Manchester United provavelmente terminando entre os quatro primeiros, e o Wolves se juntando ao perdedor dos dois na Liga Europa.

#get the predictions for the 2019/2020 champion
winner %
  filter(predicted_finish %
  mutate(prediction = "Champion chance")

winner
## # A tibble: 2 x 5
##   team            predicted_finish   perc mean_finish prediction     
##                                             
## 1 Liverpool                      1 1.00           1.5 Champion chance
## 2 Manchester City                1 0.0001         2.5 Champion chance
#get prediction for those who qualify for champions league
#and for europa league
champs_league %
  filter(predicted_finish %
  group_by(team) %>%
  summarise(perc = sum(perc)) %>%
  arrange(-perc) %>%
  mutate(prediction = "Champions League chance")

champs_league
## # A tibble: 10 x 3
##    team              perc prediction             
##                                   
##  1 Liverpool       1      Champions League chance
##  2 Manchester City 1      Champions League chance
##  3 Leicester City  0.933  Champions League chance
##  4 Chelsea         0.479  Champions League chance
##  5 Manchester Utd  0.46   Champions League chance
##  6 Wolves          0.106  Champions League chance
##  7 Sheffield Utd   0.0155 Champions League chance
##  8 Tottenham       0.004  Champions League chance
##  9 Arsenal         0.0018 Champions League chance
## 10 Everton         0.0005 Champions League chance
europa_league  %
  filter(predicted_finish %
  group_by(team) %>%
  summarise(perc = sum(perc)) %>%
  arrange(-perc) %>%
  mutate(prediction = "(at least) Europa League chance")

europa_league
## # A tibble: 13 x 3
##    team              perc prediction                     
##                                           
##  1 Liverpool       1      (at least) Europa League chance
##  2 Manchester City 1      (at least) Europa League chance
##  3 Leicester City  0.999  (at least) Europa League chance
##  4 Manchester Utd  0.954  (at least) Europa League chance
##  5 Chelsea         0.954  (at least) Europa League chance
##  6 Wolves          0.729  (at least) Europa League chance
##  7 Sheffield Utd   0.196  (at least) Europa League chance
##  8 Tottenham       0.096  (at least) Europa League chance
##  9 Arsenal         0.0479 (at least) Europa League chance
## 10 Everton         0.0139 (at least) Europa League chance
## 11 Burnley         0.0089 (at least) Europa League chance
## 12 Crystal Palace  0.0009 (at least) Europa League chance
## 13 Southampton     0.0008 (at least) Europa League chance

(obviamente, este modelo não explica nenhuma ramificação da proibição europeia do Manchester City)

Ao pé da mesa, o modelo é bastante otimista quando Norwich está sendo rebaixado, com o Aston Villa provavelmente se juntando a eles e, provavelmente, o West Ham completando os pontos de rebaixamento.

#get predictions for those who would be relegated
relegated  %
  filter(predicted_finish > 17) %>%
  group_by(team) %>%
  summarise(perc = sum(perc)) %>%
  arrange(-perc) %>%
  mutate(prediction = "Relegation chance")

relegated
## # A tibble: 8 x 3
##   team             perc prediction       
##                           
## 1 Norwich City  0.934   Relegation chance
## 2 Aston Villa   0.700   Relegation chance
## 3 Bournemouth   0.507   Relegation chance
## 4 West Ham      0.402   Relegation chance
## 5 Watford       0.270   Relegation chance
## 6 Brighton      0.171   Relegation chance
## 7 Newcastle Utd 0.0126  Relegation chance
## 8 Southampton   0.00270 Relegation chance

Considerações finais

Quero deixar claro no final deste post que esse provavelmente não é o modelo mais sofisticado para prever partidas de futebol (mais na parte 3, talvez desta vez em menos de um ano), mas faz um bom trabalho. trabalho!

De qualquer forma, não acho que executar esses sims seja uma boa maneira de terminar a temporada; na verdade, provavelmente não há uma boa maneira. Este post é mais sobre como usar essa técnica do que se para usá-lo.

Melhor, fique seguro como sempre!

var vglnk = {key: '949efb41171ac6ec1bf7f206d57e90b8'};

(função (d, t) {
var s = d.createElement
s.src = '//cdn.viglink.com/api/vglnk.js';
var r = d.getElementsByTagName
} (documento, 'script'));

Para Deixe um comentário para o autor, siga o link e comente no blog: rstats em Robert Hickman.

R-bloggers.com oferece atualizações diárias por email sobre notícias e tutoriais do R sobre o aprendizado do R e muitos outros tópicos. Clique aqui se você deseja publicar ou encontrar um emprego em ciência da dados / R.


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.



cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br