Skip to content

Instantly share code, notes, and snippets.

@Ryo-N7
Last active November 16, 2019 08:01
Show Gist options
  • Save Ryo-N7/a1b9fbdaa5ae2a55264f4dbffb7d5f85 to your computer and use it in GitHub Desktop.
Save Ryo-N7/a1b9fbdaa5ae2a55264f4dbffb7d5f85 to your computer and use it in GitHub Desktop.
Liverpool FC Age-Utility Graph (Premier League 2019-2020)
pacman::p_load(tidyverse, polite, scales, ggimage, ggforce,
stringr, ggtext,
rvest, glue, extrafont, ggrepel)
loadfonts(quiet = TRUE)
session <- bow("https://www.transfermarkt.com/liverpool-fc/leistungsdaten/verein/31/reldata/GB1%262019/plus/1")
print(session)
result_name <- scrape(session) %>%
html_nodes("#yw1 .bilderrahmen-fixed") %>%
html_attr("title")
# grab age
result_age <- scrape(session) %>%
html_nodes(".posrela+ .zentriert") %>%
html_text()
# grab minutes played in league
result_mins <- scrape(session) %>%
html_nodes("td.rechts") %>%
html_text()
resultados <- list(result_name, result_age, result_mins)
col_name <- c("name", "age", "minutes")
# then reduce(cbind) to combine them, set names to cols
resultados %>%
reduce(cbind) %>%
as_tibble() %>%
set_names(col_name) -> results_comb
glimpse(results_comb)
lfc_minutes <- results_comb %>%
mutate(age = as.numeric(age),
minutes = minutes %>%
str_replace("\\.", "") %>%
str_replace("'", "") %>%
as.numeric(),
min_perc = (minutes / 1080) %>% round(digits = 3)) %>%
filter(!is.na(minutes)) %>%
separate(name, into = c("first_name", "last_name"), sep = " ") %>%
# manually fix some names
mutate(
last_name = case_when(
first_name == "Trent" ~ "Alexander-Arnold",
first_name == "Virgil" ~ "Van Dijk",
first_name == "Alex" ~ "Oxlade-Chamberlain",
first_name == "Alisson" ~ "Alisson",
first_name == "Adrián" ~ "Adrián",
first_name == "Fabinho" ~ "Fabinho",
TRUE ~ last_name)) %>%
arrange(desc(min_perc))
rect_df <- data.frame(
xmin = 25, xmax = 30,
ymin = -Inf, ymax = Inf
)
glimpse(lfc_minutes)
## set fig.height = 6, fig.width = 8
lfc_minutes %>%
ggplot(aes(x = age, y = min_perc)) +
geom_rect(
data = rect_df, inherit.aes = FALSE,
aes(xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax),
alpha = 0.3,
fill = "firebrick1") +
geom_point(color = "red", size = 2.5) +
geom_text_repel(
aes(label = last_name, family = "Roboto Condensed"),
nudge_x = 0.5,
seed = 6) +
scale_y_continuous(
expand = c(0.01, 0),
limits = c(0, 1),
labels = percent_format()) +
scale_x_continuous(
breaks = pretty_breaks(n = 10)) +
labs(
x = "Current Age (As of Nov. 16, 2019)", y = "% of Minutes Played",
title = "<b style ='color:#d00027'>Liverpool FC</b>: Age-Utility Graph (Premier League 2019/2020)",
subtitle = "Up to Nov. 10, 2019 (Matchday 12)",
caption = glue("
Data: transfermarkt.com
Twitter: @R_by_Ryo")) +
theme_bw() +
theme(
text = element_text(family = "Roboto Condensed"),
plot.title = element_text(size = 18),
plot.subtitle = element_text(size = 14),
plot.caption = element_text(size = 12),
axis.title = element_text(size = 16),
axis.text = element_text(size = 14),
panel.grid.minor.x = element_blank()) +
geom_label(
aes(x = 27.5, y = 0.75,
hjust = 0.5,
label = glue("
With a strong core group of players in their prime,
Liverpool are in the lead for the title!
"),
family = "Roboto Condensed"),
size = 3.5)
## set directory with here::here() then specify subfolders
ggsave(filename = here::here("Premier League 2019-2020/output/lfc_age_utility_1920.png"),
height = 6, width = 8)
## add LFC logo
## add_logo function from Thomas Mock
add_logo <- function(plot_path, logo_path, logo_position, logo_scale = 10){
# Requires magick R Package https://github.com/ropensci/magick
# Useful error message for logo position
if (!logo_position %in% c("top right", "top left", "bottom right", "bottom left")) {
stop("Error Message: Uh oh! Logo Position not recognized\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'")
}
# read in raw images
plot <- magick::image_read(plot_path)
logo_raw <- magick::image_read(logo_path)
# get dimensions of plot for scaling
plot_height <- magick::image_info(plot)$height
plot_width <- magick::image_info(plot)$width
# default scale to 1/10th width of plot
# Can change with logo_scale
logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))
# Get width of logo
logo_width <- magick::image_info(logo)$width
logo_height <- magick::image_info(logo)$height
# Set position of logo
# Position starts at 0,0 at top left
# Using 0.01 for 1% - aesthetic padding
if (logo_position == "top right") {
x_pos = plot_width - logo_width - 0.01 * plot_width
y_pos = 0.01 * plot_height
} else if (logo_position == "top left") {
x_pos = 0.01 * plot_width
y_pos = 0.01 * plot_height
} else if (logo_position == "bottom right") {
x_pos = plot_width - logo_width - 0.01 * plot_width
y_pos = plot_height - logo_height - 0.01 * plot_height
} else if (logo_position == "bottom left") {
x_pos = 0.01 * plot_width
y_pos = plot_height - logo_height - 0.01 * plot_height
}
# Compose the actual overlay
magick::image_composite(plot, logo, offset = paste0("+", x_pos, "+", y_pos))
}
lfc_age_utility_1920_logo <- add_logo(
plot_path = here::here("Premier League 2019-2020/output/lfc_age_utility_1920.png"),
logo_path = "https://upload.wikimedia.org/wikipedia/en/thumb/0/0c/Liverpool_FC.svg/800px-Liverpool_FC.svg.png",
logo_position = "top right",
logo_scale = 18)
lfc_age_utility_1920_logo
image_write(image = lfc_age_utility_1920_logo,
path = here::here("Premier League 2019-2020/output/lfc_age_utility_1920_logo.png"))
@Ryo-N7
Copy link
Author

Ryo-N7 commented Nov 16, 2019

lfc_age_utility_1920_logo

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment