20220825-UCL Group Strength.R

# -- Created by Owen Thompson (@OTStats)
# 2022-08-25

# -- Load libraries
library(rvest)
library(polite)
library(tidyverse)
library(worldfootballR)
library(lubridate)
library(data.table)
library(showtext)
library(ggimage)

# -- Text
font_add_google("Lato")
showtext_auto()

# Scrape 538 UCL Predictions
session <- bow("https://projects.fivethirtyeight.com/soccer-predictions/champions-league/")

raw_table <- session %>% 
  scrape() %>% 
  html_table() %>% 
  .[[1]]

names(raw_table) <- raw_table[2,] %>% 
  unlist() %>% unname()

df <- raw_table %>% 
  select(1:3, 
         r16 = 9) %>% 
  filter(!team %in% c("", "team")) %>% 
  mutate(r16 = str_remove(r16, "\\%")) %>% 
  mutate_at(c("spi", "r16"), as.double) %>% 
  mutate(team = str_remove(team, "0 pts")) 

# --- Get team ids from Fotmob
doParallel::registerDoParallel()
dates <- seq(ymd("20220226"), ymd("20220410"), by = "day")
results <- fotmob_get_matches_by_date(date = dates)

raw_lookup <- results %>% 
  select(matches) %>% 
  unnest(matches) %>% 
  unnest(names_sep = "_") %>% 
  distinct(team_name_long = home_longName, 
           team_name = home_name, 
           id = home_id)

# UCL Teams
wip_lookup <- raw_lookup %>% 
  filter(
    team_name %in%
    c("Liverpool", "Ajax", "Napoli", "Rangers", "Atletico Madrid",
    "FC Porto", "Leverkusen", "Club Brugge", "Bayern München", "Barcelona", "Inter",
    "Viktoria Plzen", "Tottenham", "Sporting CP", "Marseille",
    "Frankfurt", "Chelsea", "Milan", "Salzburg", "Dinamo Zagreb",
    "Real Madrid", "RB Leipzig", "Celtic", "Shakhtar Donetsk", "Man City",
    "Dortmund", "Sevilla", "FC København", "PSG", "Benfica", "Juventus", "Maccabi Haifa")
    )
 
# Arrange in same order as UCL groups, R16 %
join <- tibble(team = 
         c("Liverpool", "Ajax", "Napoli", "Rangers", "Atletico Madrid",
           "FC Porto", "Leverkusen", "Club Brugge", "Bayern München", "Barcelona", 
           "Inter", "Viktoria Plzen", "Tottenham", "Sporting CP", "Marseille",
           "Frankfurt", "Chelsea", "Milan", "Salzburg", "Dinamo Zagreb",
           "Real Madrid", "RB Leipzig", "Celtic", "Shakhtar Donetsk", "Man City",
           "Dortmund", "Sevilla", "FC København", "PSG", "Benfica", "Juventus", 
           "Maccabi Haifa")) %>% 
  left_join(wip_lookup, by = c("team" = "team_name")) %>% 
  filter(id != 4057) %>% 
  transmute(image_url = glue::glue("https://images.fotmob.com/image_resources/logo/teamlogo/{id}.png"))

# -- Plot
df %>% 
  arrange(group, desc(r16)) %>% 
  bind_cols(., join) %>% 
  mutate(group = fct_reorder(group, spi, median)) %>% 
  # fix overlap for Atleti and Frankfurt
  mutate(spi = case_when(str_detect(team, "Eintrac") ~ spi -1, 
                         str_detect(team, "Atléti") ~ spi + 1.5,
                         str_detect(team, "RB ") ~ spi - 2, 
                         TRUE ~ spi)) %>% 
  ggplot(aes(x = group, y = spi)) + 
  geom_image(aes(image = image_url), asp = 1.2, 
             position = position_dodge(width = .1)) + 
  scale_x_discrete(position = "top") + 
  scale_y_continuous(breaks = seq(50, 100, by = 10), ) + 
  geom_text(data = df %>% 
              group_by(group) %>% 
              summarize(range = diff(range(spi))), 
            aes(x = group, y = 100, label = range), 
            size = 4) + 
  
  annotate(geom = "text", 
           label = "SPI range\n Diff max vs min SPI", 
           x = "D", y = 98, size = 3, color = "grey50") + 
  annotate(geom = "text", 
           label = "Lowest median SPI", 
           x = "D", y = 50, size = 3, color = "grey50") + 
  annotate(geom = "text", 
           label = "Highest median SPI", 
           x = "C", y = 50, size = 3, color = "grey50") + 
  
  labs(title = "UCL Group Strength 2022-23", 
       subtitle = "Team SPI ratings by UCL group",
       caption = glue::glue("538 SPI ratings as of {Sys.Date()}\nCreated by @OTStats"), 
       x = NULL, 
       y = NULL) + 
  
  ggthemes::theme_fivethirtyeight() + 
  theme(axis.text.x = element_text(size = 12), 
        axis.text.y = element_text(size = 10), 
        plot.title = element_text(size = 30), 
        plot.subtitle = element_text(size = 20), 
        text = element_text(family = "Lato"), 
        panel.grid.major.y = element_blank())
  

ggsave(plot = last_plot(), 
       filename = "20220826-UCL group strength.png", 
       dpi = "retina", 
       width = 12, height = 10)


# -- `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))
  
}

plot_with_logo <- add_logo(plot_path = "20220826-UCL group strength.png",
                           logo_path = glue::glue("https://images.fotmob.com/image_resources/logo/leaguelogo/42.png"),
                           logo_position = "top right",
                           logo_scale = 14)


magick::image_write(plot_with_logo, "20220826-UCL group strength.png")