Skip to content

Instantly share code, notes, and snippets.

@ikashnitsky

ikashnitsky/euro2020-predictions.R

Last active June 12, 2021 11:38
Show Gist options
  • Save ikashnitsky/69a0be97e50bb3fb26e6db96d1178c07 to your computer and use it in GitHub Desktop.
Save ikashnitsky/69a0be97e50bb3fb26e6db96d1178c07 to your computer and use it in GitHub Desktop.
Download ZIP
Win predictions of #EURO2020 pooled together from 18 sources -- https://twitter.com/ikashnitsky/status/1403470245407477764
Raw
euro2020-predictions.R
#===============================================================================
# 2021-06-11 -- twitter
# UEFA European Cup predictions
# Ilya Kashnitsky, [email protected], @ikashnitsky
#===============================================================================
library(tidyverse)
library(magrittr)
library(ggdark)
library(paletteer)
library(hrbrthemes)
library(cowplot)
# Visualizing the data from
# https://twitter.com/JanVanHaaren/status/1403374087163023360
win_prob <- tibble::tribble(
~Country, ~Average.win, ~Median.win, ~Maximum.win, ~Minimum.win, ~AZ, ~CR, ~DTAI, ~FF, ~FS, ~GI, ~GS, ~HC, ~KL, ~LB, ~LG, ~MJ, ~MS, ~OLE, ~OP, ~SG, ~SJ, ~SP,
"Belgium", 15.41, 14.09, 28.93, 2.98, 8.32, 8.69, 28.93, 2.98, 22.83, 7.69, 17.1, 13.92, 24.55, 13.71, 24.32, 14.1, 8.32, 23.79, 12.09, 14.08, 16.26, 15.67,
"France", 14.38, 13.51, 21.27, 6.9, 14.79, 12.79, 13.55, 13.19, 19.85, 7.69, 10.2, 15.53, 6.9, 13.47, 19.82, 12.77, 11.69, 21.27, 15.39, 11.26, 18.22, 20.47,
"Spain", 11.65, 11.45, 14.11, 9.29, 12.35, 9.89, 13.89, 11.62, 13.9, 9.29, 13.1, 10.33, 13.55, 9.73, 13.01, 13.55, 9.7, 14.11, 9.61, 10.77, 9.98, 11.28,
"England", 10.2, 10.01, 18.56, 4.3, 13.46, 10.49, 6.06, 14.49, 5.66, 7.09, 12.9, 9.53, 16.65, 6.64, 4.3, 11.76, 8.85, 4.36, 13.97, 13.6, 18.56, 5.19,
"Portugal", 8.53, 8.15, 18.95, 3.9, 10.08, 6.39, 8.71, 18.95, 9.83, 3.9, 9.5, 7.97, 6.9, 5.92, 8.01, 6.62, 8.29, 8.83, 9.15, 7.59, 7.34, 9.58,
"Italy", 8.39, 8.19, 13.5, 2.6, 7.92, 7.29, 8.82, 8.14, 9.53, 4.3, 10.4, 9.04, 13.5, 11.69, 2.6, 9.57, 8.23, 7.36, 8.06, 9.12, 7.84, 7.59,
"Germany", 6.91, 6.61, 16.5, 1.4, 10.07, 7.69, 2.52, 16.5, 3.28, 10.19, 3.1, 6.38, 1.4, 10.78, 7.11, 5.47, 6.83, 3.54, 10.03, 5.65, 4.1, 9.78,
"Netherlands", 5.86, 6.01, 8.57, 2.82, 6.13, 5.59, 3.13, 2.82, 3.97, 8.29, 6.8, 5.82, 4.3, 8.57, 6.41, 7.67, 6.62, 8.29, 6.39, 5.07, 3.64, 5.89,
"Denmark", 4.81, 5.14, 7.41, 0.99, 4.56, 5, 7.41, 0.99, 5.96, 5.29, 5.8, 5.43, 7.15, 6.45, 1.5, 4.62, 4.7, 3.16, 3.08, 6.63, 3.42, 5.39,
"Switzerland", 2.14, 2.12, 3.9, 0.87, 2.18, 3.2, 1.37, 0.87, 1.09, 3.9, 2.5, 2.76, 1.75, 1.71, 2.8, 2.63, 2.06, 1.11, 1.16, 3.44, 1.74, 2.3,
"Croatia", 2.04, 1.94, 4.3, 0.35, 3.05, 2.8, 0.56, 2.62, 0.35, 3.4, 1.1, 1.63, 0.5, 2.4, 4.3, 1.91, 4.16, 1.2, 2.37, 1.42, 1.98, 1,
"Sweden", 1.43, 1.34, 2.5, 0.24, 1, 2.5, 0.97, 0.24, 1.19, 2.5, 1.5, 2.04, 0.5, 2.11, 0.8, 1.75, 2.47, 0.64, 0.88, 2.1, 1.12, 1.5,
"Poland", 1.33, 1.24, 2.7, 0.4, 1.24, 2.1, 0.58, 2.27, 0.79, 2.7, 0.6, 1.56, 0.8, 2.25, 0.4, 1.4, 2.37, 0.45, 1.08, 1.31, 1.24, 0.8,
"Ukraine", 1.28, 1.06, 3.9, 0.3, 0.3, 2.8, 0.91, 0.5, 0.3, 3.9, 1.6, 1.82, 0.3, 0.81, 1.4, 1.25, 2.53, 0.66, 1.21, 1.28, 0.66, 0.8,
"Austria", 1.04, 0.62, 5.89, 0.05, 1.46, 1.9, 0.21, 1.28, 0.05, 5.89, 0.4, 0.81, 0.2, 0.46, 0.2, 0.36, 2.55, 0.27, 0.86, 0.81, 0.78, 0.2,
"Wales", 0.99, 0.87, 2.1, 0.02, 0.59, 2.1, 1.27, 0.02, 0.74, 1.3, 1, 1.83, 0.6, 1.79, 0.5, 0.57, 1.19, 0.52, 0.43, 1.29, 1.54, 0.6,
"Turkey", 0.88, 0.77, 2.4, 0.07, 0.74, 1.6, 0.55, 0.07, 0.25, 1.5, 0.9, 0.82, 0.1, 0.28, 0.8, 2.4, 2.35, 0.11, 1.58, 0.9, 0.4, 0.4,
"Russia", 0.75, 0.63, 2.43, 0.05, 0.35, 2, 0.13, 1.14, 0.15, 1.7, 0.3, 0.77, 0.05, 0.48, 0.8, 0.42, 2.43, 0.07, 0.89, 0.78, 0.12, 1,
"Czech Republic", 0.63, 0.46, 2.2, 0.12, 0.33, 1.2, 0.15, 0.5, 0.3, 2.2, 0.6, 0.77, 0.15, 0.25, 0.5, 0.43, 1.83, 0.12, 0.58, 0.98, 0.32, 0.2,
"Scotland", 0.41, 0.14, 2.2, 0, 0.58, 1.2, 0.02, 0.68, 0, 2.2, 0, 0.3, 0, 0.09, 0.1, 0.12, 0.91, 0.01, 0.33, 0.54, 0.16, 0.1,
"Slovakia", 0.32, 0.16, 2.2, 0, 0.3, 0.8, 0.02, 0.01, 0, 2.2, 0, 0.06, 0, 0.35, 0, 0.27, 0.82, 0.01, 0.27, 0.28, 0.28, 0.04,
"Hungary", 0.29, 0.17, 1, 0, 0.04, 1, 0.12, 0.1, 0, 0.9, 0.4, 0.56, 0, 0.02, 0.2, 0.19, 0.66, 0.07, 0.21, 0.53, 0.16, 0.1,
"Finland", 0.22, 0.13, 1.3, 0, 0.12, 0.6, 0.15, 0, 0, 1.3, 0.1, 0.26, 0.15, 0.02, 0.1, 0.15, 0.28, 0.05, 0.18, 0.33, 0.08, 0.1,
"North Macedonia", 0.11, 0.05, 0.7, 0, 0.06, 0.4, 0.01, 0, 0, 0.7, 0.1, 0.06, 0, 0.02, 0, 0.04, 0.13, 0, 0.17, 0.24, 0.06, 0.02
) %>%
janitor::clean_names() %>%
mutate(
country = country %>% as_factor %>% fct_reorder(median_win)
)
# boxplots ----------------------------------------------------------------
win_prob %>%
pivot_longer(names_to = "source", values_to = "win_prob", cols = az:sp) %>%
ggplot(aes(country, win_prob, color = country))+
geom_jitter(width = .25, alpha = .25)+
geom_boxplot(fill = NA, notch = T, notchwidth = .2, outlier.color = NA)+
coord_flip()+
scale_y_continuous(position = "right")+
scale_color_paletteer_d("Polychrome::light", guide = NULL)+
dark_theme_minimal(base_family = font_rc)+
labs(
title = "Who is going to win EURO 2020? Chances in %",
caption = "Data: @JanVanHaaren, pooled from 18 sources | Design: @ikashnitsky",
x = NULL, y = NULL
)+
theme(
plot.title = element_text(face = 2, family = "Roboto Slab", size = 18),
axis.text.y = element_text(face = 2, size = 12)
)
p_box <- last_plot()
# treemap -----------------------------------------------------------------
library(treemapify)
win_prob %>%
ggplot(
aes(
area = average_win, fill = country,
label = paste0(country, "\n", average_win %>% round(1))
)
)+
geom_treemap()+
scale_fill_paletteer_d("Polychrome::light", guide = NULL)+
geom_treemap_text(family = font_rc, fontface = 2, place = "centre", reflow = T, grow = F)+
theme_void()
p_tree <- last_plot()
# inset -------------------------------------------------------------------
joined <- ggdraw(p_box)+
draw_plot(p_tree, x = .53, width = .45, y = 0.05, height = .55)+
draw_text(
text = "Average of the 18 predictions",
x = .75, y = .62, vjust = 0,
family = "Roboto Slab", fontface = 2, size = 18
)
ggsave(
"~/Downloads/18-predictions.png", joined,
width = 7, height = 5, type = "cairo"
)
# geometric averaging -----------------------------------------------------
geom_avg <- win_prob %>%
pivot_longer(names_to = "source", values_to = "win_prob", cols = az:sp) %>%
filter(!win_prob==0) %>%
group_by(country) %>%
summarise(geom_avg = win_prob %>% prod %>% raise_to_power(1/18)) %>%
ungroup() %>%
mutate(geom_avg = geom_avg %>% prop.table %>% multiply_by(100))
geom_avg %>%
ggplot(
aes(
area = geom_avg, fill = country,
label = paste0(country, "\n", geom_avg %>% round(1))
)
)+
geom_treemap()+
scale_fill_paletteer_d("Polychrome::light", guide = NULL)+
geom_treemap_text(family = font_rc, fontface = 2, place = "centre", reflow = T, grow = F)+
theme_void()
p_tree_geom <- last_plot()
ggsave(
"~/Downloads/geom_centered.png", p_tree_geom,
width = 5, height = 5, type = "cairo"
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment