|
#' |
|
#' 3. Most expensive transfers |
|
#' |
|
|
|
pl <- get_league_df("premier-league") |
|
buli <- get_league_df("1-bundesliga") %>% mutate(league = "Bundesliga") |
|
laliga <- get_league_df("laliga") %>% mutate(league = "La Liga") |
|
seriea <- get_league_df("serie-a") |
|
ligue1 <- get_league_df("ligue-1") |
|
|
|
transfers <- rbind(pl, buli, laliga, seriea, ligue1) |
|
purchases <- transfers %>% filter(movement == "in" & fee > 0) |
|
|
|
|
|
#' |
|
#' PLOT 3-1: The 25 most ever expensive European transfers |
|
#' |
|
biggest_purchases <- purchases %>% |
|
arrange(desc(fee)) %>% |
|
slice(1:25) %>% |
|
mutate(fee = fee / 1e6) %>% |
|
mutate( |
|
club = case_when( |
|
club == "Arsenal FC" ~ "Arsenal", |
|
club == "Chelsea FC" ~ "Chelsea", |
|
club == "Liverpool FC" ~ "Liverpool", |
|
club == "Manchester United" ~ "Man Utd", |
|
club == "Manchester City" ~ "Man City", |
|
club == "Atlético Madrid" ~ "Atl. Madrid", |
|
club == "FC Barcelona" ~ "Barcelona", |
|
club == "Real Madrid" ~ "R. Madrid", |
|
club == "Paris Saint-Germain" ~ "PSG", |
|
club == "Juventus FC" ~ "Juventus", |
|
TRUE ~ club |
|
) |
|
) %>% |
|
select(name, club, fee, season) %>% |
|
arrange(name) |
|
|
|
x1 <- rownames(biggest_purchases) |
|
set_club_color <- function() { |
|
return (case_when( |
|
biggest_purchases$club == "R. Madrid" ~ "#00529F", |
|
biggest_purchases$club == "Barcelona" ~ "#A50044", |
|
TRUE ~ "grey30" |
|
)) |
|
} |
|
|
|
viz_biggest_purchases <- biggest_purchases %>% |
|
ggplot(aes(x = reorder(x1, fee), y = fee)) + |
|
geom_point(color = set_club_color()) + |
|
geom_segment( |
|
aes(x = x1, xend = x1, y = 0, yend = fee), |
|
color = set_club_color() |
|
) + |
|
geom_text( |
|
aes( |
|
label = sprintf("\u20AC%.fm", fee), |
|
y = fee, |
|
hjust = -0.2, |
|
fontface = "bold" |
|
), |
|
color = set_club_color(), |
|
size = 3.5 |
|
) + |
|
geom_label( |
|
aes( |
|
label = sprintf("%s, %d", club, season), |
|
y = 10, |
|
hjust = 0, |
|
fontface = case_when( |
|
club == "R. Madrid" ~ "bold.italic", |
|
club == "Barcelona" ~ "bold.italic", |
|
TRUE ~ "italic" |
|
) |
|
), |
|
color = set_club_color(), |
|
size = 3.2, |
|
label.size = NA |
|
) + |
|
labs( |
|
title = "The 25 most ever expensive European transfers", |
|
subtitle = paste( |
|
"Barcelona and Real Madrid have paid ten of the biggest ever", |
|
"transfer fees. \nNeymar and Ronaldo are the only players to make", |
|
"the top list twice." |
|
), |
|
x = NULL, |
|
y = NULL |
|
) + |
|
scale_x_discrete( |
|
labels = biggest_purchases$name[order(biggest_purchases$fee)] |
|
) + |
|
scale_y_continuous(expand = expansion(mult = c(0, 0.1))) + |
|
plot_settings + |
|
theme( |
|
axis.text.x = element_blank(), |
|
axis.ticks.x = element_blank() |
|
) + |
|
coord_flip() |
|
save_image("transfers-3-1", viz_biggest_purchases) |
|
|
|
|
|
#' |
|
#' PLOT 3-2: Biggest ever transfers adjusted for inflation |
|
#' |
|
eur_inflation_index <- setNames(c( |
|
1.68, 1.63, 1.58, 1.54, 1.50, 1.47, 1.45, 1.43, 1.41, 1.37, 1.35, 1.32, |
|
1.29, 1.26, 1.23, 1.21, 1.17, 1.15, 1.14, 1.12, 1.09, 1.06, 1.05, 1.06, |
|
1.05, 1.04, 1.03, 1.01, 1.00 |
|
), as.character(1992:2020)) |
|
|
|
adj_biggest_purchases <- purchases %>% |
|
mutate(fee = fee * eur_inflation_index[as.character(season)] / 1e6) %>% |
|
arrange(desc(fee)) %>% |
|
slice(1:25) %>% |
|
mutate( |
|
club = case_when( |
|
club == "Arsenal FC" ~ "Arsenal", |
|
club == "Chelsea FC" ~ "Chelsea", |
|
club == "Liverpool FC" ~ "Liverpool", |
|
club == "Manchester United" ~ "Man Utd", |
|
club == "Manchester City" ~ "Man City", |
|
club == "Atlético Madrid" ~ "Atl. Madrid", |
|
club == "FC Barcelona" ~ "Barcelona", |
|
club == "Real Madrid" ~ "R. Madrid", |
|
club == "Paris Saint-Germain" ~ "PSG", |
|
club == "Juventus FC" ~ "Juventus", |
|
TRUE ~ club |
|
) |
|
) %>% |
|
select(name, club, fee, season) %>% |
|
arrange(name) |
|
|
|
x2 <- rownames(adj_biggest_purchases) |
|
galacticos <- c("Zinédine Zidane", "Luís Figo") |
|
|
|
set_rma_color <- function() { |
|
return (ifelse(adj_biggest_purchases$name %in% galacticos, "#00529F", "grey30")) |
|
} |
|
set_rma_size <- function(size, default) { |
|
return (ifelse(adj_biggest_purchases$name %in% galacticos, size, default)) |
|
} |
|
|
|
viz_adj_biggest_purchases <- adj_biggest_purchases %>% |
|
ggplot(aes(x = reorder(x2, fee), y = fee)) + |
|
geom_point( |
|
color = set_rma_color(), |
|
size = set_rma_size(3, 1.5) |
|
) + |
|
geom_segment( |
|
aes(x = x2, xend = x2, y = 0, yend = fee), |
|
color = set_rma_color(), |
|
size = set_rma_size(1.25, 0.5) |
|
) + |
|
geom_text( |
|
aes( |
|
label = sprintf("\u20AC%.fm", fee), |
|
y = fee, |
|
hjust = -0.2, |
|
fontface = "bold" |
|
), |
|
color = set_rma_color(), |
|
size = set_rma_size(4.5, 3.5) |
|
) + |
|
geom_label( |
|
aes( |
|
label = sprintf("%s, %d", club, season), |
|
y = 10, |
|
hjust = 0, |
|
fontface = ifelse( |
|
adj_biggest_purchases$name %in% galacticos, "bold.italic", "italic" |
|
) |
|
), |
|
color = set_rma_color(), |
|
size = set_rma_size(4, 3.2), |
|
label.size = NA |
|
) + |
|
labs( |
|
title = "Biggest ever transfers adjusted for inflation", |
|
subtitle = paste( |
|
"Two of the original Real Madrid Galácticos, Zidane and Luis", |
|
"Figo, are \nstill among the most expensive transfers." |
|
), |
|
x = NULL, |
|
y = NULL |
|
) + |
|
scale_x_discrete( |
|
labels = adj_biggest_purchases$name[order(adj_biggest_purchases$fee)] |
|
) + |
|
scale_y_continuous(expand = expansion(mult = c(0, 0.1))) + |
|
plot_settings + |
|
theme( |
|
axis.text.x = element_blank(), |
|
axis.ticks.x = element_blank() |
|
) + |
|
coord_flip() |
|
save_image("transfers-3-2", viz_adj_biggest_purchases) |