Players Without Club Contracts

I noticed the variables team_position and team_jersey_number have missing values. We can ascertain the relationship between both columns by counting the NAs and checking if they’re equal.

data %>% 
  select(contains("team")) %>% 
  map_df(~sum(is.na(.)))

## # A tibble: 1 x 2
##   team_position team_jersey_number
##           <int>              <int>
## 1           240                240

Why do certain players have no team_position ?

data %>%
  filter(is.na(team_position)) %>%
  select(
    short_name,
    club,
    nation_position,
    player_positions,
    team_position,
    team_jersey_number,
    value_eur
  ) %>%
  head(10)

## # A tibble: 10 x 7
##    short_name club  nation_position player_positions team_position
##    <chr>      <chr> <chr>           <chr>            <chr>        
##  1 E. Scheti~ Urug~ RCB             CB               <NA>         
##  2 J. Sildero Urug~ RM              CAM, RM          <NA>         
##  3 J. Frenda~ Urug~ LCB             CB, CDM          <NA>         
##  4 S. Ardero  Urug~ LM              CAM, LM, LW      <NA>         
##  5 L. Dálves  Urug~ ST              ST, CF           <NA>         
##  6 S. Mandíq~ Ecua~ RS              ST               <NA>         
##  7 J. Serend~ Urug~ GK              GK               <NA>         
##  8 M. Baldona Urug~ RDM             CDM, CM          <NA>         
##  9 M. Nérez   Urug~ LB              LB, LM           <NA>         
## 10 A. Lunev   Russ~ SUB             GK               <NA>         
## # ... with 2 more variables: team_jersey_number <dbl>, value_eur <dbl>

It seems these players entered the database because they represented their country but aren’t contracted with any clubs. If they are good enough to represent their country, shouldn’t they at least be good enough for some entry-level clubs? As a player-manager in FIFA 20, is this an untapped pool of talent waiting to be exploited?

Let’s explore if this phenomenon is restricted to only certain geographical areas.

library(countrycode)
library(tidytext)

data %>%
  filter(is.na(team_position)) %>%
  mutate(continent = countrycode(club,
                                 origin = "country.name",
                                 destination = "continent")) %>%
  mutate(continent = replace_na(continent, "Europe")) %>%
  add_count(club) %>%
  mutate(club = reorder_within(club, n, continent)) %>%
  ggplot(aes(club, n / n, fill = continent)) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  facet_wrap( ~ continent, scales = "free_y") +
  scale_x_reordered() +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  labs(
    x = "",
    y = "",
    title = "Continents With Highest # Of International Players With No Clubs/Contracts",
    subtitle = "A higher percentage of players come from Africa, Americas and Europe.\nPerhaps these are countries with no well-established soccer leagues?",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
  ) 

Are these players without contracts because overall performance is trailing far behind potential? Let’s analyze it further across position.

library(ggridges)

data %>%
  filter(is.na(team_position)) %>%
  pivot_longer(overall:potential, names_to = "rating", values_to = "values") %>%
  mutate(rating = as_factor(rating)) %>%
  ggplot(aes(values, position, fill = rating)) +
  geom_density_ridges(scale = 1, alpha = 0.5) +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  theme_ridges(center_axis_labels = TRUE) +
  labs(
    x = NULL,
    y = NULL,
    fill = "Score",
    title = "Players Without Contracts: Comparing Overall vs Potential Score Across Positions",
    subtitle = "Not playing up to one's potential seems to be pervasive across all field positions",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
    legend.title = element_text(face = "bold", size = 15)
  ) 

Testing our hypothesis if it is indeed a performance gap that is resulting in these players to be contract-less, can we then expect players with contracts to be playing much closer to their potential?

data %>%
  filter(!is.na(team_position)) %>%
  pivot_longer(overall:potential, names_to = "rating", values_to = "values") %>%
  mutate(rating = as_factor(rating)) %>%
  ggplot(aes(values, position, fill = rating)) +
  geom_density_ridges(scale = 1, alpha = 0.5) +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  theme_ridges(center_axis_labels = TRUE) +
  labs(
    x = NULL,
    y = NULL,
    fill = "Score",
    title = "Players With Contracts: Comparing Overall vs Potential Score Across Positions",
    subtitle = "Ironically, the gap between overall and potential performance is even wider for players with club contracts,\nalbeit with longer right tails. This could also be due to a larger sample size.",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
    legend.title = element_text(face = "bold", size = 15)
  ) 

Another way to compare performance between contracted and non-contracted players would be to use skill sets such as pace, dribbling and shooting that are applicable across all position (excluding Goalkeepers because they have their own unique skill sets such as diving).

labels <-
  c("D" = "Defender",
    "DM" = "Defensive Midfielder",
    "M" = "Midfielder",
    "AM" = "Attacking Midfielder",
    "F" = "Forward",
    "ST" = "Striker")

data %>%
  mutate(contracted = case_when(is.na(team_position) ~ "No",
                                TRUE ~ "Yes")) %>%
  pivot_longer(pace:physic, names_to = "skills", values_to = "values") %>%
  filter(!position == "GK") %>%
  mutate(skills = reorder_within(skills, values, position)) %>%
  ggplot(aes(values, skills, fill = contracted)) +
  geom_boxplot() +
  geom_text(
    data = . %>%
      group_by(position, skills) %>%
      mutate(percentile = values > quantile(values, 0.99999, na.rm = TRUE)) %>%
      filter(percentile == 1),
    aes(label = paste(short_name, "\n", str_wrap(club, width = 15), sep = ""), colour = position),
    size = 3,
    check_overlap = TRUE,
    fontface = "bold",
    vjust = "inward", hjust = "inward",
    show.legend = F
  ) +
  facet_wrap( ~ position, scales = "free_y", labeller = as_labeller(labels)) +
  scale_y_reordered() +
  scale_colour_fish_d(option = "Antennarius_commerson") +
  scale_fill_fish_d(option = "Hypsypops_rubicundus") +
  labs(
    x = "Values",
    y = "Skills",
    fill = "Under Contract?",
    title = "Players With And Without Contracts In FIFA 20 - How Do They Compare?",
    subtitle = "Using traits like dribbling, passing and shooting, players with only international appearances and\nno club contracts don't appear to be less skilled.\nHowever there are significantly more outliers among players with contracts.\nThe extreme outliers and their clubs are highlighted.",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
    legend.title = element_text(face = "bold", size = 15),
    legend.position = "top"
  ) 

Using boxplots to identify medians, variance and outliers, I conclude that there are other reasons other than overall score and generic skills driving the non-contractual state of these players.

Take for example Defenders - we want a higher defending score and the median for non-contract players is higher than players with contracts. Similarly, the median for passing scores is higher for non-contract players, and the same can be said for shooting scores for Forwards and Strikers.

One other thing you might have observed is that there are significantly more outliers for contracted players. The crème de la crème, so to speak.

What Makes A Player Stand Out From The Crowd?

Two columns, player_tags and player_traits, contain text descriptions of certain players’ characteristics e.g. Playmaker, Acrobat, etc, and popular traits e.g. Crowd Favourite, Beat Offside Trap, Argues with Officials, etc.

data %>%
  select(short_name, club, position, player_tags, player_traits) %>% 
  na.omit() %>% 
  sample_n(10)

## # A tibble: 10 x 5
##    short_name   club            position player_tags      player_traits         
##    <chr>        <chr>           <fct>    <chr>            <chr>                 
##  1 D. Djigla    Chamois Niorta~ M        #Speedster       Early Crosser         
##  2 T. Buhagiar  Sydney FC       AM       #Speedster, #Ac~ Early Crosser         
##  3 A. Ibargüen  Club América    M        #Speedster, #Ac~ Diver, Selfish, Crowd~
##  4 B. Boutobba  Montpellier HSC M        #Acrobat         Injury Free, Selfish,~
##  5 K. Tierney   Arsenal         D        #Engine          Early Crosser         
##  6 N. Maksimov~ Napoli          D        #Strength        Injury Prone, Long Pa~
##  7 S. Mendoza   Amiens SC       M        #Speedster       Argues with Officials~
##  8 N. Dovedan   1. FC Nürnberg  M        #Acrobat         Diver, Finesse Shot, ~
##  9 B. McKay     Swansea City    M        #Acrobat         Selfish, Early Crosse~
## 10 S. Kutschke  FC Ingolstadt ~ ST       #Aerial Threat,~ Diver, Long Passer (C~

We can visualize the relationship between tags and traits using a network graph. First we have to wrangle our data into a long format using separate and pivot_longer, remove the tag “CPU AI Only”, and use pairwise_cor to find pairwise correlation across the words as that will form the basis of our network graph.

library(widyr)
library(igraph)
library(ggraph)

corr <- data %>%
  select(short_name, club, position, player_tags, player_traits) %>%
  separate(player_tags, paste("tag", 1:10, sep = ""), sep = ", ") %>%
  separate(player_traits, paste("trait", 1:8, sep = ""), sep = ", ") %>% 
  pivot_longer(tag1:trait8, names_to = "tag", values_to = "description", values_drop_na = T) %>%
  mutate(description = str_replace(description, "#", "")) %>% 
  filter(!str_detect(description, "CPU AI Only")) %>% 
  group_by(description) %>% 
  filter(n() > 100) %>% 
  pairwise_cor(description, short_name, sort = TRUE)

corr

## # A tibble: 552 x 3
##    item1                    item2                    correlation
##    <chr>                    <chr>                          <dbl>
##  1 Crowd Favourite          Selfish                        0.388
##  2 Selfish                  Crowd Favourite                0.388
##  3 Speedster                Early Crosser                  0.288
##  4 Early Crosser            Speedster                      0.288
##  5 Speedster                Acrobat                        0.262
##  6 Acrobat                  Speedster                      0.262
##  7 Aerial Threat            Strength                       0.252
##  8 Strength                 Aerial Threat                  0.252
##  9 Avoids Using Weaker Foot Giant Throw-in                 0.223
## 10 Giant Throw-in           Avoids Using Weaker Foot       0.223
## # ... with 542 more rows

Tidy Text Mining with R has a great tutorial on how to construct network graphs.

The igraph package has many powerful functions for manipulating and analyzing networks. One way to create an igraph object from tidy data is the graph_from_data_frame() function, which takes a data frame of edges with columns for “from”, “to”, and edge attributes.

set.seed(2020)

corr %>%
  filter(correlation > .03) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(
    aes(label = name),
    repel = TRUE,
    fontface = "bold",
    vjust = -1,
    hjust = -0.2
  ) +
  labs(
    title = "Visualizing Correlation Of Players' Tags and Traits With A Network Graph",
    subtitle = "Crowd favourites tend to be selfish acrobats that excel at beating offside traps and arguing with officials\nDoes any particular player come to mind?",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
    theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
  ) 

Do Soccer Players Age Like Wine?

To investigate a player’s score as the years fly by, we bucket age into two categories - before and after twenty five (mean age is 25.3 years), and use ggscatmat() against variables such as value_eur, wage_eur, overall and potential. This gives a scatterplot matrix with density plots on the diagonal and correlation printed in the upper triangle.

library(GGally)

data %>%
  mutate(
    age_segment = case_when(
      age < 23 ~ "Age<23",
      between(age, 23, 25) ~ "Age 23-25",
      between(age, 26, 29) ~ "Age 26-29",
      TRUE ~ "Age>29"
    )
  ) %>%
  select(age, value_eur, wage_eur, overall, potential, age_segment) %>%
  ggscatmat(columns = 1:5, color = "age_segment") +
  scale_color_fish_d(option = "Antennarius_commerson") +
  labs(title = "Players Aged <23 +ve Correlated With Higher Value/Wages/Overall Score",
       subtitle = "Beyond 29 years of age, we start to see negative correlation",
       color = "Age Segment",
       caption = "Source: FIFA 20 Complete Player Data Set") +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    legend.title = element_text(face = "bold")
  ) 

There is some positive correlation observed between players aged 23 and younger and their associated value_eur, wage_eur and overall score. Conversely, beyond 29 years of age, we observe some negative correlation too between age and value_eur, wage_eur and overall score.

This isn’t too surprising as the average retirement age of a football player is said to be 35 years old, according to the Professional Footballers’ Association.

Bargain Hunting At Clubs

Information about the biggest and richest clubs are easily available online and buying a star player from any of those clubs would easily cost a fortune. What I reckon could be more interesting is identifying clubs by a metric I call pot_per_dollar: A player’s potential score divided by his current value_eur. Summing all of the players, we get the club’s pot_per_dollar.

Clubs with the highest pot_per_dollar are great for bargain hunting because there is a good chance to find high potential players with a cheap asking price that you could snap up. We can further segment our data by continent to address geographical-related transfer constraints, if any.

#adding continents
geography <- data %>%
  mutate(continent = countrycode(nationality,
                                 origin = "country.name",
                                 destination = "continent")) %>%
  #place Brexit countries back into Europe
  mutate(continent = replace_na(continent, "Europe"))

geography %>% 
  select(short_name, club, nationality, continent) %>% 
  sample_n(10)

## # A tibble: 10 x 4
##    short_name    club                 nationality continent
##    <chr>         <chr>                <chr>       <chr>    
##  1 D. Parrett    Stevenage            England     Europe   
##  2 L. McGee      Portsmouth           England     Europe   
##  3 Ignasi Miquel Girona FC            Spain       Europe   
##  4 J. Rollinson  Stevenage            England     Europe   
##  5 R. Uehara     Júbilo Iwata         Japan       Asia     
##  6 D. Cvitanich  Racing Club          Argentina   Americas 
##  7 Zheng Dalun   Tianjin Quanjian FC  China PR    Asia     
##  8 O. Oularé     Standard de Liège    Belgium     Europe   
##  9 W. Marinus    FC Emmen             Netherlands Europe   
## 10 I. Sissoko    RC Strasbourg Alsace France      Europe

#identify the clubs with the highest potential per wage dollar paid
list <- geography %>%
  #remove players with no clubs and no wages paid, and some players with 0 value
  filter(!is.na(team_position),
         value_eur > 0) %>%
  select(short_name, club, potential, value_eur, nationality, continent) %>% 
  #each player's potential per dollar of wages paid. Higher is better.
  mutate(pot_per_dollar = potential / value_eur) %>%
  group_by(club) %>% 
  summarise(total_pot = sum(pot_per_dollar)) %>% 
  arrange(desc(total_pot)) %>% 
  head(20)

geography %>%
  #filter data set for clubs in list
  filter(club %in% list$club,
         value_eur > 0) %>%
  select(short_name, club, potential, value_eur, nationality, continent) %>%
  mutate(
    pot_per_dollar = potential / value_eur,
    club = fct_reorder(club, pot_per_dollar, .fun = sum)
  ) %>%
  ggplot(aes(club, pot_per_dollar)) +
  geom_col(aes(fill = continent)) +
  coord_flip() +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  labs(
    x = "Club",
    y = "Club's Total Potential Per Value",
    fill = "Continent",
    title = "Bargain Hunting: Clubs With High Potential Players At Lowest Prices",
    subtitle = "Sorted by this metric, we can see promising clubs can be found in Asia and Europe leagues.",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
    legend.title = element_text(face = "bold")
  ) 

Principal Components Analysis

tidymodels allows for seamless and fuss-free Principal Components Analysis (PCA) implementation, and this wide data set is great with nearly 40 variables.

As the webpage reference for recipes::step_pca() describes it:

Principal component analysis (PCA) is a transformation of a group of variables that produces a new set of artificial features or components. These components are designed to capture the maximum amount of information (i.e. variance) in the original variables. Also, the components are statistically independent from one another. This means that they can be used to combat large inter-variables correlations in a data set.

We first load the tidymodels meta package, then filter players with no teams and all goalkeepers (they have a separate skill set), followed by selecting of columns. Let’s also segment age per its quantiles and use it as variables for PCA.

library(skimr)

geography$age %>% 
  skim()

Variable type: numeric

library(tidymodels)

pca_rec <- geography %>%
  filter(!is.na(team_jersey_number), !position == "GK") %>%
  mutate(age_segment = case_when(
      age < 23 ~ "Age<23",
      between(age, 23, 25) ~ "Age 23-25",
      between(age, 26, 29) ~ "Age 26-29",
      TRUE ~ "Age>29")) %>%
  select(
    #identifiers
    sofifa_id, short_name, long_name, club, value_eur,
    #categorical
    preferred_foot, position, continent, age_segment,
    #numeric
    overall:potential, team_jersey_number, skill_moves,
    pace:physic, attacking_crossing:defending_sliding_tackle
  ) %>%
  recipe( ~ .) %>%
  update_role(sofifa_id, short_name, long_name, club, value_eur, new_role = "id") %>%
  step_dummy(preferred_foot, position, continent, age_segment) %>%
  step_normalize(all_predictors()) %>%
  step_pca(all_predictors())

Note that we did not define an outcome/response in our recipe() function, so this is unsupervised learning. Our recipe contains:

• update_role() is used to indicate variables that should not be included when executing pre-processing with prep() later on, and that these variables are only included as identifiers.
• Because PCA only takes in numeric data, we convert our categorical data to numbers with step_dummy(), which converts nominal data (e.g. character or factors) into one or more numeric binary model terms for the levels of the original data.
• PCA is sensitive to outliers so step_normalize() essentially scales and centers all numeric variables to have a standard deviation of one and a mean of zero.
• Finally, step_pca() implements Principal Component Analysis.

The recipe only begins executing the pre-processing steps after we run prep().

pca_prep <- pca_rec %>% 
  prep()

pca_prep

## Data Recipe
## 
## Inputs:
## 
##       role #variables
##         id          5
##  predictor         43
## 
## Training data contained 16042 data points and no missing data.
## 
## Operations:
## 
## Dummy variables from preferred_foot, position, continent, age_segment [trained]
## Centering and scaling for overall, potential, ... [trained]
## PCA extraction with overall, potential, ... [trained]

We can use tidy() to extract our PCA results in a convenient tidy format which we can then subsequently visualize.

#tidy(df,3) lets us extract the third recipe step i.e. step_pca
tidied_pca <- tidy(pca_prep, 3)

tidied_pca %>%
  filter(component %in% paste0("PC", 1:4)) %>%
  mutate(component = fct_inorder(component)) %>%
  ggplot(aes(value, terms, fill = terms)) +
  geom_col(show.legend = FALSE) +
  facet_wrap( ~ component, nrow = 1) +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  labs(
    x = "Value",
    y = "Traits",
    fill = "",
    title = "PCA: A High-Level Overview Of The First Four Features Created",
    subtitle = NULL,
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15)
  ) 

Let’s dive deeper into the top 15 traits that defines each of these four features.

tidied_pca %>%
  filter(component %in% paste0("PC", 1:4)) %>%
  group_by(component) %>%
  top_n(20, abs(value)) %>%
  ungroup() %>%
  mutate(terms = reorder_within(terms, abs(value), component)) %>%
  ggplot(aes(abs(value), terms, fill = value > 0)) +
  geom_col() +
  facet_wrap(~component, scales = "free_y") +
  scale_y_reordered() +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  labs(
    x = "Absolute Value of Contribution",
    y = NULL, 
    fill = "Positive?",
    title = "PCA: Visualizing The First Four Features (PC1-PC4) Created",
    subtitle = "Interpretation: As PC1 gets more negative, it captures offensive midfielder/playmaker traits;\nPC3: Hallmarks of a classic striker (strength, finishing, shooting) vs Movement/Agility traits",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
    legend.title = element_text(face = "bold")
  ) 

Below is my interpretation for PC1-PC4:

• PC1: Negative indicates offensive midfielder / playmaker traits
• PC2: Negative indicates defender / defensive midfielder traits
• PC3: Striker traits (+ve) versus defenders with high movement-related traits (-ve)
• PC4: Passing-related traits (+ve) versus finesse-related traits (-ve)

Now let’s assess how accurate our PCA features are by visualizing the most valuable players against our features.

#Getting our top 50 valuable players ex GKs
valuable <- geography %>%
  filter(!is.na(team_jersey_number),
         !position == "GK") %>%
  arrange(desc(value_eur)) %>% 
  select(long_name) %>% 
  slice(1:100)

juice(pca_prep) %>%
  filter(long_name %in% valuable$long_name) %>%
  left_join(geography %>% select(sofifa_id, position)) %>% 
  ggplot(aes(PC1, PC3, label = paste(
    short_name, " ", "(", str_wrap(club, width = 20), ")", "\n", "EUR", value_eur/1000000, "m", sep = ""))) +
  geom_point(aes(color = position), alpha = 0.75, size = 5) +
  geom_text(
    check_overlap = TRUE,
    vjust = "inward",
    hjust = "inward",
    size = 4,
    fontface = "bold") +
  scale_colour_fish_d(option = "Hypsypops_rubicundus") +
  scale_x_continuous() +
  labs(
    x = "PC1",
    y = "PC3",
    color = "Position",
    title = "FIFA 20: Top 100 Most Valuable Soccer Players (ex GKs) Mapped Against PC1 and PC3",
    subtitle = "Offensive midfielders/playmakers are towards the left, defenders are mapped towards the right,\nStrikers can be found towards the top, while defensive roles with high movement scores are towards the bottom.",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    legend.title = element_text(face = "bold"),
    legend.position = "top"
  ) 

To my knowledge it looks like the positions are mapped out fairly accurately. Well-known players such as Messi, Ronaldo and Neymar have dazzled the world with their dribbling and shooting - and have been aptly mapped towards the left most of this chart.

Revisiting our bargain hunting theme, let’s run PCA on the top 100 players with the highest pot_per_dollar.

pot_dollar <- geography %>% 
  filter(!is.na(team_jersey_number),
         !position == "GK",
         value_eur > 0) %>% 
  mutate(pot_per_dollar = potential / value_eur) %>% 
  arrange(desc(pot_per_dollar)) %>% 
  select(long_name, pot_per_dollar) %>% 
  slice(1:100)

juice(pca_prep) %>%
  filter(long_name %in% pot_dollar$long_name) %>%
  left_join(geography %>% select(sofifa_id, position)) %>% 
  ggplot(aes(PC1, PC3, label = paste(
    short_name, " ", "(", str_wrap(club, width = 20), ")", "\n", "EUR", value_eur/1000, "k", sep = ""))) +
  geom_point(aes(color = position), alpha = 0.75, size = 5) +
  geom_text(
    check_overlap = TRUE,
    hjust = "left",
    size = 4,
    fontface = "bold"
  ) +
  scale_colour_fish_d(option = "Hypsypops_rubicundus") +
  labs(
    x = "PC1",
    y = "PC3",
    color = "Position",
    title = "FIFA 20: Top 100 Soccer Players (ex GKs) With The Highest Potential Per Value Dollar",
    subtitle = "Note: x-axis has shifted significantly from the previous chart, with PC1 indicating a selection bias towards players with defensive traits.",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    legend.title = element_text(face = "bold"),
    legend.position = "top"
  ) 

First and foremost, what’s interesting about this chart is the x-axis. Our previous Top 50 Most Valuable Players chart had a strong bias towards negative PC1 values (players with offensive traits), while our current chart has a strong bias towards positive PC1 values(players with defensive traits) and we consequently see significantly more defenders showing up.

Finally, recall PC2 was the feature created that was tilted towards defender / defensive midfielder traits. Let’s pick four of the defenders located furthest to the right and map PC2 components against their strongest traits.

library(gghighlight)

PC2 <- tidied_pca %>%
  filter(component == "PC2") %>%
  top_n(15, abs(value))

geography %>%
  filter(str_detect(short_name, "T. French|Y. Fujita|A. Bennett|J. McCombe")) %>%
  select(
    short_name, club, player_positions, position,
    overall:potential, pace:physic,attacking_crossing:defending_sliding_tackle
  ) %>%
  pivot_longer(
    c(overall:potential, pace:physic, attacking_crossing:defending_sliding_tackle),
    names_to = "traits",
    values_to = "scores"
  ) %>%
  group_by(short_name) %>% 
  top_n(20, scores) %>% 
  ungroup() %>% 
  ggplot(aes(reorder_within(traits, scores, short_name), scores)) +
  geom_col(aes(fill = short_name), show.legend = F) +
  gghighlight(traits %in% PC2$terms, calculate_per_facet = T) +
  coord_flip() +
  facet_wrap(~ short_name, scales = "free_y") +
  scale_x_reordered() +
  scale_fill_fish_d(option = "Antennarius_commerson") +
  labs(
    x = "Traits",
    y = "Scores",
    title = "How Does PC2 Components Map Onto These Four Defenders' Top Traits?",
    subtitle = "Not surprisingly, the top PC2 components are featured strongly across all four players' traits",
    caption = "Source: FIFA 20 Complete Player Data Set"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.subtitle = element_text(size = 17),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15),
  ) 

I think there are plenty of questions that warrant further investigation here, and personally this blog post really made me appreciate PCA and the intuition it brings. It’s been one of my long-time visualization goals to use network graphs and ridgeline plots, and its great to be able to add them to my EDA toolkit. A big shout-out to Wen Hao for spotting some errors in my initial charts!