Skip to content

Instantly share code, notes, and snippets.

@ikashnitsky
Last active June 12, 2021 11:38
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save ikashnitsky/69a0be97e50bb3fb26e6db96d1178c07 to your computer and use it in GitHub Desktop.
Save ikashnitsky/69a0be97e50bb3fb26e6db96d1178c07 to your computer and use it in GitHub Desktop.
Win predictions of #EURO2020 pooled together from 18 sources -- https://twitter.com/ikashnitsky/status/1403470245407477764
#===============================================================================
# 2021-06-11 -- twitter
# UEFA European Cup predictions
# Ilya Kashnitsky, ilya.kashnitsky@gmail.com, @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