Den nächsten Bundesliga-Spieltag vorhersagen? Bestimmt nicht einfach, mit den Spielerwechseln, Transfers oder auch möglichen Verletzungen. Nun ich versuche es auf relativ simple Weise. Leider mit nicht großem Erfolg; dennoch gibts am Ende des Artikels eine Prognose zum nächsten Spieltag der ersten Bundesliga. Die nächsten Tage werden zeigen, wie gut die Prognose war.
Für die Daten benutze ich die Seite fbref.com; der Direktlink funktioniert über die Funktion Embed this Table, wobei die Umlaute hier falsch formattiert sind. Dies korrigier ich noch mit der gsub()-Funktion. Mich interessiert zwar nur die erste Bundesliga. Ich ziehe aber auch die Daten für die 2. Bundesliga an, da auch die Teams mit Auf-und Abstiegen berücksichtigt werden müssen. Zur Einfachheit unterscheide ich im späteren Modell aber nicht nach Liga. Die Daten sehen schließlich wiefolgt aus:
## Date Home Away Home_Score Away_Score Result year
## 1 2021-08-13 M'Gladbach Bayern Munich 1 1 D 2021
## 2 2021-08-14 Augsburg Hoffenheim 0 4 A 2021
## 3 2021-08-14 Union Berlin Leverkusen 1 1 D 2021
## 4 2021-08-14 Wolfsburg Bochum 1 0 H 2021
## 5 2021-08-14 Arminia Freiburg 0 0 D 2021
## 6 2021-08-14 Stuttgart Greuther Fuerth 5 1 H 2021Als erstes schauen wir auf die Durchschnittswerte, wie auch hier beschrieben. Wir sehen schon den bekannten Heimvorteil im Datensatz, der aber verschieden stark über die Jahre hinweg ist. Dies ist v.a. deswegen wichtig, weil wir mit den Testdaten vor dem Juni 2021 die Trainingsdaten von nach Juni 2021 vorhersagen wollen. Wir sehen direkt, dass der Heimvorteil im letzten Jahr ohne Zuschauer abgenommen hat.
## # A tibble: 4 × 3
## year avg_home_goals avg_away_goals
## <chr> <dbl> <dbl>
## 1 2019 1.68 1.41
## 2 2020 1.56 1.40
## 3 2021 1.74 1.31
## 4 2022 NA NADer Heimvorteil ist auch in der folgenden Visualisierung als Dichtefunktion gut sichtbar.
Perfekt. Es zeigt sich also, dass die Daten einige Informationen hergeben (können). Zeit für eine tiefere Analyse. Als einfaches Modell nehm ich jetzt für jedes Team die Durchschnittstore geschossen als Angriffs- (alpha) und kassiert als Verteidigungsstärke (beta). Dafür nehme ich Testdaten von vor dem Juni 2021, um später mit den Ergebnissen von nach dem Juni das Modell zu evaluieren.
## # A tibble: 6 × 3
## team alpha beta
## <chr> <dbl> <dbl>
## 1 Arminia 1.91 0.882
## 2 Augsburg 1.32 1.85
## 3 Bayern Munich 2.94 0.941
## 4 Bochum 1.75 1.32
## 5 Braunschweig 0.882 1.74
## 6 Darmstadt 98 1.63 1.44Im Folgenden nun die vorhergesagten Ergebnisse mit folgender Methodik:
gamma <- sum(Home_Score) / sum(Away_Score) #Heimvorteil
Home_Score_e = round(team_alphas[Home]* team_betas[Away]* gamma,3))
Away_Score_e = round(team_alphas[Away]* team_betas[Home],3))## Date Home Away Home_Score Away_Score Result
## 1 2021-08-13 M'Gladbach Bayern Munich 1 1 D
## 2 2021-08-14 Augsburg Hoffenheim 0 4 A
## 3 2021-08-14 Union Berlin Leverkusen 1 1 D
## 4 2021-08-14 Wolfsburg Bochum 1 0 H
## 5 2021-08-14 Arminia Freiburg 0 0 D
## 6 2021-08-14 Stuttgart Greuther Fuerth 5 1 H
## Home_Score_e Away_Score_e Result_e
## 1 2.140 3.460 A
## 2 2.417 2.888 A
## 3 1.828 3.061 A
## 4 2.189 2.368 A
## 5 3.096 1.246 H
## 6 2.796 2.039 HDie Güte messe ich ganz einfach mit dem Anteil der richtig vorhergesagten Resultate Heimsieg, Unentschieden oder Gastsieg.
## correct total accuracy
## 1 63 153 41.18%Oder im Folgenden als Confusion matrix.
## predicted
## actual A H
## A 16 25
## D 16 20
## H 29 47Anwendung der Poisson-Verteilung
Die Verteilung der Tore lässt sich gut mit einer Poisson-Verteilung annähren. Die Poisson-Wahrscheinlichkeitsverteilung erlaubt es die Anzahl von Toren zu modellieren, die unabhängig voneinander in den 90 Minuten Spielzeit eintreten. Die Tore werden im folgenden mit den Durchschnittswerten vergangener Spiele (des gesamten Datensatzes) angenähert, wie hier beschrieben:
Dasselbe können wir pro Team machen; im Folgenden zB für Freiburg. Es wird also schon ersichtlich, wie wir ein Modell bilden können. 
Die Differenz zw. zwei Poisson-Verteilungen ist eine Skellam-Verteilung. Dies erlaubt uns die Wahrscheinlichkeit spezifischer Events zu berechnen. Zum Beispiel liegt die Wahrscheinlichkeit, dass das Heim-Team mit einem Tor mehr gewinnt bei 21%.
dskellam(1,mean(dataset_poisson$Home_Score),mean(dataset_poisson$Away_Score))## [1] 0.2128509Und visualisiert als Grafik:
Im nächsten Schritt baue ich ein allgemeineres Poisson-Regressions-Modell mit dem Trainingsdatensatz und ohne die Unabhängigkeit zwischen den Spielen. Des Ergebnis sieht wiefolgt aus:
##
## Call:
## glm(formula = goals ~ home + team + opponent, family = poisson(link = log),
## data = .)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4943 -0.9307 -0.1576 0.5838 3.7918
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.054707 0.223481 0.245 0.806617
## home 0.158243 0.037922 4.173 3.01e-05 ***
## teamAugsburg -0.018361 0.215829 -0.085 0.932205
## teamBayern Munich 0.749197 0.185366 4.042 5.31e-05 ***
## teamBochum -0.087549 0.154780 -0.566 0.571643
## teamBraunschweig -0.774171 0.221668 -3.492 0.000479 ***
## teamDarmstadt 98 -0.152617 0.156733 -0.974 0.330188
## teamDortmund 0.584118 0.190434 3.067 0.002160 **
## teamDresden -0.677719 0.216227 -3.134 0.001723 **
## teamDuesseldorf -0.204933 0.168526 -1.216 0.223974
## teamEint Frankfurt 0.250262 0.203246 1.231 0.218202
## teamErzgebirge Aue -0.361289 0.163302 -2.212 0.026939 *
## teamFreiburg 0.029159 0.212588 0.137 0.890903
## teamGreuther Fuerth -0.122466 0.155720 -0.786 0.431602
## teamHamburger SV 0.024132 0.151898 0.159 0.873773
## teamHannover 96 -0.188262 0.157806 -1.193 0.232871
## teamHeidenheim -0.336645 0.160709 -2.095 0.036193 *
## teamHertha BSC 0.042059 0.212587 0.198 0.843169
## teamHoffenheim 0.134984 0.207914 0.649 0.516190
## teamHolstein Kiel -0.173189 0.156550 -1.106 0.268604
## teamIngolstadt 04 -0.155618 0.403027 -0.386 0.699405
## teamJahn R'burg -0.392337 0.164477 -2.385 0.017062 *
## teamKarlsruher -0.297132 0.161162 -1.844 0.065228 .
## teamKoeln 0.131551 0.202779 0.649 0.516507
## teamLeverkusen 0.266291 0.201876 1.319 0.187141
## teamM'Gladbach 0.340994 0.198776 1.715 0.086259 .
## teamMainz 05 -0.038740 0.216995 -0.179 0.858309
## teamNuernberg -0.347658 0.162457 -2.140 0.032355 *
## teamOsnabrueck -0.461586 0.166303 -2.776 0.005511 **
## teamPaderborn 07 -0.212756 0.168871 -1.260 0.207717
## teamRB Leipzig 0.543205 0.191588 2.835 0.004579 **
## teamSandhausen -0.428131 0.165718 -2.583 0.009781 **
## teamSchalke 04 -0.193306 0.225112 -0.859 0.390500
## teamSt. Pauli -0.336270 0.162567 -2.068 0.038593 *
## teamStuttgart -0.034356 0.177801 -0.193 0.846779
## teamUnion Berlin -0.117122 0.220795 -0.530 0.595796
## teamW'burg Kickers -0.551908 0.206929 -2.667 0.007650 **
## teamWehen -0.327352 0.194266 -1.685 0.091975 .
## teamWerder Bremen -0.121774 0.210675 -0.578 0.563254
## teamWolfsburg 0.028092 0.212588 0.132 0.894870
## opponentAugsburg 0.307533 0.241189 1.275 0.202284
## opponentBayern Munich -0.312106 0.271209 -1.151 0.249817
## opponentBochum 0.419601 0.211216 1.987 0.046968 *
## opponentBraunschweig 0.676029 0.225074 3.004 0.002668 **
## opponentDarmstadt 98 0.500293 0.209052 2.393 0.016704 *
## opponentDortmund -0.081014 0.258250 -0.314 0.753745
## opponentDresden 0.622305 0.225181 2.764 0.005717 **
## opponentDuesseldorf 0.397933 0.214520 1.855 0.063598 .
## opponentEint Frankfurt 0.273837 0.242832 1.128 0.259455
## opponentErzgebirge Aue 0.518043 0.208306 2.487 0.012885 *
## opponentFreiburg 0.016915 0.252143 0.067 0.946516
## opponentGreuther Fuerth 0.405993 0.211508 1.920 0.054919 .
## opponentHamburger SV 0.428030 0.211229 2.026 0.042726 *
## opponentHannover 96 0.518178 0.208559 2.485 0.012971 *
## opponentHeidenheim 0.327480 0.211804 1.546 0.122070
## opponentHertha BSC 0.244968 0.243410 1.006 0.314223
## opponentHoffenheim 0.142779 0.247321 0.577 0.563735
## opponentHolstein Kiel 0.435300 0.209698 2.076 0.037908 *
## opponentIngolstadt 04 0.671511 0.453140 1.482 0.138366
## opponentJahn R'burg 0.564738 0.207180 2.726 0.006414 **
## opponentKarlsruher 0.511618 0.208549 2.453 0.014158 *
## opponentKoeln 0.393858 0.236169 1.668 0.095376 .
## opponentLeverkusen -0.035274 0.255006 -0.138 0.889982
## opponentM'Gladbach -0.125478 0.259425 -0.484 0.628616
## opponentMainz 05 0.337805 0.240174 1.407 0.159575
## opponentNuernberg 0.590020 0.206315 2.860 0.004239 **
## opponentOsnabrueck 0.566398 0.206695 2.740 0.006139 **
## opponentPaderborn 07 0.449285 0.213477 2.105 0.035325 *
## opponentRB Leipzig -0.187370 0.263306 -0.712 0.476708
## opponentSandhausen 0.553453 0.207394 2.669 0.007617 **
## opponentSchalke 04 0.217069 0.244008 0.890 0.373681
## opponentSt. Pauli 0.567708 0.207185 2.740 0.006142 **
## opponentStuttgart 0.309796 0.240627 1.287 0.197936
## opponentUnion Berlin 0.220280 0.244008 0.903 0.366655
## opponentW'burg Kickers 0.841408 0.219529 3.833 0.000127 ***
## opponentWehen 0.752071 0.221070 3.402 0.000669 ***
## opponentWerder Bremen 0.382074 0.234598 1.629 0.103391
## opponentWolfsburg -0.004646 0.253058 -0.018 0.985352
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 2319.0 on 1855 degrees of freedom
## Residual deviance: 2070.3 on 1778 degrees of freedom
## AIC: 5739.9
##
## Number of Fisher Scoring iterations: 5Mich interessiert vor allem die Spalte Estimate; sie ist ähnlich wie der Steigungskoeffizient einer linearen Regression. Ähnlich wie bei einer logistischen Regression zählt der Exponent: positiv bedeutet mehr Tore, Werte näher an Null bedeuten einen negativeren Effekt. Wir sehen, dass home einen Estimate-Wert von 0.19 hat; dass Heim-Teams also mehr Tore schießen als Gastteams: genauer gesagt exp(0.19)=1.2 mal mehr. Auch die einzelnen Teams fließen mit ihrer Stärke bzw Schwäche ein: Bayern München hat einen estimate von 0.9, Nürnberg von -0.2; München schießt also Tore wie der Durchschnitt, Nürnberg weniger. Ähnlich lässt sich das mit den opponentTeams und der Verteidigungsstärke tun. Nun können wir wieder Vorhersagen machen. Ich mache direkt eine Simulation für verschiedene Ergebnisse: anbei wieder Freiburg gegen Stuttgart. Die Matrix zeigt die Wahrscheinlichkeit an Toren für Freiburg (Reihe) und Stuttgart (Spalte). Die Diagonale ist ein Unentschieden, unter der Diagonale ein Freiburg-Sieg, darüber ein Stuttgart-Sieg
## [1] "6.238%" "10.832%" "9.406%" "5.444%" "2.364%" "0.821%" "0.238%"
## [8] "0.059%" "0.013%" "0.002%" "0.000%" "6.475%" "11.244%" "9.763%"
## [15] "5.651%" "2.453%" "0.852%" "0.247%" "0.061%" "0.013%" "0.003%"
## [22] "0.000%" "3.360%" "5.835%" "5.067%" "2.933%" "1.273%" "0.442%"
## [29] "0.128%" "0.032%" "0.007%" "0.001%" "0.000%" "1.163%" "2.019%"
## [36] "1.753%" "1.015%" "0.441%" "0.153%" "0.044%" "0.011%" "0.002%"
## [43] "0.000%" "0.000%" "0.302%" "0.524%" "0.455%" "0.263%" "0.114%"
## [50] "0.040%" "0.011%" "0.003%" "0.001%" "0.000%" "0.000%" "0.063%"
## [57] "0.109%" "0.094%" "0.055%" "0.024%" "0.008%" "0.002%" "0.001%"
## [64] "0.000%" "0.000%" "0.000%" "0.011%" "0.019%" "0.016%" "0.009%"
## [71] "0.004%" "0.001%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%"
## [78] "0.002%" "0.003%" "0.002%" "0.001%" "0.001%" "0.000%" "0.000%"
## [85] "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%"
## [92] "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%"
## [99] "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%"
## [106] "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%"
## [113] "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%" "0.000%"
## [120] "0.000%" "0.000%"Damit können wir nun wiefolgt die Wahrscheinlichkeiten berechnen:
tibble(Freiburg_win = percent(sum(game_sim[lower.tri(game_sim)]), accuracy=0.1),
Draw = percent(sum(diag(game_sim)), accuracy=0.1),
Stuttgart_win = percent(sum(game_sim[upper.tri(game_sim)]), accuracy=0.1))## # A tibble: 1 × 3
## Freiburg_win Draw Stuttgart_win
## <chr> <chr> <chr>
## 1 53.7% 23.7% 22.6%Genauso prognostiziere ich nun die Spiele des Testdatensatzes und bekomme folgendes Ergebnis:
## # A tibble: 6 × 11
## # Rowwise:
## Date Home Away Home_Score Away_Score Result year Sim_HomeWin Sim_Draw
## <chr> <chr> <chr> <dbl> <dbl> <chr> <chr> <dbl> <dbl>
## 1 2021-08-13 M'Gl… Baye… 1 1 D 2021 0.245 0.218
## 2 2021-08-14 Augs… Hoff… 0 4 A 2021 0.328 0.239
## 3 2021-08-14 Unio… Leve… 1 1 D 2021 0.234 0.239
## 4 2021-08-14 Wolf… Boch… 1 0 H 2021 0.601 0.217
## 5 2021-08-14 Armi… Frei… 0 0 D 2021 0.402 0.279
## 6 2021-08-14 Stut… Greu… 5 1 H 2021 0.496 0.231
## # … with 2 more variables: Sim_AwayWin <dbl>, Result_Sim <chr>Die Güte messe ich wieder ganz einfach mit dem Anteil der richtig vorhergesagten Resultate Heimsieg, Unentschieden oder Gastsieg.
## correct total accuracy
## 1 74 153 48.4%Schade, leider auch nicht besser, wie auch die Matrix zeigt:
## predicted
## actual A H
## A 16 25
## D 16 20
## H 29 47Leider ist das Modell also nicht besser als ein Münzwurf. Dennoch versuche ich mich am nächsten Spieltag mit einem Modell, das am gesamten Datensatz gebildet wurde.
## # A tibble: 9 × 7
## # Rowwise:
## Date Home Away Sim_HomeWin Sim_Draw Sim_AwayWin Sim_Result
## <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 2022-01-07 Bayern Munich M'Glad… 76.70% 13.61% 9.66% H
## 2 2022-01-08 Greuther Fuerth Stuttg… 32.40% 23.70% 43.90% A
## 3 2022-01-08 Hoffenheim Augsbu… 59.34% 21.02% 19.64% H
## 4 2022-01-08 RB Leipzig Mainz … 69.10% 17.78% 13.12% H
## 5 2022-01-08 Freiburg Arminia 50.23% 27.67% 22.10% H
## 6 2022-01-08 Leverkusen Union … 61.51% 20.55% 17.94% H
## 7 2022-01-08 Eint Frankfurt Dortmu… 26.38% 19.96% 53.66% A
## 8 2022-01-09 Hertha BSC Koeln 40.90% 22.82% 36.27% H
## 9 2022-01-09 Bochum Wolfsb… 29.70% 26.24% 44.06% AAnbei noch der komplette Code:
library(dplyr)
library(ggplot2)
library(tidyr)
library(lubridate)
library(xml2)
library(rvest)
library(reshape2)
library(skellam)
# datapull using the Link on fbref.com from Bundesliga + "Embed This Table"
url_BL1_2021_2022 <- "https://widgets.sports-reference.com/wg.fcgi?css=1&site=fb&url=%2Fen%2Fcomps%2F20%2Fschedule%2FBundesliga-Scores-and-Fixtures&div=div_sched_11193_1"
url_BL2_2021_2022 <- "https://widgets.sports-reference.com/wg.fcgi?css=1&site=fb&url=%2Fen%2Fcomps%2F33%2Fschedule%2F2-Bundesliga-Scores-and-Fixtures&div=div_sched_11194_1"
url_BL1_2020_2021 <- "https://widgets.sports-reference.com/wg.fcgi?css=1&site=fb&url=%2Fen%2Fcomps%2F20%2F10737%2Fschedule%2F2020-2021-Bundesliga-Scores-and-Fixtures&div=div_sched_all"
url_BL2_2020_2021 <- "https://widgets.sports-reference.com/wg.fcgi?css=1&site=fb&url=%2Fen%2Fcomps%2F33%2F10745%2Fschedule%2F2020-2021-2-Bundesliga-Scores-and-Fixtures&div=div_sched_all"
url_BL1_2019_2020 <- "https://widgets.sports-reference.com/wg.fcgi?css=1&site=fb&url=%2Fen%2Fcomps%2F20%2F3248%2Fschedule%2F2019-2020-Bundesliga-Scores-and-Fixtures&div=div_sched_all"
url_BL2_2019_2020 <- "https://widgets.sports-reference.com/wg.fcgi?css=1&site=fb&url=%2Fen%2Fcomps%2F33%2F3249%2Fschedule%2F2019-2020-2-Bundesliga-Scores-and-Fixtures&div=div_sched_all"
BL1_2021_2022 <- read_html(url_BL1_2021_2022) %>%
html_nodes('table') %>%
html_table() %>%
.[[1]]
BL2_2021_2022 <- read_html(url_BL2_2021_2022) %>%
html_nodes('table') %>%
html_table() %>%
.[[1]]
BL1_2020_2021 <- read_html(url_BL1_2020_2021) %>%
html_nodes('table') %>%
html_table() %>%
.[[1]]
BL2_2020_2021 <- read_html(url_BL2_2020_2021) %>%
html_nodes('table') %>%
html_table() %>%
.[[1]]
BL1_2019_2020 <- read_html(url_BL1_2019_2020) %>%
html_nodes('table') %>%
html_table() %>%
.[[1]]
BL2_2019_2020 <- read_html(url_BL2_2019_2020) %>%
html_nodes('table') %>%
html_table() %>%
.[[1]]
dataset_Bundesliga <- BL1_2021_2022 %>%
select(Date, Home, Away, Score) %>%
rbind(BL2_2020_2021 %>%
select(Date, Home, Away, Score)) %>%
rbind(BL1_2019_2020 %>%
select(Date, Home, Away, Score)) %>%
rbind(BL2_2019_2020 %>%
select(Date, Home, Away, Score)) %>%
mutate(Home = gsub("ü", "ue", Home)) %>% #leider im HTML Datensatz mit falscher Umschreibung
mutate(Home = gsub("ö", "oe", Home)) %>%
mutate(Away = gsub("ü", "ue", Away)) %>%
mutate(Away = gsub("ö", "oe", Away)) %>%
filter(!(Date=="")) %>%
separate(Score, into=c("Home_Score", "Away_Score"), convert=TRUE) %>%
mutate(Home_Score = as.numeric(Home_Score)) %>%
mutate(Away_Score = as.numeric(Away_Score)) %>%
mutate(Result = ifelse(Home_Score > Away_Score, "H",
ifelse(Home_Score < Away_Score, "A", "D"))) %>%
mutate(year = format(as.Date(Date),"%Y")) %>%
as.data.frame()
head(dataset_Bundesliga)
dataset_Bundesliga %>%
group_by(year) %>%
summarise(avg_home_goals = mean(Home_Score),
avg_away_goals = mean(Away_Score))
dataset_Bundesliga %>%
ggplot(aes()) +
geom_density(aes(x=Home_Score, fill="Heim"), adjust=8, alpha=0.5) +
geom_density(aes(x=Away_Score, fill="Gast"), adjust=8, alpha=0.5) +
scale_x_continuous(breaks = 0:8) +
theme_minimal() +
scale_fill_manual(values=c("Heim" = "#327D8F", "Gast" = "#E0D556")) +
labs(title = "geschossene Tore Heim- und Gastteam",
x = "Tore", y = "Dichte")
# Trainings- & Testdatensatz
df_train <- dataset_Bundesliga %>%
filter(Date < "2021-06-01" )
df_test <- dataset_Bundesliga %>%
filter(Date >= "2021-06-01") %>%
drop_na(Result)
# Datenaufbereitung
df_train_long <- rbind(
df_train %>%
select(team = Home, attack = Home_Score, defense = Away_Score) %>%
mutate(type = "home"),
df_train %>%
select(team = Away, attack = Away_Score, defense = Home_Score) %>%
mutate(type = "away")
)
# Modellbildung
# die Durchschnittswerte der geschosenen Tore für den Angriff, die kassierten Tore für die Verteidigung
model1 <- df_train_long %>%
group_by(team) %>%
summarise(alpha=mean(attack), beta=mean(defense))
head(model1)
team_alphas <- model1$alpha %>% 'names<-'(model1$team)
team_betas <- model1$beta %>% 'names<-'(model1$team)
gamma <- sum(df_train$Home_Score) / sum(df_train$Away_Score) #for home advantage
prediction_model1 <- df_test %>%
select(Date, Home, Away, Home_Score, Away_Score, Result) %>%
mutate(Home_Score_e = round(team_alphas[Home]* team_betas[Away]* gamma,3)) %>%
mutate(Away_Score_e = round(team_alphas[Away]* team_betas[Home],3)) %>%
mutate(Result_e = ifelse(Home_Score_e > Away_Score_e, "H",
ifelse(Away_Score_e > Home_Score_e, "A", "D"))) %>%
as.data.frame()
head(prediction_model1)
accuracy_model1 <- tibble(correct = prediction_model1 %>%
filter(Result == Result_e) %>%
nrow(),
total = prediction_model1 %>%
nrow(),
accuracy = percent(correct / total, accuracy=0.01)) %>%
as.data.frame() %>%
print
table(actual=prediction_model1$Result, predicted = prediction_model1$Result_e)
dataset_poisson <- dataset_Bundesliga %>%
drop_na(Result)
poisson <- bind_rows(list(
merge(
tibble(Goals = seq(0, max(dataset_poisson$Away_Score, dataset_poisson$Home_Score), by=1)) %>%
mutate(pred=dpois(0:(nrow(.)-1), mean(dataset_poisson$Home_Score))) %>%
mutate(type = "home"),
dataset_poisson %>%
group_by(Home_Score) %>%
summarize(actual=n()/nrow(.)),
by.x="Goals", by.y="Home_Score", all.x=TRUE),
merge(
tibble(Goals = seq(0, max(dataset_poisson$Away_Score, dataset_poisson$Home_Score), by=1)) %>%
mutate(pred=dpois(0:(nrow(.)-1), mean(dataset_poisson$Away_Score))) %>%
mutate(type="away"),
dataset_poisson %>%
group_by(Away_Score) %>%
summarize(actual=n()/nrow(.)),
by.x="Goals", by.y="Away_Score", all.x=TRUE))) %>%
mutate(actual = if_else(is.na(actual), 0, actual))
poisson %>%
ggplot(aes(x=as.factor(Goals))) +
geom_col(aes(y=actual, fill=type), stat="identity", position="dodge", alpha=0.5) +
geom_line(aes(y=pred, group=type, color=type), size=1.25) +
scale_fill_manual(values=c("#327D8F", "#E0D556"), name="actual") +
scale_color_manual(values=c("#327D8F", "#E0D556"), name="Poisson") +
theme_minimal() +
labs(title = "Anteil der erzielten und geschätzten Tore pro Spiel",
x = "erzielte Tore", y = "Anteil an Spielen")
df_freiburg.home <- dataset_poisson %>%
filter(Home == "Freiburg")
df_freiburg.away <- dataset_poisson %>%
filter(Away == "Freiburg")
poisson_freiburg <- bind_rows(list(
merge(
tibble(Goals = seq(0, max(df_freiburg.away$Away_Score, df_freiburg.home$Home_Score), by=1)) %>%
mutate(pred=dpois(0:(nrow(.)-1), mean(df_freiburg.home$Home_Score))) %>%
mutate(type = "home"),
df_freiburg.home %>%
group_by(Home_Score) %>%
summarize(actual=n()/nrow(.)),
by.x="Goals", by.y="Home_Score", all.x=TRUE),
merge(
tibble(Goals = seq(0, max(df_freiburg.away$Away_Score, df_freiburg.home$Home_Score), by=1)) %>%
mutate(pred=dpois(0:(nrow(.)-1), mean(df_freiburg.away$Away_Score))) %>%
mutate(type="away"),
df_freiburg.away %>%
group_by(Away_Score) %>%
summarize(actual=n()/nrow(.)),
by.x="Goals", by.y="Away_Score", all.x=TRUE))) %>%
mutate(actual = if_else(is.na(actual), 0, actual))
poisson_freiburg %>%
ggplot(aes(x=as.factor(Goals))) +
geom_col(aes(y=actual, fill=type), stat="identity", position="dodge", alpha=0.5) +
geom_line(aes(y=pred, group=type, color=type), size=1.25) +
scale_fill_manual(values=c("#327D8F", "#E0D556"), name="actual") +
scale_color_manual(values=c("#327D8F", "#E0D556"), name="Poisson") +
theme_minimal() +
labs(title = "Anteil der von Freiburg erzielten und geschätzten Tore pro Spiel",
x = "erzielte Tore", y = "Anteil an Spielen")
dskellam(1,mean(dataset_poisson$Home_Score),mean(dataset_poisson$Away_Score))
dataset_poisson %>%
mutate(goal_diff = Home_Score-Away_Score) %>%
group_by(goal_diff) %>%
summarize(actual=n()/nrow(.)) %>%
inner_join(data.frame(goal_diff=-5:5,
pred=dskellam(-5:5, mean(df_train$Home_Score), mean(df_train$Away_Score))),
by=c("goal_diff")) %>%
ggplot(aes(x=as.factor(goal_diff))) +
geom_bar(aes(y = actual,fill="actual"), stat="identity") +
geom_line(aes(y = pred, group = 1, color = "Skellam"), size=1.25) +
scale_fill_manual(values=c("#327D8F"), name="actual") +
scale_color_manual(values=c("#E0D556"), name="Skellam") +
theme_minimal() +
labs(title = "Tordifferenz Heim- vs Gast-Team",
x = "Tordifferenz", y = "Anteil an Spielen")
poisson_model <- rbind(
data.frame(goals=df_train$Home_Score,
team=df_train$Home,
opponent=df_train$Away,
home=1),
data.frame(goals=df_train$Away_Score,
team=df_train$Away,
opponent=df_train$Home,
home=0)) %>%
glm(goals ~ home + team +opponent, family=poisson(link=log),data=.)
summary(poisson_model)
simulate_match <- function(foot_model, Home, Away, max_goals=10){
home_goals_avg <- predict(foot_model,
data.frame(home=1, team=Home,
opponent=Away), type="response")
away_goals_avg <- predict(foot_model,
data.frame(home=0, team=Away,
opponent=Home), type="response")
dpois(0:max_goals, home_goals_avg) %o% dpois(0:max_goals, away_goals_avg)
}
game_sim <- simulate_match(poisson_model, "Freiburg", "Stuttgart", max_goals=10)
library(scales)
percent(game_sim, accuracy = 0.001)
tibble(Freiburg_win = percent(sum(game_sim[lower.tri(game_sim)]), accuracy=0.1),
Draw = percent(sum(diag(game_sim)), accuracy=0.1),
Stuttgart_win = percent(sum(game_sim[upper.tri(game_sim)]), accuracy=0.1))
poisson_predictions <- df_test %>%
filter(Home != "Hansa Rostock") %>%
filter(Away != "Hansa Rostock")
for (i in 1:nrow(poisson_predictions)){
sim <- simulate_match(poisson_model, poisson_predictions$Home[i], poisson_predictions$Away[i], max_goals=10)
poisson_predictions$Sim_HomeWin[i]=sum(sim[lower.tri(sim)])
poisson_predictions$Sim_Draw[i]=sum(diag(sim))
poisson_predictions$Sim_AwayWin[i]=sum(sim[upper.tri(sim)])
}
poisson_predictions <- poisson_predictions %>%
rowwise() %>%
mutate(Result_Sim = if_else(Sim_HomeWin == max(Sim_HomeWin, Sim_Draw, Sim_AwayWin), "H",
if_else(Sim_AwayWin == max(Sim_HomeWin, Sim_Draw, Sim_AwayWin), "A",
"D")))
accuracy_model1 <- tibble(correct = poisson_predictions %>%
filter(Result == Result_Sim) %>%
nrow(),
total = poisson_predictions %>%
nrow(),
accuracy = correct / total) %>%
as.data.frame() %>%
print
table(actual=prediction_model1$Result, predicted = prediction_model1$Result_e)
poisson_model2 <- rbind(
data.frame(goals=dataset_poisson$Home_Score,
team=dataset_poisson$Home,
opponent=dataset_poisson$Away,
home=1),
data.frame(goals=dataset_poisson$Away_Score,
team=dataset_poisson$Away,
opponent=dataset_poisson$Home,
home=0)) %>%
glm(goals ~ home + team +opponent, family=poisson(link=log),data=.)
poisson_predictions2 <- dataset_Bundesliga %>%
filter(Date == "2022-01-07" | Date == "2022-01-08" | Date == "2022-01-09") %>%
filter(Home != "Hansa Rostock") %>%
filter(Away != "Hansa Rostock")
for (i in 1:nrow(poisson_predictions2)){
sim <- simulate_match(poisson_model2, poisson_predictions2$Home[i], poisson_predictions2$Away[i], max_goals=10)
poisson_predictions2$Sim_HomeWin[i]=sum(sim[lower.tri(sim)])
poisson_predictions2$Sim_Draw[i]=sum(diag(sim))
poisson_predictions2$Sim_AwayWin[i]=sum(sim[upper.tri(sim)])
}
poisson_predictions2 %>%
rowwise() %>%
mutate(Sim_Result = if_else(Sim_HomeWin == max(Sim_HomeWin, Sim_Draw, Sim_AwayWin), "H",
if_else(Sim_AwayWin == max(Sim_HomeWin, Sim_Draw, Sim_AwayWin), "A",
"D"))) %>%
select(Date, Home, Away, Sim_HomeWin, Sim_Draw, Sim_AwayWin, Sim_Result) %>%
mutate(Sim_HomeWin = percent(as.numeric(Sim_HomeWin), accuracy=0.01)) %>%
mutate(Sim_AwayWin = percent(as.numeric(Sim_AwayWin), accuracy=0.01)) %>%
mutate(Sim_Draw = percent(as.numeric(Sim_Draw), accuracy=0.01)) %>%
print(