R Notebook

Last week, the new season of the Chinese Super League began. Over the past few months, this league has been getting a lot of attention due to its lavish spending on players from top leagues to fill out the permitted foreigner places on teams.

I thought it would be a nice exercise in visualing nested data to see just how much of the leagues value is taken up by the relatively small number of foreign players.

To start, we need to get a table of every team and the links to their squads from wikipedia and transfermarkt. The table also has loads of extra information I won’t use here but is nice to have. We’ll do this using the rvest scraping package and the tidyverse to try and keep the code as neat as possible.

#libraries
library(magrittr)
library(rvest)
library(dplyr)
#links for information to scrape
league_wiki <- "https://en.wikipedia.org/wiki/2017_Chinese_Super_League"
league_trmarkt <- "http://www.transfermarkt.com/chinese-super-league/startseite/wettbewerb/CSL"
#function to scrape from the links
scrape_func <- function(wiki, trmarkt){
  #get the wikipedia information
  wiki_read <- read_html(wiki)
    wiki_table <- wiki_read %>%
      html_nodes("#mw-content-text > table:nth-child(17)") %>%
        html_table(fill = TRUE) %>% 
          data.frame() %>%
            arrange(Team)
    
    #get links to each clubs wikipedia page
    wiki_club_links <- wiki_read %>%
      html_nodes("#mw-content-text > table:nth-child(17) > tr > td:nth-child(1) > a") %>%
        html_attr("href") %>%
          sort()
    wiki_table <- mutate(wiki_table, wiki_link = paste0("https://en.wikipedia.org", wiki_club_links)) 
    
  #get the transfermarkt information  
  trmarkt_read <- read_html(trmarkt)
    trmarkt_table <- trmarkt_read %>%
      html_nodes("#yw1 > table") %>%
        html_table(fill = TRUE) %>%
          data.frame() %>%
            filter(nchar(name) > 2) %>%
                arrange(name)
  trmarkt_table[trmarkt_table == ""] <- NA
  #get links to each clubs transfermarkt page
  trmarkt_club_links <- trmarkt_read %>%
    html_nodes(".hide-for-pad .vereinprofil_tooltip") %>%
      html_attr("href")
  trmarkt_table <- mutate(trmarkt_table, trmakrt_link = paste0("http://www.transfermarkt.com", trmarkt_club_links)) 
  #mash everything together
  wiki_table$Team <- trmarkt_table$Club.s..1
    names(trmarkt_table)[which(names(trmarkt_table) == "Club.s..1")] <- "Team"
  
  table <- merge(wiki_table, trmarkt_table, by = "Team")
  
  return(table)
}
table <- scrape_func(league_wiki, league_trmarkt) %>%
  select_if(colSums(!is.na(.)) > 0)

I wanted to have some colour parameter for each team to plot. The teams kits gives a nice simple way to scrape this. We’ll need the png package to work with the png pictures of kits, as well as the data.table and stringr packages to manipulate data.

I also took the top function to check if a string is a valid colour from this answer on stackoverflow.

#libraries
library(png)
library(data.table)
library(stringr)

#Josh O'Brien's stackoverflow answer (see above)
#checks if a string is a valid colour
areColors <- function(x) {
    sapply(x, function(X) {
        tryCatch(is.matrix(col2rgb(X)), 
                 error = function(e) FALSE)
    })
}

#function to get the colour of each teams shirts from their wikipedia page
shirt.col_func <- function(link){
  #grab the background colour for the model pictures of kits
  bg_col <- read_html(link) %>%
    html_nodes("td:nth-child(1) > div > div:nth-child(1) > div:nth-child(3)") %>%
    str_extract("#......")
  #for some, no background is listed. We'll use white instead to make the next steps work
  if(is.na(bg_col)){bg_col <- "#ffffff"}

  #most kits have a 'white' background on which colour is overlayed
  #if a background is lsited as white, we ignore it and use the overlay instead
  if(areColors(bg_col) && tolower(bg_col) != "#ffffff"){kit_col <- bg_col}else{
  
  #find and download the png picture of the kit overlay
  kit_link <- paste0("https:", read_html(link) %>%
    html_nodes("td:nth-child(1) > div > div:nth-child(1) > div:nth-child(3) > img") %>%
      html_attr('src'))
  
  temp <- tempfile()
  download.file(kit_link, temp, mode="wb", quiet = TRUE)
  #once read we need to find the colour of every pixel on these overlays
  kit_pic <- readPNG(temp) %>%
    melt() %>%
      reshape(timevar = "Var3",
              idvar = c("Var1", "Var2"),
              direction = "wide")
  #if there is an alpha channel (value.4), remove all these pixels
  if(names(kit_pic)[ncol(kit_pic)] == "value.4"){kit_pic <- filter(kit_pic, value.4 > 0)}
  kit_pic$Var1 <- rgb(kit_pic[,3:5])
  
  #sum the pixels by colour and choose the most frequent
  #this is actually a little biased towards white, which works nicely given our ignoring of white backgrounds above
  kit_cols <- data.frame(table(kit_pic$Var1))
  kit_col <- as.character(kit_cols$Var1[which.max(kit_cols$Freq)])
  }
  return(kit_col)
}

#run the function and mutate a column for the kit colour to each row
table$kit_colour <- unlist(lapply(table$wiki_link, shirt.col_func))