\n## 1 India 2 0 0 13 0\n## 2 Palestine 1 0 0 4 0\n## 3 Vietnam 1 0 0 1 0\n```\n\nAs you can see Japan has never lost or drawn against India, Palestine, or Vietnam so in the data there wouldn't have been any rows with \"Loss\" in the results column. With the function I created I was able to impute results that didn't exist and fill them in with 0s!\n\nLet's check Japan's performance against our main rivals in the Asian Cup. Here I make the tables look a lot nicer with the options in the `kable` and `kableExtra` packages.\n\n\n```r\nresults_jp_asia %>% \n japan_versus(opponent %in% c(\"Iran\", \"Korea Republic\", \"Saudi Arabia\"),\n tournament == \"AFC Asian Cup\") %>% \n knitr::kable(format = \"html\",\n caption = \"Japan vs. Historic Rivals in the Asian Cup\") %>% \n kableExtra::kable_styling(full_width = FALSE) %>% \n kableExtra::add_header_above(c(\" \", \"Result\" = 3, \"Goals\" = 2))\n```\n\n\nJapan vs. Historic Rivals in the Asian Cup\n \n\n | \nResult | \nGoals | \n
\n \n | opponent | \n Win | \n Draw | \n Loss | \n Goals For | \n Goals Against | \n
\n \n\n \n | Iran | \n 1 | \n 2 | \n 0 | \n 1 | \n 0 | \n
\n \n | Korea Republic | \n 0 | \n 2 | \n 1 | \n 2 | \n 4 | \n
\n \n | Saudi Arabia | \n 4 | \n 0 | \n 1 | \n 13 | \n 4 | \n
\n\n
\n\nNow let's take a look at how Japan have historically played against the other teams in Group F of this year's Asian Cup.\n\n\n```r\nresults_jp_asia %>% \n japan_versus(opponent %in% c(\"Oman\", \"Uzbekistan\", \"Turkmenistan\")) %>% \n knitr::kable(format = \"html\",\n caption = \"Japan's Record vs. Group F Teams\") %>% \n kableExtra::kable_styling(full_width = FALSE) %>% \n kableExtra::add_header_above(c(\" \", \"Result\" = 3, \"Goals\" = 2))\n```\n\n\nJapan's Record vs. Group F Teams\n \n\n | \nResult | \nGoals | \n
\n \n | opponent | \n Win | \n Draw | \n Loss | \n Goals For | \n Goals Against | \n
\n \n\n \n | Oman | \n 8 | \n 3 | \n 0 | \n 19 | \n 4 | \n
\n \n | Uzbekistan | \n 6 | \n 3 | \n 1 | \n 28 | \n 9 | \n
\n\n
\n\nWe see no rows here for Turkmenistan. This is due to the fact that until just this past week Japan had **never** played against them in a friendly or competitive game!\n\n# Conclusion\n\nAlthough Japan's first game was quite horrible I'm hoping it'll wake the players and coaches out of their complacency and not underestimate our opponents in the next two games. \n\nJapan \n\nSouth Korea and Iran\n\nthankfully south korea should be on the other side of the bracket and we would also only meet Iran in the semifinals (provided both teams finish top of their respective groups)\n\nJapan could meet Australia in the Quarters but without Aaron Mooy they're a much weaker side as shown in their abject loss to Jordan in their opening match.\n\neven with losing new star Nakajima, the fact that we can replace him with a player of the calibre of Takashi Inui and Hannover regular, Genki Haraguchi, stepping up from the bench shows how much Japanese football has progressed these past 25 years.\n\nIt's a changing of the guard for Japan but we've got quality players in Europe as well as some depth too with more young Japanese players headed to Europe from a young age\n\nIt was quite awe-inspiring seeing how the number of Japanese players playing for foreign clubs have been steadily increasing since the 1988 Asian Cup squad. Maybe that could be another idea for a visualization?\n\nthis tournament should be a first stepping stone for this new generation of players to make a big impact for the next world cup in 2022 so keep your eye out for this bunch of players!\n"
},
{
"path": "Bundesliga 2018-2019/player_goal_contribution_matrix.Rmd",
"content": "---\ntitle: \"Bundesliga\"\nauthor: \"RN7\"\ndate: \"5/24/2019\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, ggforce,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n\n# Bundesliga\n\n## webscrape soccerway\n\n```{r}\nurl <- \"https://us.soccerway.com/national/germany/bundesliga/20182019/regular-season/r47657/\"\n\nsession <- bow(url)\n\nteam_links <- scrape(session) %>% \n html_nodes(\"#page_competition_1_block_competition_tables_7_block_competition_league_table_1_table .large-link a\") %>% \n html_attr(\"href\")\n\nteam_links_df <- team_links %>% \n enframe(name = NULL) %>% \n separate(value, c(NA, NA, NA, \"team_name\", \"team_num\"), sep = \"/\") %>% \n mutate(link = glue(\"\n https://us.soccerway.com/teams/germany/{team_name}/{team_num}/squad/\"),\n stat_link = glue(\"{link %>% str_replace('squad', 'statistics')}\"))\n\n# for each team link:\n\nplayer_name_info <- function(session) {\n \n player_name_info <- scrape(session) %>% \n html_nodes(\"#page_team_1_block_team_squad_3-table .name.large-link\") %>% \n html_text()\n}\n\nnum_goals_info <- function(session) {\n\n num_goals_info <- scrape(session) %>% \n html_nodes(\".goals\") %>% \n html_text()\n \n num_goals_info_clean <- num_goals_info[-1]\n}\n\nnum_assists_info <- function(session) {\n\n num_assists_info <- scrape(session) %>% \n html_nodes(\".assists\") %>% \n html_text()\n \n num_assists_info_clean <- num_assists_info[-1]\n}\n\nteam_goals_info <- function(session) {\n team_goals_info <- scrape(session) %>% \n html_nodes(\"tr.first:nth-child(6) > td:nth-child(2)\") %>% \n html_text()\n}\n\n# BIG FUNCTION\nbundesliga_stats_info <- function(link, statlink) {\n \n session <- bow(link)\n session2 <- bow(statlink)\n \n player_name <- player_name_info(session = session)\n\n num_goals <- num_goals_info(session = session)\n\n num_assists <- num_assists_info(session = session)\n \n team_goals <- team_goals_info(session = session2)\n \n resultados <- list(player_name, num_goals, num_assists, team_goals)\n col_names <- c(\"name\", \"goals\", \"assists\", \"team_goals\") \n \n bundesliga_stats <- resultados %>% \n reduce(cbind) %>% \n as_tibble() %>% \n set_names(col_names) \n \n}\n```\n\n### all at once\n\n```{r}\n# ALL 18 TEAMS AT ONCE, WILL TAKE A WHILE:\nbundesliga_goal_contribution_df_ALL <- map2(.x = team_links_df$link,\n .y = team_links_df$stat_link,\n ~ bundesliga_stats_info(link = .x, statlink = .y))\n\nbundesliga_goal_contribution_df <- bundesliga_goal_contribution_df_ALL %>% \n set_names(team_links_df$team_name) %>% \n bind_rows(.id = \"team_name\")\n\n## save\nsaveRDS(bundesliga_goal_contribution_df, file = glue(\"{here::here()}/data/bundesliga_goal_contrib_df_soccerway.RDS\"))\n```\n\n## clean\n\n```{r}\nbundesliga_goal_contribution_clean_df <- bundesliga_goal_contribution_df %>% \n mutate_at(.vars = c(\"goals\", \"assists\"), \n ~str_replace(., \"-\", \"0\") %>% as.numeric) %>% \n mutate(team = team_name %>% str_replace_all(., \"-\", \" \") %>% str_to_title,\n total_goals = as.numeric(team_goals)) %>% \n group_by(team) %>% \n mutate(total_assists = sum(assists),\n goal_contrib = goals/total_goals,\n assist_contrib = assists/total_goals) %>% \n ungroup() %>% \n select(-team_name, -team_goals)\n\n## save\nsaveRDS(bundesliga_goal_contribution_clean_df, \n file = glue(\"{here::here()}/data/bundesliga_goal_contrib_clean_df.RDS\"))\nbundesliga_goal_contribution_clean_df <- readRDS(file = glue(\"{here::here()}/data/bundesliga_goal_contrib_clean_df.RDS\"))\n```\n\n## plot\n\n```{r fig.width = 10, fig.height = 8} \n## Description text\ndesc_hazard <- \"Hazard FC: With 16 goals and 15 assists Eden Hazard has been involved in the most goals for a team this season.\"\ndesc_vardymurray <- \"Scoring 37.5% and 37.1% of their team's goals, Jamie Vardy and Glen Murray have proven to be talismans for their team yet again!\"\ndesc_fraser <- \"Another fantastic season from Ryan Fraser with 7 goals and 14 assists (one behind league-leader Hazard)\"\n\n## PLOT!\nbundesliga_goal_contribution_clean_df %>% \n ggplot(aes(assist_contrib, goal_contrib)) +\n geom_point(data = bundesliga_goal_contribution_clean_df %>%\n filter(goal_contrib < 0.225 | assist_contrib < 0.125),\n color = \"grey20\", size = 4, alpha = 0.2) +\n geom_point(data = bundesliga_goal_contribution_clean_df %>%\n filter(goal_contrib > 0.225 | assist_contrib > 0.125),\n color = \"red\", size = 4) +\n geom_hline(yintercept = 0.225, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 0.125, color = \"grey20\", alpha = 0.4) +\n geom_text_repel(data = bundesliga_goal_contribution_clean_df %>%\n filter(goal_contrib > 0.225 | assist_contrib > 0.125),\n aes(label = name, family = \"Roboto Condensed\", fontface = \"bold\"), \n seed = 15, size = 5, \n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5) +\n # geom_mark_circle(aes(filter = name == \"E. Hazard\", label = \"Eden Hazard\",\n # description = desc_hazard), \n # label.family = \"Roboto Condensed\", label.fontsize = c(14, 10)) +\n # geom_mark_hull(aes(filter = name %in% c(\"G. Murray\", \"J. Vardy\"), label = \"Vardy & Murray\",\n # description = desc_vardymurray),\n # label.buffer = unit(20, \"mm\"), label.fontsize = c(14, 10),\n # label.family = \"Roboto Condensed\") +\n # geom_mark_circle(aes(filter = name == \"R. Fraser\", label = \"Ryan Fraser\",\n # description = desc_fraser),\n # label.buffer = unit(9.8, \"mm\"), label.fontsize = c(14, 10),\n # label.family = \"Roboto Condensed\") +\n scale_x_continuous(labels = percent_format(accuracy = 1),\n breaks = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3),\n limits = c(0, 0.225)) +\n scale_y_continuous(labels = percent_format(accuracy = 1),\n breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5),\n limits = c(0, 0.4)) +\n labs(title = \"Goal Contribution Matrix: Bundesliga (2018-2019 Season)\",\n subtitle = \"Team Goal Involvement as Percentage of Total Club Goals and/or Assists.\",\n caption = glue(\"\n Data: soccerway.com\n By: @R_by_Ryo\"),\n x = \"Percentage of Club Goals Assisted\",\n y = \"Percentage of Club Goals Scored\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n title = element_text(size = 18),\n plot.subtitle = element_text(size = 16),\n plot.caption = element_text(size = 10),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12),\n panel.grid.minor.x = element_blank()) -> bundesliga_goal_contribution_matrix\n\nbundesliga_goal_contribution_matrix\n```\n\n## save\n\n```{r}\nggsave(plot = bundesliga_goal_contribution_matrix, \n \"../Bundesliga 2018-2019/output/goal_contribution_matrix_plot_bundesliga.png\",\n height = 9, width = 11)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = \"../Bundesliga 2018-2019/output/goal_contribution_matrix_plot_bundesliga.png\",\n logo_path = \"https://upload.wikimedia.org/wikipedia/en/d/df/Bundesliga_logo_%282017%29.svg\",\n logo_position = \"top right\",\n logo_scale = 13)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n \"../Bundesliga 2018-2019/output/goal_contribution_matrix_plot_logo_bundesliga.png\")\n```\n"
},
{
"path": "Bundesliga 2019-2020/buli_age_utility.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"5/15/2020\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n\n\n# age-utility\n\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, rvest, \n glue, extrafont, showtext, ggrepel, magick, \n ggforce, ggtext, lubridate, \n cowplot, patchwork, rlang)\nloadfonts(quiet = TRUE)\n```\n\n## team links function\n\n```{r}\nget_team_links <- function(season) {\n \n url <- \"https://www.transfermarkt.com/bundesliga/startseite/wettbewerb/L1/plus/?saison_id={season}\"\n \n session <- bow(url)\n \n team_links <- scrape(session) %>% \n html_nodes(\"#yw1 > table > tbody > tr > td.zentriert.no-border-rechts > a\") %>% \n html_attr(\"href\")\n \n # season <- enquo(season)\n \n team_links_df <- team_links %>% \n enframe(name = NULL) %>% \n separate(value, c(NA, \"team_name\", NA, NA, \"team_num\", NA, NA), sep = \"/\") %>% \n mutate(link = glue(\"https://www.transfermarkt.com/{team_name}/leistungsdaten/verein/{team_num}/reldata/%26{season}/plus/1\"),\n season = season)\n}\n```\n\n```{r}\nteam_links_df <- get_team_links(season = 2019)\n\nglimpse(team_links_df)\n```\n\n\n\n## scrape function\n\n```{r}\nbuli_age_utility_info <- function(team_name, team_num, season, total_minutes) {\n ## get age + minutes played\n session <- bow(glue::glue(\"https://www.transfermarkt.com/{team_name}/leistungsdaten/verein/{team_num}/plus/1?reldata=L1%26{season}/\"))\n \n # grab name from photo element instead\n result_name <- scrape(session) %>% \n html_nodes(\"#yw1 .bilderrahmen-fixed\") %>% \n html_attr(\"title\") \n \n # grab age\n result_age <- scrape(session) %>% \n html_nodes(\".posrela+ .zentriert\") %>% \n html_text()\n \n # grab minutes played in league\n result_mins <- scrape(session) %>% \n html_nodes(\"td.rechts\") %>% \n html_text()\n \n ## get length\n session <- bow(glue::glue(\"https://www.transfermarkt.com/{team_name}/kader/verein/{team_num}/saison_id/{season}/plus/1\"))\n \n result_name2 <- scrape(session) %>% \n html_nodes(\"#yw1 .bilderrahmen-fixed\") %>% \n html_attr(\"title\") \n \n result_bday <- scrape(session) %>% \n html_nodes(\".posrela+ .zentriert\") %>% \n html_text()\n \n result_joinedteam <- scrape(session) %>% \n html_nodes(\"td:nth-child(7)\") %>% \n html_text()\n \n result_leaveteam <- scrape(session) %>% \n html_nodes(\"td:nth-child(9)\") %>% \n html_text()\n \n # place each vector into list\n resultados <- list(result_name, result_age, result_mins)\n \n col_name <- c(\"name\", \"age\", \"minutes\")\n \n results_comb <- resultados %>% \n reduce(cbind) %>% \n as_tibble() %>% \n set_names(col_name)\n \n ## join + bday\n resultados2 <- list(result_name2, result_bday, \n result_joinedteam, result_leaveteam)\n \n col_name2 <- c(\"name\", \"bday\", \"join\", \"leave\")\n \n results_comb2 <- resultados2 %>% \n reduce(cbind) %>% \n as_tibble() %>% \n set_names(col_name2)\n \n ## combine BOTH\n results_comb <- results_comb %>% \n left_join(results_comb2) \n \n # fix \"strings\" into proper formats, calculate % of minutes appeared\n all_team_minutes <- results_comb %>% \n mutate(age = as.numeric(age),\n minutes = minutes %>% \n str_replace(\"\\\\.\", \"\") %>% \n str_replace(\"'\", \"\") %>% \n as.numeric(),\n min_perc = (minutes / total_minutes) %>% round(digits = 3),\n bday = str_replace_all(bday, \"\\\\(.*\\\\)\", \"\") %>% mdy(),\n join = join %>% mdy(),\n join_age = interval(bday, join) / years(1),\n age_now = interval(bday, Sys.Date()) / years(1)) %>% \n filter(!is.na(minutes)) %>% \n separate(name, into = c(\"first_name\", \"last_name\"), \n sep = \" \", fill = \"left\") %>%\n mutate(\n fname = if_else(!is.na(first_name), \n str_extract(first_name, \"[A-Z]{1}\"),\n \"\"),\n player = case_when(\n !is.na(first_name) ~ glue(\"{fname}. {last_name}\"),\n TRUE ~ last_name),\n team_name = team_name,\n team_name = case_when(\n team_name == \"fc-bayern-munchen\" ~ \"Bayern München\",\n team_name == \"rasenballsport-leipzig\" ~ \"RB Leipzig\", \n team_name == \"fc-schalke-04\" ~ \"Schalke 04\",\n team_name == \"hertha-bsc\" ~ \"Hertha Berlin\",\n team_name == \"1-fc-union-berlin\" ~ \"Union Berlin\",\n team_name == \"fortuna-dusseldorf\" ~ \"Fortuna Düsseldorf\",\n team_name == \"bayer-04-leverkusen\" ~ \"Bayer Leverkusen\",\n team_name == \"sv-werder-bremen\" ~ \"Werder Bremen\",\n team_name == \"borussia-monchengladbach\" ~ \"Borussia Mönchengladbach\",\n team_name == \"tsg-1899-hoffenheim\" ~ \"Hoffenheim\",\n TRUE ~ str_replace_all(team_name, \"-\", \" \") %>% stringr::str_to_title()),\n season = season) %>% \n arrange(desc(min_perc)) \n \n return(all_team_minutes)\n}\n```\n\n```{r}\n# ALL TEAMS AT ONCE, WILL TAKE A WHILE:\nage_utility_df_ALL <- pmap(list(team_links_df$team_name, \n team_links_df$team_num,\n team_links_df$season,\n 2160),\n .f = buli_age_utility_info)\n\nbuli_age_utility_df <- age_utility_df_ALL %>% \n reduce(rbind)\n\n## save\nsaveRDS(buli_age_utility_df, file = glue(\"{here::here()}/data/buli_age_utility_df_MD24_1920.RDS\"))\n```\n\n## all team data\n\n```{r}\nbuli_age_utility_df <- readRDS(file = here::here(glue::glue(\"data/buli_age_utility_df_MD24_1920.RDS\")))\n```\n\n\n## bvb\n\n```{r fig.width=15, fig.height=8}\nbvb_df <- buli_age_utility_df %>% \n filter(team_name == \"Borussia Dortmund\") %>% \n mutate(player = case_when(player == \"V. van\" ~ \"V. Van Dijk\", \n TRUE ~ as.character(player)),\n join_age = case_when(player == \"J. Weigl\" ~ 18.9,\n first_name == \"Paco\" ~ 23.9,\n TRUE ~ join_age),\n age_now = case_when(player == \"J. Weigl\" ~ 24.3,\n first_name == \"Paco\" ~ 26.4,\n TRUE ~ age_now))\n\ncombined_plot <- age_utility_plotter(df = bvb_df, \n team_name = \"Borussia Dortmund\",\n j_name = \"Borussia Dortmund\",\n color_1 = \"#D3D3D3\", color_2 = \"#beb500\", #firebrick1 #009782\n img_path = here::here(\"img/BorussiaDortmund.png\"))\n\ncombined_plot\n```\n\n\n```{r}\nggsave(plot = combined_plot, \"../Bundesliga 2019-2020/output/bvb_age_utility_22820.png\",\n height = 8, width = 15)\n```\n\n\n\n\n\n## rbl\n\n```{r fig.width=15, fig.height=8}\nrbl_df <- buli_age_utility_df %>% \n filter(team_name == \"RB Leipzig\") %>% \n mutate(player = case_when(player == \"V. van\" ~ \"V. Van Dijk\", \n TRUE ~ as.character(player)),\n join_age = case_when(player == \"S. Ilsanker\" ~ 26,\n player == \"M. Cunha\" ~ 19,\n player == \"D. Demme\" ~ 22,\n TRUE ~ join_age),\n age_now = case_when(player == \"S. Ilsanker\" ~ 30,\n player == \"M. Cunha\" ~ 20,\n player == \"D. Demme\" ~ 28,\n TRUE ~ age_now))\n\ncombined_plot <- age_utility_plotter(df = rbl_df, \n team_name = \"RB Leipzig\",\n j_name = \"RB Leipzig\",\n color_1 = \"#001f47\", color_2 = \"#dd0741\", #firebrick1 #009782\n img_path = here::here(\"img/RBLeipzig.png\"))\n\ncombined_plot\n```\n\n\n```{r}\nggsave(plot = combined_plot, \"../Bundesliga 2019-2020/output/rbl_age_utility_22820.png\",\n height = 8, width = 15)\n```\n\n\n\n\n\n\n\n\n\n## Bayern Munich\n\n```{r fig.width=15, fig.height=8}\nbayern_df <- buli_age_utility_df %>% \n filter(team_name == \"Bayern München\") %>% \n mutate(player = case_when(player == \"NA. Odriozola\" ~ \"A. Odriozola\", \n TRUE ~ as.character(player)),\n join_age = case_when(player == \"J. Zirkzee\" ~ 18,\n player == \"M. Cunha\" ~ 19,\n player == \"D. Demme\" ~ 22,\n TRUE ~ join_age))\n\ncombined_plot <- age_utility_plotter(df = bayern_df, \n team_name = \"Bayern München\",\n j_name = \"Bayern Munich\",\n color_1 = \"#0066b2\", color_2 = \"#dc052d\", #firebrick1 #009782\n img_path = here::here(\"img/Bayern.png\"))\n\ncombined_plot\n```\n\n\n```{r}\nggsave(plot = combined_plot, \"../Bundesliga 2019-2020/output/BayernMunich_age_utility_3120.png\",\n height = 8, width = 15)\n```\n\n\n\n"
},
{
"path": "Bundesliga 2019-2020/buli_dribbling_1920_hinrunde.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"1/16/2020\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, \n ggforce, ggtext,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, \n logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n# Bundesliga data\n\n- Save \"Player Standard Stats\" & \"Squad Standard Stats\" as a `.csv` file or whatever you prefer.\n- https://fbref.com/en/comps/20/passing/Bundesliga-Stats\n\n### player stats\n\n\n```{r}\nbuli_player_dribbling_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_player_dribbling_stats_hinrunde.csv\"),\n skip = 1, col_names = TRUE)\n\nbuli_player_dribbling_stats_hinrunde <- buli_player_dribbling_stats_hinrunde_raw %>% \n select(-Matches, -Rk) %>% \n select(Player, Pos, Squad, `90s`,\n dribble_success = Succ,\n dribble_attempt = Att,\n dribble_perc = `Succ%`,\n dribble_past = `#Pl`,\n nutmegs = Megs,\n dribble_tackled = Tkl,\n dribble_against = Att_1,\n tackle_success = `Tkl%`,\n dribble_against_success = Past)\n\nglimpse(buli_player_dribbling_stats_hinrunde)\n```\n\n```{r}\nbuli_player_dribbling_hinrunde_clean <- buli_player_dribbling_stats_hinrunde %>% \n separate(Player, into = c(\"fullname\", \"allname\"), sep = \"\\\\\\\\\") %>% separate(fullname, into = c(\"firstname\", \"lastname\"),\n sep = \"\\\\s\", extra = \"merge\",\n remove = FALSE) %>%\n mutate(fname = str_extract(firstname, \"[A-Z]{1}\")) %>% \n ## players like Fabinho listed without Tavares last name\n mutate(player = if_else(is.na(lastname), firstname, lastname)) %>% \n mutate(player = case_when(\n !is.na(lastname) ~ glue(\"{fname}. {lastname}\"),\n TRUE ~ firstname)) %>% \n mutate(\n min = `90s` * 90,\n dribble_successPer90 = (dribble_success / min) * 90,\n dribble_attemptPer90 = (dribble_attempt / min) * 90,\n dribble_pastPer90 = (dribble_past / min) * 90,\n nutmegsPer90 = (nutmegs / min) * 90,\n dribble_tackledPer90 = (dribble_tackled / min) * 90,\n dribble_againstPer90 = (dribble_against / min) * 90,\n dribble_against_successPer90 = (dribble_against_success / min) * 90) %>% \n ## keep fullname so can differentiate A. Gomes (Andre/Angel), etc.\n select(-`90s`, -firstname, -lastname, -allname, \n team_name = Squad, -fname, contains(\"dribble\"),\n nutmegs, nutmegsPer90) \n\nglimpse(buli_player_dribbling_hinrunde_clean)\n```\n\n\n```{r}\n## save\nsaveRDS(buli_player_dribbling_hinrunde_clean, \n file = glue(\"{here::here()}/data/buli_player_dribbling_hinrunde_clean.RDS\"))\n\nbuli_player_dribbling_hinrunde_clean <- readRDS(\n file = glue(\"{here::here()}/data/buli_player_dribbling_hinrunde_clean.RDS\"))\n```\n\n\n\n# plot\n\n\n```{r}\nbuli_player_dribbling_hinrunde_clean %>% \n filter(min >= 900,\n dribble_attemptPer90 > 2) %>% \n summarize(avg_dribblesper90 = median(dribble_attemptPer90),\n avg_dribble_successper90 = median(dribble_successPer90),\n avg_dribble_rate = median(dribble_perc))\n\nbuli_player_dribbling_hinrunde_clean %>% \n filter(min >= 900,\n dribble_attemptPer90 > 2,\n Pos %in% c(\"FW\", \"FWMF\")) %>% \n summarize(avg_dribblesper90 = median(dribble_attemptPer90),\n avg_dribble_successper90 = median(dribble_successPer90),\n avg_dribble_rate = median(dribble_perc))\n```\n\n- when filtering for FW/Attacking MFs, F3 falls and PPA rises - fairly self-explanatory and reasonable\n\n```{r}\nbad_box <- data.frame(\n xmin = -Inf, xmax = 3.36, \n ymin = -Inf, ymax = 60.45)\n\nchance_creation_box <- data.frame(\n xmin = -Inf, xmax = 3.36, \n ymin = 60.45, ymax = Inf)\n\nmidfield_progress_box <- data.frame(\n xmin = 3.36, xmax = Inf, \n ymin = -Inf, ymax = 60.45)\n\ndual_box <- data.frame(\n xmin = 3.36, xmax = Inf, \n ymin = 60.45, ymax = Inf)\n```\n\n\n```{r}\nbuli_dribble_df <- buli_player_dribbling_hinrunde_clean %>% \n filter(min >= 900,\n dribble_attemptPer90 > 2) %>% \n mutate(fillcol = case_when(\n dribble_attemptPer90 < 3.36 & dribble_perc < 60.45 ~ \"red\",\n dribble_attemptPer90 > 3.36 & dribble_perc < 60.45 ~ \"orange\",\n dribble_attemptPer90 < 3.36 & dribble_perc > 60.45 ~ \"yellow\",\n dribble_attemptPer90 > 3.36 & dribble_perc > 60.45 ~ \"green\",\n TRUE ~ NA_character_))\n```\n\n```{r}\npoint_cols <- c(\"yellow\" = \"yellow\", \"red\" = \"red\",\n \"orange\" = \"orange\", \"green\" = \"#228B22\")\n```\n\n\n```{r}\nbayern_desc <- \"Both Kimmich & Alaba have been playing much more centrally this season (Center Midfield & Center Back respectively) the former only behind teammate Coutinho and Brandt in Passes into the Penalty Area per 90 with the latter leading the league with 9.83 Passes into the Final 3rd per 90. Thiago keeps things ticking in midfield with a 90.2% Pass Accuracy.\"\n\nbrandt_desc <- \"Julian Brandt has become the primary ball progressor in this Dortmund side with his 2.99 PPA per 90 leading the league by a considerable margin. A lot of this comes from his throughballs (0.68 Through Balls per 90, 1st in the league). Along with his 7th and 4th ranking (within BVB) in Final Third Passes per 90 & xA per 90 respectively, it shows that he provides the incisive ball in between the build-up & the final pass. Indeed, his 1.45 KP per 90 is 4th in the team behind Hazard, Sancho, & Hakimi.\"\n```\n\n\n\n```{r fig.width = 14, fig.height = 10}\nbuli_dribbling_hinrunde_plot <- ggplot(\n buli_dribble_df, \n aes(x = dribble_attemptPer90, y = dribble_perc)) +\n ## area fills\n geom_rect(data = chance_creation_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"yellow\", alpha = 0.1) +\n geom_rect(data = bad_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"red\", alpha = 0.1) +\n geom_rect(data = midfield_progress_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"orange\", alpha = 0.2) +\n geom_rect(data = dual_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"green\", alpha = 0.1) +\n ## median reference lines\n geom_hline(yintercept = 60.45, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 3.35, color = \"grey20\", alpha = 0.4) +\n ## player data\n geom_point(aes(color = factor(fillcol)), size = 3) +\n scale_color_manual(values = point_cols) +\n ## league average\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 7.35, y = 61, hjust = 0, color = \"grey20\",\n label = \"Average OP Passes into the Final Third per 90: 2.5\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 3.35, y = 105, hjust = 0, color = \"grey20\",\n label = \"Average OP Passes into Penalty Area per 90: 0.48\") +\n ## area labels\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.25, y = 3.8, \n hjust = 0, color = \"#CCCC00\", size = 6,\n label = \"Good Chance Creation\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 0.2, \n hjust = 0, color = \"orange\", size = 6,\n label = \"Good Midfield Progression\") +\n annotate(\n \"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 3.77, \n hjust = 0, color = \"#228B22\", size = 6,\n label = \"Good Chance Creation\\nGood Midfield Progression\") +\n ## player labels\n geom_text_repel(\n data = buli_dribble_df %>% \n filter(dribble_attemptPer90 > 2 | dribble_perc > 60.45,\n !player %in% c(\"J. Sancho\", \"M. Rashica\",\n \"A. Davies\", \"T. Alcántara\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\", \n segment.color = factor(fillcol)),\n min.segment.length = 0.3, seed = 15, size = 3.5,\n #segment.color = \"red\", \n point.padding = 0.6,\n color = \"grey20\") +\n # ## Bayern description\n geom_mark_hull(\n aes(filter = player == \"J. Sancho\",\n label = \"Jaden Sancho: Dribble Koenig\",\n description = \"bayern_desc\"),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n con.colour = \"orange\", color = \"orange\",\n label.width = unit(70, 'mm'), label.buffer = unit(10, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n # ## Brandt description #7fbf7f #b2d8b2\n geom_mark_hull(\n aes(filter = player == \"A. Davies\",\n label = \"Alphonso Davies: Canada's \",\n description = \"brandt_desc\"),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n con.colour = \"#228B22\", color = \"#228B22\",\n label.width = unit(50, 'mm'), label.buffer = unit(60, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n # ## Brandt description #7fbf7f #b2d8b2\n geom_mark_hull(\n aes(filter = player == \"T. Alcántara\",\n label = \"Alcántara: Efficient Dribbler.\",\n description = \"brandt_desc\"),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(90, 'mm'), label.buffer = unit(5, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n # ## Bayern description\n geom_mark_hull(\n aes(filter = player == \"M. Rashica\",\n label = \"Milot Rashica: Dribble Koenig\",\n description = \"bayern_desc\"),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(70, 'mm'), label.buffer = unit(30, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n ## Bayern player labels\n # geom_text_repel(\n # data = buli_player_dribbling_hinrunde_clean %>%\n # filter(min >= 900, \n # player %in% c(\"J. Kimmich\", \n # \"D. Alaba\", \n # \"T. Alcántara\",\n # \"P. Coutinho\")),\n # aes(label = player, family = \"Roboto Condensed\", \n # fontface = \"bold\"),\n # seed = 15, size = 4.5, color = \"red\",\n # min.segment.length = 0, segment.color = \"red\",\n # point.padding = 0.5, nudge_x = 0.6) +\n ## scales\n scale_x_continuous(labels = seq(0, 10, 0.5), \n breaks = seq(0, 10, 0.5),\n limits = c(1.25, 10),\n expand = c(0.01, 0)) +\n scale_y_continuous(labels = seq(0, 100, 10), \n breaks = seq(0, 100, 10),\n limits = c(30, 110),\n expand = c(0.01, 0)) +\n labs(title = \"Dribble Volume vs. Dribble Success: Bundesliga (2019-2020)\", \n subtitle = glue(\"\n Hinrunde | January 16th, 2020\n Average (Median) | Minimum 900 Minutes Played | More than 2 dribble per 90\"),\n caption = glue(\"\n Data: FBref | StatsBomb\n Ryo Nakagawara, Twitter: @R_by_Ryo\"),\n x = \"Dribbles Attempted per 90\",\n y = \"Dribble Success Rate (%)\") +\n theme_minimal() +\n theme(text = element_markdown(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 20),\n plot.subtitle = element_markdown(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12))\n\nbuli_dribbling_hinrunde_plot\n```\n\n\n\n\n\n\n## save\n\n```{r}\nggsave(plot = buli_dribbling_hinrunde_plot, \n here::here(\"Bundesliga 2019-2020/output/buli_dribbling_1920_hinrunde.png\"),\n height = 10, width = 14)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = here::here(\"Bundesliga 2019-2020/output/buli_dribbling_1920_hinrunde.png\"),\n logo_path = here::here(\"../soccer_match_reports/img/Bundesliga_logo_(2017).svg\"),\n logo_position = \"top right\",\n logo_scale = 18)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n here::here(\"Bundesliga 2019-2020/output/buli_dribbling_1920_hinrunde_logo.png\"))\n```\n\n\n\n\n\n\n\n\n"
},
{
"path": "Bundesliga 2019-2020/buli_goalkeepers_1920_hinrunde.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"1/18/2020\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, \n ggforce, ggtext,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, \n logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n\n\n# Bundesliga data\n\n- Save \"Player Standard Stats\" & \"Squad Standard Stats\" as a `.csv` file or whatever you prefer.\n- https://fbref.com/en/comps/20/passing/Bundesliga-Stats\n\n## advanced stats\n\n\n```{r}\nbuli_player_goalkeeping_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_player_goalkeeping_stats_hinrunde.csv\"),\n skip = 1, col_names = TRUE) %>% \n select(-Matches, -Rk)\n\nbuli_player_goalkeeping_stats_hinrunde <- buli_player_goalkeeping_stats_hinrunde_raw %>% \n rename_at(vars(15:17), \n ~ glue::glue(\"launch_{colnames(buli_player_goalkeeping_stats_hinrunde_raw)[15:17]}\")) %>% \n rename_at(vars(18:21), \n ~ glue::glue(\"pass_{colnames(buli_player_goalkeeping_stats_hinrunde_raw)[18:21]}\")) %>% \n rename_at(vars(22:24), \n ~ glue::glue(\"goalkick_{colnames(buli_player_goalkeeping_stats_hinrunde_raw)[22:24]}\")) %>% \n rename_at(vars(25:27), \n ~ glue::glue(\"crosses_{colnames(buli_player_goalkeeping_stats_hinrunde_raw)[25:27]}\"))\n\n\nbuli_player_goalkeeping_stats_hinrunde <- buli_player_goalkeeping_stats_hinrunde %>% \n rename_all(~str_replace_all(colnames(buli_player_goalkeeping_stats_hinrunde), \"_[0-9]\", \"\")) %>% \n rename(PSxGper90 = `/90`)\n\nglimpse(buli_player_goalkeeping_stats_hinrunde)\n```\n\n\n## regular stats\n\n```{r}\nbuli_player_regular_goalkeeping_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_player_regular_goalkeeping_stats_hinrunde.csv\"), skip = 1, col_names = TRUE) %>% \n select(-Matches, -Rk)\n\nbuli_player_regular_goalkeeping_stats_hinrunde <- buli_player_regular_goalkeeping_stats_hinrunde_raw %>% \n separate(Player, into = c(\"fullname\", \"allname\"), \n sep = \"\\\\\\\\\") %>% \n separate(fullname, into = c(\"firstname\", \"lastname\"),\n sep = \"\\\\s\", extra = \"merge\", remove = FALSE) %>%\n mutate(fname = str_extract(firstname, \"[A-Z]{1}\")) %>% \n ## players like Fabinho listed without Tavares last name\n mutate(player = if_else(is.na(lastname), firstname, lastname)) %>% \n mutate(player = case_when(\n !is.na(lastname) ~ glue(\"{fname}. {lastname}\"),\n TRUE ~ firstname)) %>% \n select(-firstname, -fname, -lastname, -allname)\n\n\nglimpse(buli_player_regular_goalkeeping_stats_hinrunde)\n```\n\n\n## clean\n\n```{r}\nbuli_player_goalkeeping_hinrunde_clean <- buli_player_goalkeeping_stats_hinrunde %>% \n separate(Player, into = c(\"fullname\", \"allname\"), sep = \"\\\\\\\\\") %>% separate(fullname, into = c(\"firstname\", \"lastname\"),\n sep = \"\\\\s\", extra = \"merge\",\n remove = FALSE) %>%\n mutate(fname = str_extract(firstname, \"[A-Z]{1}\")) %>% \n ## players like Fabinho listed without Tavares last name\n mutate(player = if_else(is.na(lastname), firstname, lastname)) %>% \n mutate(player = case_when(\n !is.na(lastname) ~ glue(\"{fname}. {lastname}\"),\n TRUE ~ firstname)) %>% \n left_join(buli_player_regular_goalkeeping_stats_hinrunde) %>% \n mutate(\n min = `90s` * 90,\n GSAA = PSxG - GA,\n GSAAper90 = (GSAA / min) * 90,\n `xSave%` = (SoTA - PSxG) / SoTA,\n GSAA_perc = `Save%` - `xSave%`,\n minPerSave = min / Saves) %>% \n ## GSAA %: (SoTA - PSxG) / SoTA\n rename(team_name = Squad) %>% \n ## keep fullname so can differentiate A. Gomes (Andre/Angel), etc.\n select(-`90s`, -firstname, -fname, -lastname, -allname)\n\nglimpse(buli_player_goalkeeping_hinrunde_clean)\n```\n\n\n```{r}\n## save\nsaveRDS(buli_player_goalkeeping_hinrunde_clean, \n file = glue(\"{here::here()}/data/buli_player_goalkeeping_hinrunde_clean.RDS\"))\n\nbuli_player_goalkeeping_hinrunde_clean <- readRDS(\n file = glue(\"{here::here()}/data/buli_player_goalkeeping_hinrunde_clean.RDS\"))\n```\n\n\n\n\n# plot\n\n\n\n```{r}\nbuli_player_goalkeeping_hinrunde_clean %>% \n filter(min >= 900) %>% \n summarize(avg_psxgper90 = median(PSxGper90),\n avg_GA = median(GA),\n avg_GSAA = median(GSAA),\n avg_SV_perc = median(`Save%`),\n avg_xSV_perc = median(`xSave%`),\n avg_minperSave = median(minPerSave),\n avg_GSAA_perc = median(GSAA_perc))\n\nbuli_player_goalkeeping_hinrunde_clean %>% \n filter(min >= 900) %>% \n summarize(avg_psxgper90 = mean(PSxGper90),\n avg_GA = mean(GA),\n avg_GSAA = mean(GSAA))\n```\n\n\n```{r}\nbad_box <- data.frame(\n xmin = -Inf, xmax = 0, \n ymin = -Inf, ymax = 28.86)\n\nchance_creation_box <- data.frame(\n xmin = -Inf, xmax = 0, \n ymin = 28.86, ymax = Inf)\n\nmidfield_progress_box <- data.frame(\n xmin = 0, xmax = Inf, \n ymin = -Inf, ymax = 28.86)\n\ndual_box <- data.frame(\n xmin = 0, xmax = Inf, \n ymin = 28.86, ymax = Inf)\n```\n\n\n\n\n\n```{r}\nbuli_player_goalkeeping_hinrunde_clean %>% \n filter(min >= 900) %>% \n ggplot(aes(x = GA, y = PSxGper90)) +\n geom_point() +\n geom_label_repel(aes(label = player))\n```\n\n\n\n```{r fig.width = 14, fig.height = 10}\nbuli_player_goalkeeping_hinrunde_clean %>% \n filter(min >= 900) %>% \n ggplot(aes(x = GA, y = GSAA)) +\n geom_point(aes(size = `xSave%`), color = \"red\") +\n geom_text_repel(aes(label = player)) +\n geom_vline(xintercept = 23) +\n geom_hline(yintercept = -1.2) +\n scale_x_reverse() +\n theme_minimal()\n```\n\n\n\n\n\n## Minutes / Save vs. GSAA\n\n```{r}\nbuli_gk <- buli_player_goalkeeping_hinrunde_clean %>% \n filter(min >= 900) %>% \n mutate(fillcol = case_when(\n GSAA_perc < 0 & minPerSave < 28.86 ~ \"red\",\n GSAA_perc > 0 & minPerSave < 28.86 ~ \"yellow\",\n GSAA_perc < 0 & minPerSave > 28.86 ~ \"orange\",\n GSAA_perc > 0 & minPerSave > 28.86 ~ \"green\",\n TRUE ~ NA_character_))\n```\n\n```{r}\npoint_cols <- c(\"yellow\" = \"yellow\", \"red\" = \"red\",\n \"orange\" = \"orange\", \"green\" = \"#228B22\")\n```\n\n\n```{r}\nsommer_desc <- \"Yann Sommer has been in excellent form and has helped push Die Fohlen to become genuine title challengers this season. The Swiss is tied 1st for least goals conceded, 1st in Goals Against per 90 (1.06), & boasts a 6.4 GSAA (best in the league by a considerable margin, over 4 goals compared to 2nd placed Gikiewicz).\"\n\nburki_desc <- \"Roman Burki is having a tough time in goal with the worst Save % in the league(47.7%) and a dreadful -16 GSAA % showing how he has leaked a lot of goals that the post-shot model expected him to save. BVB's defense may also share the blame with 3 own goals and Bürki's league-worst 0.38 PSxG/Shot on Target can also be attributed to opponent strikers being very clinical.\"\n\npavlenka_desc <- \"Jiri Pavlenka is giving up a league-worst 2.41 Goals Against per 90 but he is not helped by a defense that forces him into a save every 27 minutes on average. Although the post-shot model has him saving the highest percentage of shots faced in the league (67.7% xSaves) the Czech has a -10.8 GSAA %.\"\n```\n\n\n\n\n```{r fig.width = 14, fig.height = 10}\nbuli_goalkeeping_hinrunde_plot <- buli_gk %>% \n ggplot(aes(x = GSAA_perc, y = minPerSave)) +\n geom_vline(xintercept = 0) +\n geom_hline(yintercept = 28.86) +\n ## area fills\n geom_rect(data = chance_creation_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"orange\", alpha = 0.1) +\n geom_rect(data = bad_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"red\", alpha = 0.1) +\n geom_rect(data = midfield_progress_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"yellow\", alpha = 0.2) +\n geom_rect(data = dual_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"green\", alpha = 0.1) +\n ## area labels\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = -0.2, y = 19, \n hjust = 0, color = \"red\", size = 6,\n label = \"Busy & Saving Less Than Average GK\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = -0.2, y = 54, \n hjust = 0, color = \"orange\", size = 6,\n label = \"Not Busy & Saving Less Than Average GK\") +\n annotate( # #7f7f00 #228B22 #CCCC00\n \"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.02, y = 54, \n hjust = 0, color = \"#228B22\", size = 6,\n label = \"Not Busy & Saving More Than Average GK\") +\n annotate(\n \"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.02, y = 19, \n hjust = 0, color = \"#7f7f00\", size = 6,\n label = \"Busy & Saving More Than Average GK\") +\n ## avg minutes per save\n annotate(\n \"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = -0.2, y = 29.5, \n hjust = 0, color = \"grey20\", size = 4,\n label = \"Average: 28.6 Minutes per Save\") +\n ## player data\n geom_point(aes(fill = factor(fillcol)), \n shape = 21, size = 3) +\n scale_fill_manual(values = point_cols,\n guide = NULL) +\n geom_text_repel(\n data = buli_gk %>% \n filter(!player %in% c(\"J. Pavlenka\", \"R. Bürki\",\n \"Y. Sommer\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\", \n segment.color = factor(fillcol)),\n min.segment.length = 0.3, seed = 15, size = 5,\n point.padding = 0.6, color = \"grey20\") +\n # Bürki\n geom_mark_hull(\n aes(filter = player == \"R. Bürki\",\n label = \"Roman Bürki (Borussia Dortmund)\",\n description = burki_desc),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n con.colour = \"orange\", color = \"orange\",\n label.width = unit(140, 'mm'), label.buffer = unit(4.95, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#ffe5cc\") +\n # Pavlenka\n geom_mark_hull(\n aes(filter = player == \"J. Pavlenka\",\n label = \"Jiri Pavlenka (Werder Bremen)\",\n description = pavlenka_desc),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n con.colour = \"red\", color = \"red\", \n label.width = unit(140, 'mm'), label.buffer = unit(0.5, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#FFCCCC\") +\n # Sommer\n geom_mark_hull(\n aes(filter = player == \"Y. Sommer\",\n label = \"Yann Sommer (Borussia Mönchengladbach)\",\n description = sommer_desc),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(120, 'mm'), label.buffer = unit(57, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n scale_x_continuous(labels = scales::percent,\n breaks = seq(-0.25, 0.15, 0.05),\n limits = c(-0.2, 0.12),\n expand = c(0.01, 0)) +\n scale_y_continuous(breaks = seq(20, 56, 10),\n limits = c(18, 56),\n expand = c(0.01, 0)) +\n labs(title = \"Goalkeeper Performance & Workload: Bundesliga (2019-2020)\",\n subtitle = glue::glue(\"\n January 18th, 2020 | Hinrunde | Minimum 900 Minutes Played\n
GSAA %: Whether a GK has saved more/less than the post-shot model expected an average GK to save (Actual Save % - Expected Save %)\"),\n x = \"Goals Saved Above Average Percentage (GSAA %)\", \n y = \"Average Minutes per Save\",\n caption = \"Data: FBref | StatsBomb\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 20),\n plot.subtitle = element_markdown(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12))\n\nbuli_goalkeeping_hinrunde_plot\n```\n\n\n\n\n## save\n\n```{r}\nggsave(plot = buli_goalkeeping_hinrunde_plot, \n here::here(\"Bundesliga 2019-2020/output/buli_goalkeeping_1920_hinrunde.png\"),\n height = 10, width = 14)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = here::here(\"Bundesliga 2019-2020/output/buli_goalkeeping_1920_hinrunde.png\"),\n logo_path = here::here(\"../soccer_match_reports/img/Bundesliga_logo_(2017).svg\"),\n logo_position = \"top right\",\n logo_scale = 18)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n here::here(\"Bundesliga 2019-2020/output/buli_goalkeeping_1920_hinrunde_logo.png\"))\n```\n\n\n\n\n\n\n"
},
{
"path": "Bundesliga 2019-2020/buli_progressive_passing_1920_hinrunde.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"1/14/2020\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, \n ggforce, ggtext,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, \n logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n# Bundesliga data\n\n- Save \"Player Standard Stats\" & \"Squad Standard Stats\" as a `.csv` file or whatever you prefer.\n- https://fbref.com/en/comps/20/passing/Bundesliga-Stats\n\n### player stats\n\n```{r}\nbuli_player_passing_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_player_passing_stats_hinrunde.csv\"),\n skip = 1, col_names = TRUE)\n\nbuli_player_passing_stats_hinrunde <- buli_player_passing_stats_hinrunde_raw %>% \n rename_at(vars(14:16), \n ~ glue::glue(\"short_{colnames(buli_player_passing_stats_hinrunde_raw)[14:16]}\")) %>% \n rename_at(vars(17:19), \n ~ glue::glue(\"medium_{colnames(buli_player_passing_stats_hinrunde_raw)[17:19]}\")) %>% \n rename_at(vars(20:22), \n ~ glue::glue(\"long_{colnames(buli_player_passing_stats_hinrunde_raw)[20:22]}\")) %>% \n rename_all(~str_replace_all(colnames(buli_player_passing_stats_hinrunde), \"_[0-9]\", \"\")) %>% \n select(-Matches, -Rk)\n\nglimpse(buli_player_passing_stats_hinrunde)\n```\n\n```{r}\n## save\nsaveRDS(buli_player_passing_stats_hinrunde, \n file = glue(\"{here::here()}/data/buli_player_passing_stats_hinrunde.RDS\"))\n\nbuli_player_passing_stats_hinrunde <- readRDS(\n file = glue(\"{here::here()}/data/buli_player_passing_stats_hinrunde.RDS\"))\n```\n\n```{r}\nbuli_player_passing_hinrunde_clean <- buli_player_passing_stats_hinrunde %>% \n separate(Player, into = c(\"fullname\", \"allname\"), sep = \"\\\\\\\\\") %>% separate(fullname, into = c(\"firstname\", \"lastname\"),\n sep = \"\\\\s\", extra = \"merge\",\n remove = FALSE) %>%\n mutate(fname = str_extract(firstname, \"[A-Z]{1}\")) %>% \n ## players like Fabinho listed without Tavares last name\n mutate(player = if_else(is.na(lastname), firstname, lastname)) %>% \n mutate(player = case_when(\n !is.na(lastname) ~ glue(\"{fname}. {lastname}\"),\n TRUE ~ firstname)) %>% \n mutate(min = `90s` * 90) %>% \n mutate(KPper90 = (KP / min) * 90,\n xAper90 = (xA / min) * 90,\n finalthirdper90 = (`1/3` / min) * 90,\n PPAper90 = (PPA / min) * 90,\n CrsPAper90 = (CrsPA / min) * 90,\n TBper90 = (TB / min) * 90) %>% \n ## keep fullname so can differentiate A. Gomes (Andre/Angel), etc.\n select(-`90s`, -firstname, -lastname, -allname, \n team_name = Squad, -fname) \n\nglimpse(buli_player_passing_hinrunde_clean)\n```\n\n\n```{r}\n## save\nsaveRDS(buli_player_passing_hinrunde_clean, \n file = glue(\"{here::here()}/data/buli_player_passing_hinrunde_clean.RDS\"))\n\nbuli_player_passing_hinrunde_clean <- readRDS(\n file = glue(\"{here::here()}/data/buli_player_passing_hinrunde_clean.RDS\"))\n```\n\n\n\n\n# plot\n\n\n```{r}\nbuli_player_passing_hinrunde_clean %>% \n filter(min >= 900) %>% \n summarize(avg_f3per90 = median(finalthirdper90),\n avg_PPAper90 = median(PPAper90))\n\nbuli_player_passing_hinrunde_clean %>% \n filter(min >= 900,\n Pos %in% c(\"FW\", \"FWMF\")) %>% \n summarize(avg_f3per90 = median(finalthirdper90),\n avg_PPAper90 = median(PPAper90))\n```\n\n- when filtering for FW/Attacking MFs, F3 falls and PPA rises - fairly self-explanatory and reasonable\n\n```{r}\nbad_box <- data.frame(\n xmin = -Inf, xmax = 2.5, \n ymin = -Inf, ymax = 0.48)\n\nchance_creation_box <- data.frame(\n xmin = -Inf, xmax = 2.5, \n ymin = 0.48, ymax = Inf)\n\nmidfield_progress_box <- data.frame(\n xmin = 2.5, xmax = Inf, \n ymin = -Inf, ymax = 0.48)\n\ndual_box <- data.frame(\n xmin = 2.5, xmax = Inf, \n ymin = 0.48, ymax = Inf)\n```\n\n\n```{r}\nbuli_pass_df <- buli_player_passing_hinrunde_clean %>% \n filter(min >= 900)\n```\n\n```{r}\nbayern_desc <- \"Both Kimmich & Alaba have been playing much more centrally this season (Center Midfield & Center Back respectively) the former only behind teammate Coutinho and Brandt in Passes into the Penalty Area per 90 with the latter leading the league with 9.83 Passes into the Final 3rd per 90. Thiago keeps things ticking in midfield with a 90.2% Pass Accuracy.\"\n\nbrandt_desc <- \"Julian Brandt has become the primary ball progressor in this Dortmund side with his 2.99 PPA per 90 leading the league by a considerable margin. A lot of this comes from his throughballs (0.68 Through Balls per 90, 1st in the league). Along with his 7th and 4th ranking (within BVB) in Final Third Passes per 90 & xA per 90 respectively, it shows that he provides the incisive ball in between the build-up & the final pass. Indeed, his 1.45 KP per 90 is 4th in the team behind Hazard, Sancho, & Hakimi.\"\n```\n\nKimmich:\n\nAlaba:\n\n\nBrandt: 0.68 TB per 90 (1st), 2.99 PPA per 90 (1st), 4.1 Final Third per 90 (30th), 0.19 xA per 90 (30th)\n\n1.45 KP per 90 (47t league, 4th team) xA per 90 (4th), final 3rd (7th)\n\n```{r fig.width = 14, fig.height = 10}\nbuli_progressive_pass_hinrunde_plot <- ggplot(buli_pass_df, \n aes(x = finalthirdper90, y = PPAper90)) +\n ## area fills\n geom_rect(data = chance_creation_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"yellow\", alpha = 0.1) +\n geom_rect(data = bad_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"red\", alpha = 0.1) +\n geom_rect(data = midfield_progress_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"orange\", alpha = 0.2) +\n geom_rect(data = dual_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"green\", alpha = 0.1) +\n ## median reference lines\n geom_hline(yintercept = 0.48, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 2.5, color = \"grey20\", alpha = 0.4) +\n ## player data\n geom_point(color = \"red\", size = 3) +\n ## league average\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 2.6, y = 3.8, hjust = 0, color = \"grey20\",\n label = \"Average OP Passes into the Final Third per 90: 2.5\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 0.44, hjust = 0, color = \"grey20\",\n label = \"Average OP Passes into Penalty Area per 90: 0.48\") +\n ## area labels\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.25, y = 3.8, \n hjust = 0, color = \"#CCCC00\", size = 6,\n label = \"Good Chance Creation\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 0.2, \n hjust = 0, color = \"orange\", size = 6,\n label = \"Good Midfield Progression\") +\n annotate(\n \"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 3.77, \n hjust = 0, color = \"#228B22\", size = 6,\n label = \"Good Chance Creation\\nGood Midfield Progression\") +\n ## player labels\n geom_text_repel(\n data = buli_player_passing_hinrunde_clean %>% \n filter(min >= 900, \n finalthirdper90 > 3.75 | PPAper90 > 1.2,\n !player %in% c(\"J. Kimmich\", \n \"D. Alaba\", \n \"T. Alcántara\",\n \"P. Coutinho\",\n \"J. Brandt\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n min.segment.length = 0.3, seed = 15, size = 3.5,\n segment.color = \"red\", point.padding = 0.6,\n color = \"grey20\") +\n ## Bayern description\n geom_mark_hull(\n aes(filter = player %in% c(\"J. Kimmich\", \n \"D. Alaba\", \n \"T. Alcántara\",\n \"P. Coutinho\"),\n label = \"Bayern's Passing Maestros.\",\n description = bayern_desc),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(170, 'mm'), label.buffer = unit(10, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n ## Brandt description #7fbf7f #b2d8b2\n geom_mark_hull(\n aes(filter = player %in% c(\"J. Brandt\"),\n label = \"Julian Brandt: BVB's Elite Ball Progressor.\",\n description = brandt_desc),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(250, 'mm'), label.buffer = unit(0.5, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = \"grey20\", label.fill = \"#cce5cc\") + \n ## Bayern player labels\n geom_text_repel(\n data = buli_player_passing_hinrunde_clean %>%\n filter(player %in% c(\"J. Kimmich\", \n \"D. Alaba\", \n \"T. Alcántara\",\n \"P. Coutinho\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n seed = 15, size = 4.5, color = \"red\",\n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5, nudge_x = 0.6) +\n ## scales\n scale_x_continuous(labels = seq(0, 12, 1), \n breaks = seq(0, 12, 1),\n limits = c(0, 12),\n expand = c(0.01, 0)) +\n scale_y_continuous(labels = seq(0, 4, 0.5), \n breaks = seq(0, 4, 0.5),\n limits = c(0, 4),\n expand = c(0.01, 0)) +\n labs(title = \"Progressive Passers: Bundesliga (2019-2020)\", \n subtitle = glue(\"\n Hinrunde | January 15th, 2020\n
Average (Median) | Minimum 900 Minutes Played\"),\n caption = glue(\"\n Data: FBref | StatsBomb\n Ryo Nakagawara, Twitter: @R_by_Ryo\"),\n x = \"Open Play Passes into Final Third per 90\",\n y = \"Open Play Passes into Penalty Area per 90\") +\n theme_minimal() +\n theme(text = element_markdown(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 20),\n plot.subtitle = element_markdown(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12))\n\nbuli_progressive_pass_hinrunde_plot\n```\n\nFlorian Neuhaus (12th PPA per 90), Levin Oztunali (8th PPA per 90, 37th xA per 90)\n\nThe clairvoyant crossers: Filip Kostic (1.38), Christian Gunter (1.0), Niko Gießelmann (0.8) Completed Crosses into Penalty Area per 90 (1st-3rd in league). Kostic also boasts an impressive 2.6 KP per 90 (4th in the league).\n\nRB Leipzig will surely miss Diego Demme who played a huge part in their build up. 6th in the league (just behind teammate Upamecano) in Passes into Final 3rd per 90 and leads Leipzig with 0.3 Through Balls per 90.\n\n\n\n## save\n\n```{r}\nggsave(plot = buli_progressive_pass_hinrunde_plot, \n here::here(\"Bundesliga 2019-2020/output/buli_progressive_pass_1920_hinrunde.png\"),\n height = 10, width = 14)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = here::here(\"Bundesliga 2019-2020/output/buli_progressive_pass_1920_hinrunde.png\"),\n logo_path = here::here(\"../soccer_match_reports/img/Bundesliga_logo_(2017).svg\"),\n logo_position = \"top right\",\n logo_scale = 18)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n here::here(\"Bundesliga 2019-2020/output/buli_progressive_pass_1920_hinrunde_logo.png\"))\n```\n\n\n\n\n\n\n\n\n\n\n\n"
},
{
"path": "Bundesliga 2019-2020/buli_shot_quality_1920_hinrunde.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"1/15/2020\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, \n ggforce, ggtext,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, \n logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n# Bundesliga data\n\n- Save \"Player Standard Stats\" & \"Squad Standard Stats\" as a `.csv` file or whatever you prefer.\n- https://fbref.com/en/comps/20/passing/Bundesliga-Stats\n\n### player stats\n\n\n```{r}\nbuli_player_shooting_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_player_shooting_stats_hinrunde.csv\"),\n col_names = TRUE)\n\nbuli_player_shooting_stats_hinrunde <- buli_player_shooting_stats_hinrunde_raw %>% \n select(-Matches, -Rk)\n\nglimpse(buli_player_shooting_stats_hinrunde)\n```\n\n```{r}\n## save\nsaveRDS(buli_player_shooting_stats_hinrunde, \n file = glue(\"{here::here()}/data/buli_player_shooting_stats_hinrunde.RDS\"))\n\nbuli_player_shooting_stats_hinrunde <- readRDS(\n file = glue(\"{here::here()}/data/buli_player_shooting_stats_hinrunde.RDS\"))\n```\n\n```{r}\nbuli_player_shooting_hinrunde_clean <- buli_player_shooting_stats_hinrunde %>% \n separate(Player, into = c(\"fullname\", \"allname\"), sep = \"\\\\\\\\\") %>% separate(fullname, into = c(\"firstname\", \"lastname\"),\n sep = \"\\\\s\", extra = \"merge\",\n remove = FALSE) %>%\n mutate(fname = str_extract(firstname, \"[A-Z]{1}\")) %>% \n ## players like Fabinho listed without Tavares last name\n mutate(player = if_else(is.na(lastname), firstname, lastname)) %>% \n mutate(player = case_when(\n !is.na(lastname) ~ glue(\"{fname}. {lastname}\"),\n TRUE ~ firstname)) %>% \n mutate(np_shots = Sh - PKatt,\n np_SOT = SoT - PK) %>% \n mutate(min = `90s` * 90) %>% \n # mutate(Shotsper90 = round( (np_shots / min) * 90, 2),\n # SOTper90 = round( (np_SOT / min) * 90, 2),\n # npxGperShot = npxG / np_shots) %>% \n ## keep fullname so can differentiate A. Gomes (Andre/Angel), etc.\n select(-`90s`, -firstname, -lastname, -allname, \n team_name = Squad, -fname,\n npxGperShot = `npxG/Sh`, \n Shotsper90 = `Sh/90`) \n\nglimpse(buli_player_shooting_hinrunde_clean)\n```\n\n\n```{r}\n## save\nsaveRDS(buli_player_shooting_hinrunde_clean, \n file = glue(\"{here::here()}/data/buli_player_shooting_hinrunde_clean.RDS\"))\n\nbuli_player_shooting_hinrunde_clean <- readRDS(\n file = glue(\"{here::here()}/data/buli_player_shooting_hinrunde_clean.RDS\"))\n```\n\n\n\n\n# plot\n\n\n```{r}\nbuli_player_shooting_hinrunde_clean %>% \n filter(min >= 900,\n Shotsper90 > 1) %>% \n summarize(avg_Shotsper90 = median(Shotsper90),\n avg_npxGperShot = median(npxGperShot))\n\nbuli_player_shooting_hinrunde_clean %>% \n filter(min >= 900,\n Shotsper90 > 1,\n Pos %in% c(\"FW\", \"FWMF\")) %>% \n summarize(avg_Shotsper90 = median(Shotsper90),\n avg_npxGperShot = median(npxGperShot))\n```\n\n- when filtering for FW/Attacking MFs, F3 falls and PPA rises - fairly self-explanatory and reasonable\n\n```{r}\nbad_box <- data.frame(\n xmin = -Inf, xmax = 2.5, \n ymin = -Inf, ymax = 0.48)\n\nchance_creation_box <- data.frame(\n xmin = -Inf, xmax = 2.5, \n ymin = 0.48, ymax = Inf)\n\nmidfield_progress_box <- data.frame(\n xmin = 2.5, xmax = Inf, \n ymin = -Inf, ymax = 0.48)\n\ndual_box <- data.frame(\n xmin = 2.5, xmax = Inf, \n ymin = 0.48, ymax = Inf)\n```\n\n\n```{r}\nbuli_shot_df <- buli_player_shooting_hinrunde_clean %>% \n filter(min >= 900)\n```\n\n```{r}\nbayern_desc <- \"Both Kimmich & Alaba have been playing much more centrally this season (Center Midfield & Center Back respectively) the former only behind teammate Coutinho and Brandt in Passes into the Penalty Area per 90 with the latter leading the league with 9.83 Passes into the Final 3rd per 90. Thiago keeps things ticking in midfield with a 90.2% Pass Accuracy.\"\n\nbrandt_desc <- \"Julian Brandt has become the primary ball progressor in this Dortmund side with his 2.99 PPA per 90 leading the league by a considerable margin. A lot of this comes from his throughballs (0.68 Through Balls per 90, 1st in the league). Along with his 7th and 4th ranking (within BVB) in Final Third Passes per 90 & xA per 90 respectively, it shows that he provides the incisive ball in between the build-up & the final pass. Indeed, his 1.45 KP per 90 is 4th in the team behind Hazard, Sancho, & Hakimi.\"\n```\n\n\n\n```{r fig.width = 14, fig.height = 10}\nbuli_shooting_hinrunde_plot <- ggplot(\n buli_shot_df, \n aes(x = Shotsper90, y = npxGperShot)) +\n ## area fills\n geom_rect(data = chance_creation_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"yellow\", alpha = 0.1) +\n geom_rect(data = bad_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"red\", alpha = 0.1) +\n geom_rect(data = midfield_progress_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"orange\", alpha = 0.2) +\n geom_rect(data = dual_box,\n aes(x = NULL, y = NULL,\n xmin = xmin, xmax = xmax,\n ymin = ymin, ymax = ymax),\n fill = \"green\", alpha = 0.1) +\n ## median reference lines\n geom_hline(yintercept = 0.1, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 2, color = \"grey20\", alpha = 0.4) +\n ## player data\n geom_point(color = \"red\", size = 3) +\n ## league average\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 2.6, y = 3.8, hjust = 0, color = \"grey20\",\n label = \"Average OP Passes into the Final Third per 90: 2.5\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 0.44, hjust = 0, color = \"grey20\",\n label = \"Average OP Passes into Penalty Area per 90: 0.48\") +\n ## area labels\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.25, y = 3.8, \n hjust = 0, color = \"#CCCC00\", size = 6,\n label = \"Good Chance Creation\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 0.2, \n hjust = 0, color = \"orange\", size = 6,\n label = \"Good Midfield Progression\") +\n annotate(\n \"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 9.2, y = 3.77, \n hjust = 0, color = \"#228B22\", size = 6,\n label = \"Good Chance Creation\\nGood Midfield Progression\") +\n ## player labels\n geom_text_repel(\n data = buli_player_shooting_hinrunde_clean %>% \n filter(min >= 900, \n Shotsper90 > 2 | npxGperShot > 0.1,\n !player %in% c(\"J. Kimmich\", \n \"D. Alaba\", \n \"T. Alcántara\",\n \"P. Coutinho\",\n \"J. Brandt\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n min.segment.length = 0.3, seed = 15, size = 3.5,\n segment.color = \"red\", point.padding = 0.6,\n color = \"grey20\") +\n # ## Bayern description\n # geom_mark_hull(\n # aes(filter = player %in% c(\"J. Kimmich\", \n # \"D. Alaba\", \n # \"T. Alcántara\",\n # \"P. Coutinho\"),\n # label = \"Bayern's Passing Maestros.\",\n # description = \"bayern_desc\"),\n # expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n # label.width = unit(170, 'mm'), label.buffer = unit(10, \"mm\"),\n # label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n # label.colour = \"grey20\", label.fill = \"#cce5cc\") +\n # ## Brandt description #7fbf7f #b2d8b2\n # geom_mark_hull(\n # aes(filter = player %in% c(\"J. Brandt\"),\n # label = \"Julian Brandt: BVB's Elite Ball Progressor.\",\n # description = \"brandt_desc\"),\n # expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n # label.width = unit(250, 'mm'), label.buffer = unit(0.5, \"mm\"),\n # label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n # label.colour = \"grey20\", label.fill = \"#cce5cc\") + \n ## Bayern player labels\n geom_text_repel(\n data = buli_player_shooting_hinrunde_clean %>%\n filter(min >= 900, \n player %in% c(\"J. Kimmich\", \n \"D. Alaba\", \n \"T. Alcántara\",\n \"P. Coutinho\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n seed = 15, size = 4.5, color = \"red\",\n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5, nudge_x = 0.6) +\n ## scales\n scale_x_continuous(labels = seq(0, 5, 0.5), \n breaks = seq(0, 5, 0.5),\n limits = c(0, 5),\n expand = c(0.01, 0)) +\n scale_y_continuous(labels = seq(0, 0.35, 0.1), \n breaks = seq(0, 0.35, 0.1),\n limits = c(0, 0.35),\n expand = c(0.01, 0)) +\n labs(title = \"Shot Volume vs. Shot Quality: Bundesliga (2019-2020)\", \n subtitle = glue(\"\n Hinrunde | January 15th, 2020\n
Average (Median) | Minimum 900 Minutes Played | More than 1 Shot per 90\"),\n caption = glue(\"\n Data: FBref | StatsBomb\n Ryo Nakagawara, Twitter: @R_by_Ryo\"),\n x = \"Shots per 90\",\n y = \"non-Penalty xG per Shot\") +\n theme_minimal() +\n theme(text = element_markdown(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 20),\n plot.subtitle = element_markdown(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12))\n\nbuli_shooting_hinrunde_plot\n```\n\n\n\n\n\n\n\n"
},
{
"path": "Bundesliga 2019-2020/goal_contrib_graph_1920_hinrunde.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"1/8/2020\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, scales, ggforce, ggtext,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, \n logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n# Bundesliga data\n\n## fbref\n\n- Save \"Player Standard Stats\" & \"Squad Standard Stats\" as a `.csv` file or whatever you prefer.\n- https://fbref.com/en/comps/20/stats/Bundesliga-Stats\n\n### squad stats\n\n```{r}\nbuli_squad_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_squad_stats_hinrunde.csv\"),\n skip = 1, col_names = TRUE)\n\nbuli_squad_stats_hinrunde <- buli_squad_stats_hinrunde_raw %>% \n rename_at(vars(12:16), \n ~ glue::glue(\"{colnames(buli_squad_stats_hinrunde_raw)[12:16]}_p90\")) %>% \n rename_at(vars(20:24), \n ~ glue::glue(\"{colnames(buli_squad_stats_hinrunde_raw)[20:24]}_p90\"))\n\nbuli_squad_stats_hinrunde <- buli_squad_stats_hinrunde %>% \n rename_at(vars(2:24), ~ glue::glue(\"{colnames(buli_squad_stats_hinrunde)[2:24]}_squad\")) %>% \n rename_at(vars(contains(\"_1\")), ~ str_replace(., \"_1\", \"\"))\n\nglimpse(buli_squad_stats_hinrunde)\n```\n\n```{r}\n## save\nsaveRDS(buli_squad_stats_hinrunde, file = glue(\"{here::here()}/data/buli_squad_stats_hinrunde.RDS\"))\nbuli_squad_stats_hinrunde <- readRDS(file = glue(\"{here::here()}/data/buli_squad_stats_hinrunde.RDS\"))\n```\n\n### player stats\n\n```{r}\nbuli_player_stats_hinrunde_raw <- read_csv(here::here(\"data/buli_player_stats_hinrunde.csv\"),\n skip = 1, col_names = TRUE)\n\nbuli_player_stats_hinrunde <- buli_player_stats_hinrunde_raw %>% \n rename_at(vars(17:21), \n ~ glue::glue(\"{colnames(buli_player_stats_hinrunde_raw)[17:21]}_p90\")) %>% \n rename_at(vars(25:29), \n ~ glue::glue(\"{colnames(buli_player_stats_hinrunde_raw)[25:29]}_p90\"))\n\nbuli_player_stats_hinrunde <- buli_player_stats_hinrunde %>% \n rename_at(vars(contains(\"_1\")), ~ str_replace(., \"_1\", \"\")) %>% \n select(-Matches, -Rk)\n \n\nglimpse(buli_player_stats_hinrunde)\n```\n\n```{r}\n## save\nsaveRDS(buli_player_stats_hinrunde, file = glue(\"{here::here()}/data/buli_player_stats_hinrunde.RDS\"))\nbuli_player_stats_hinrunde <- readRDS(file = glue(\"{here::here()}/data/buli_player_stats_hinrunde.RDS\"))\n```\n\n\n## clean\n\n```{r}\ngoal_contribution_clean_df <- buli_player_stats_hinrunde %>% \n left_join(buli_squad_stats_hinrunde, by = \"Squad\") %>% \n separate(Player, into = c(\"fullname\", \"allname\"), sep = \"\\\\\\\\\") %>% \n separate(fullname, into = c(\"firstname\", \"lastname\"),\n sep = \"\\\\s\", extra = \"merge\",\n remove = FALSE) %>%\n mutate(fname = str_extract(firstname, \"[A-Z]{1}\")) %>% \n ## players like Fabinho listed without Tavares last name\n mutate(player = if_else(is.na(lastname), firstname, lastname)) %>% \n mutate(player = case_when(\n !is.na(lastname) ~ glue(\"{fname}. {lastname}\"),\n TRUE ~ firstname)) %>% \n group_by(fullname) %>% \n mutate(goal_contrib = Gls / Gls_squad,\n assist_contrib = Ast / Gls_squad) %>% \n ungroup() %>% \n ## keep fullname so can differentiate A. Gomes (Andre/Angel), etc.\n select(player, fullname, Pos, Squad, Min,\n Gls, Gls_squad, PK, PK_squad, \n Ast, Ast_squad,\n goal_contrib, assist_contrib,\n npxG_p90, xA_p90, npxG, xA) \n\nglimpse(goal_contribution_clean_df)\n```\n\n\n\n## plot\n\n```{r}\ngoal_contribution_clean_df %>% \n filter(Min >= 900,\n Pos %in% c(\"FW\", \"FWMF\")) %>% \n summarize(avg_goal_contrib = median(goal_contrib),\n avg_assist_contrib = median(assist_contrib))\n```\n\n\n### goals & assists\n\n\n```{r fig.width = 14, fig.height = 10} \n## Description text\ndesc_andersson <- \"Union Berlin had a rought start to their maiden Bundesliga season but Andersson stepped up to scoring vitals goals in wins against fellow relegation candidates like Mainz and FC Köln\"\n\ndesc_weghorst <- \"With \"\n\ndesc_nieder <- \"Niederlechner is on course to beat his best Bundesliga season (11 Goals | 3 Assists with Freiburg in 16/17) by quite a margin with 8 goals and 6 assists so far. His total contribution (goals and assists) equals to half of Augburg's goals in the hinrunde.\"\n\ndesc_volland <- \"Volland is the fulcrum of Leverkusen's bid for a consecutive appearance in the Champions League with 5 goals and 6 assists. He tallied up 0.45 xG per 90 (11th in the league) and 0.28 xA per 90 (10th) in the Hinrunde.\"\n\n## PLOT!\ngoal_contribution_matrix <- goal_contribution_clean_df %>% \n ggplot(aes(assist_contrib, goal_contrib)) +\n geom_point(data = goal_contribution_clean_df %>%\n filter(goal_contrib < 0.2 | assist_contrib < 0.15),\n color = \"grey20\", size = 4, alpha = 0.2) +\n geom_point(data = goal_contribution_clean_df %>%\n filter(goal_contrib > 0.2 | assist_contrib > 0.15),\n color = \"red\", size = 4) +\n geom_hline(yintercept = 0.157, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 0.08, color = \"grey20\", alpha = 0.4) +\n geom_text_repel(\n data = goal_contribution_clean_df %>%\n filter(goal_contrib > 0.2 | assist_contrib > 0.15, \n !player %in% c(\"S. Andersson\", \"W. Weghorst\", \n \"F. Niederlechner\", \"K. Volland\")),\n aes(label = player, family = \"Roboto Condensed\", fontface = \"bold\"), \n seed = 15, size = 4, \n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5) +\n geom_mark_circle(\n aes(filter = player == \"S. Andersson\", \n label = \"Sebastian Andersson\",\n description = desc_andersson), \n label.width = unit(65, 'mm'), label.buffer = unit(5, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12)) +\n geom_mark_hull(\n aes(filter = player == \"W. Weghorst\", \n label = \"Wout Weghorst\",\n description = desc_weghorst),\n label.width = unit(45, 'mm'), label.buffer = unit(5, \"mm\"), label.fontsize = c(14, 11),\n label.family = \"Roboto Condensed\") +\n geom_mark_hull(\n aes(filter = player == \"F. Niederlechner\", \n label = \"Florian Niederlechner\",\n description = desc_nieder), \n concavity = 1,\n label.width = unit(55, 'mm'), label.buffer = unit(0.1, \"mm\"),\n label.fontsize = c(14, 12), label.family = \"Roboto Condensed\") +\n geom_mark_hull(\n aes(filter = player == \"K. Volland\", \n label = \"Kevin Volland\",\n description = desc_volland), \n concavity = 1,\n label.width = unit(65, 'mm'), label.buffer = unit(40.5, \"mm\"),\n label.fontsize = c(14, 12), label.family = \"Roboto Condensed\") +\n scale_x_continuous(labels = percent_format(accuracy = 1), \n breaks = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3),\n limits = c(0, 0.35)) +\n scale_y_continuous(labels = percent_format(accuracy = 1), \n breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5),\n limits = c(0, 0.57)) +\n labs(title = \"Goal Involvement: Bundesliga (2019-2020 Season)\", \n subtitle = glue(\"\n Goal Involvement (Goals or Assists) as Percentage of Total Club Goals\n Hinrunde | January 13th, 2020\"),\n caption = glue(\"\n Data: FBref | StatsBomb\n Ryo Nakagawara, Twitter: @R_by_Ryo\"),\n x = \"Percentage of Club Goals Assisted\",\n y = \"Percentage of Club Goals Scored\") +\n theme_minimal() +\n theme(text = element_markdown(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 20),\n plot.subtitle = element_text(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12),\n panel.grid.minor.x = element_blank())\n\ngoal_contribution_matrix\n```\n\n\n\n```{r fig.width = 14, fig.height = 10} \n## Description text\ndesc_labels <- c(\n\"Union Berlin had a rought start to their maiden Bundesliga season but Andersson stepped up to scoring vitals goals in wins against fellow relegation candidates like Mainz and FC Köln\",\n\n\"With \",\n\n\"Niederlechner is on course to beat his best Bundesliga season (11 Goals | 3 Assists with Freiburg in 16/17) by quite a margin with 8 goals and 6 assists so far. His total contribution (goals and assists) equals to half of Augburg's goals in the hinrunde.\",\n\n\"Volland is the fulcrum of Leverkusen's bid for a consecutive appearance in the Champions League with 5 goals and 6 assists. He tallied up 0.45 xG per 90 (11th in the league) and 0.28 xA per 90 (10th) in the Hinrunde.\")\n\n## PLOT!\ngoal_contribution_matrix <- goal_contribution_clean_df %>% \n ggplot(aes(assist_contrib, goal_contrib)) +\n geom_point(data = goal_contribution_clean_df %>%\n filter(goal_contrib < 0.2 | assist_contrib < 0.15),\n color = \"grey20\", size = 4, alpha = 0.2) +\n geom_point(data = goal_contribution_clean_df %>%\n filter(goal_contrib > 0.2 | assist_contrib > 0.15),\n color = \"red\", size = 4) +\n geom_hline(yintercept = 0.157, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 0.08, color = \"grey20\", alpha = 0.4) +\n geom_text_repel(\n data = goal_contribution_clean_df %>%\n filter(goal_contrib > 0.2 | assist_contrib > 0.15, \n !player %in% c(\"S. Andersson\", \"W. Weghorst\", \n \"F. Niederlechner\", \"K. Volland\")),\n aes(label = player, family = \"Roboto Condensed\", fontface = \"bold\"), \n seed = 15, size = 4, \n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5) +\n geom_mark_circle(\n aes(filter = player %in% c(\"S. Andersson\", \"W. Weghorst\", \n \"F. Niederlechner\", \"K. Volland\"), \n description = desc_labels), \n label.width = unit(65, 'mm'), label.buffer = unit(5, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12)) +\n scale_x_continuous(labels = percent_format(accuracy = 1), \n breaks = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3),\n limits = c(0, 0.35)) +\n scale_y_continuous(labels = percent_format(accuracy = 1), \n breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5),\n limits = c(0, 0.57)) +\n labs(title = \"Goal Involvement: Bundesliga (2019-2020 Season)\", \n subtitle = glue(\"\n Goal Involvement (Goals or Assists) as Percentage of Total Club Goals\n Hinrunde | January 13th, 2020\"),\n caption = glue(\"\n Data: FBref | StatsBomb\n Ryo Nakagawara, Twitter: @R_by_Ryo\"),\n x = \"Percentage of Club Goals Assisted\",\n y = \"Percentage of Club Goals Scored\") +\n theme_minimal() +\n theme(text = element_markdown(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 20),\n plot.subtitle = element_text(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12),\n panel.grid.minor.x = element_blank())\n\ngoal_contribution_matrix\n```\n\n\n\n\n\n\n\n\n#### save\n\n```{r}\nggsave(plot = goal_contribution_matrix, \n here::here(\"Premier League 2019-2020/output/goal_contribution_plot_1920_MD20.png\"),\n height = 9, width = 11)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = here::here(\"Premier League 2019-2020/output/goal_contribution_plot_1920_MD20.png\"),\n logo_path = \"https://upload.wikimedia.org/wikipedia/en/f/f2/Premier_League_Logo.svg\",\n logo_position = \"top right\",\n logo_scale = 6)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n here::here(\"Premier League 2019-2020/output/goal_contribution_plot_1920_MD20_logo.png\"))\n```\n\n\n\n\n### xG \n\n\n```{r}\ngoal_contribution_clean_df %>% \n filter(Min >= 900,\n Pos %in% c(\"FW\", \"FWMF\")) %>% \n summarize(avg_npxg90 = median(npxG_p90),\n avg_xA = median(xA_p90))\n\ngoal_contribution_clean_df %>% \n filter(Min >= 900,\n Pos %in% c(\"FW\")) %>% \n summarize(avg_npxg90 = median(npxG_p90),\n avg_xA = median(xA_p90))\n```\n\n\n```{r}\nxG_xA_per90 <- goal_contribution_clean_df\n```\n\n```{r}\nxG_xA_per90 %>% \n filter(Min >= 900,\n Pos %in% c(\"FW\", \"FWMF\")) %>% \n summarize(avg_npxg90 = median(npxG_p90),\n avg_xA = median(xA_p90))\n```\n\n- Lewa: 14 > 12 np 8.3 np-xG\n- Muller: 0.32 xG per 90 (Kovac), 0.4 xG per 90 (Flick)\n-- 512 mins Flick 0.53 xA per 90 (Kovac), 0.58 xA per 90 (Flick)\n- Gnabry:\n-- \n\n- Plea: 0.48 npxG per 90, 0.28 xA per 90\n- Thuram: 0.39 npxG per 90, 0.27 xA per 90\n- Embolo: 0.34 npxG per 90, 0.27 xA per 90\n\n```{r}\ndesc_bayern <- \"Despite Niko Kovac's poor tactics & his eventual sacking, Bayern maintained great attacking output mainly through Robert Lewandowski's great finishing (12 np Goals from 8.3 np xG under Kovac)! Thomas Müller, having been frozen out by Kovac, got back to form under new manager Hansi Flick (0.32 xG per 90 vs. 0.4 xG per 90 & 0.53 xA per 90 vs. 0.58 xA per 90). Serge Gnabry has been a consistent threat throughout while Phil Coutinho has been doing well after a slow start.\"\n\ndesc_gladbach <- \"Although he has cooled off a bit from an electric 4 goals & 4 assists in the first 7 games, Alassane Plea still provides the most threat with a team-leading 0.48 np-xG per 90 & 0.28 xA per 90 (Patrick Herrmann with 0.54 xG per 90 & 0.32 xA per 90 just misses out having only played 790 minutes). Plea is supported by the new arrivals Breel Embolo & Marcus Thuram who complete this dynamic trident that excels on transition plays.\"\n```\n\n\n```{r fig.width = 12, fig.height = 10}\nxG_xA_per90_plot <- xG_xA_per90 %>% \n filter(Min >= 900) %>% \n ggplot(aes(xA_p90, npxG_p90)) +\n geom_point(data = xG_xA_per90 %>%\n filter(xA_p90 < 0.15 | npxG_p90 < 0.3,\n Min >= 900),\n color = \"grey20\", size = 4, alpha = 0.2) +\n geom_point(data = xG_xA_per90 %>%\n filter(xA_p90 > 0.15 | npxG_p90 > 0.3,\n Min >= 900),\n color = \"red\", size = 4) +\n geom_hline(yintercept = 0.3, alpha = 0.6) +\n geom_vline(xintercept = 0.15, alpha = 0.6) +\n ## All player labels\n geom_text_repel(\n data = xG_xA_per90 %>%\n filter(xA_p90 > 0.15 | npxG_p90 > 0.3,\n !player %in% c(\"R. Lewandowski\", \n \"S. Gnabry\", \"T. Müller\",\n \"P. Coutinho\",\n \"M. Thuram\", \n \"B. Embolo\", \"A. Pléa\",\n \"K. Volland\", \n \"F. Niederlechner\",\n \"T. Werner\"),\n Min >= 900),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n seed = 15, size = 3.5,\n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5) +\n ## Separate player\n geom_text(data = xG_xA_per90 %>%\n filter(player %in% c(\"T. Werner\", \n \"F. Niederlechner\", \n \"K. Volland\")),\n aes(label = player, family = \"Roboto Condensed\",\n fontface = \"bold\"),\n size = 3.5, nudge_x = 0.01, hjust = 0) +\n ## Bayern player labels\n geom_text_repel(\n data = xG_xA_per90 %>%\n filter(player %in% c(\"R. Lewandowski\", \"P. Coutinho\",\n \"S. Gnabry\", \"T. Müller\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n seed = 15, size = 4.5, color = \"red\",\n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5, nudge_y = 0.05) +\n ## Gladbach player labels\n geom_text_repel(\n data = xG_xA_per90 %>%\n filter(player %in% c(\"M. Thuram\", \n \"B. Embolo\", \"A. Pléa\")),\n aes(label = player, family = \"Roboto Condensed\", \n fontface = \"bold\"),\n seed = 15, size = 4.5, color = \"#228B22\",\n min.segment.length = 0, segment.color = NA,\n point.padding = 0.5) +\n ## Bayern description\n geom_mark_hull(\n aes(filter = player %in% c(\"R. Lewandowski\", \n \"S. Gnabry\", \n \"T. Müller\",\n \"P. Coutinho\"),\n label = \"Bayern's Attack Remains Strong.\",\n description = desc_bayern),\n expand = unit(2.5, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(130, 'mm'), label.buffer = unit(5, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 12),\n label.colour = c(\"red\", \"black\")) +\n ## Gladbach description\n geom_mark_hull(\n aes(filter = player %in% c(\"M. Thuram\", \n \"B. Embolo\"), \n label = \"Gladbach's Attacking Trident\",\n description = desc_gladbach),\n expand = unit(0.05, \"mm\"), con.cap = unit(0, \"mm\"),\n label.width = unit(65, 'mm'), label.buffer = unit(49, \"mm\"),\n label.family = \"Roboto Condensed\", label.fontsize = c(14, 11),\n label.colour = c(\"#228B22\", \"black\")) +\n geom_mark_circle(\n aes(filter = player == \"A. Pléa\"),\n expand = unit(3, \"mm\"), label.width = unit(50, 'mm'),\n label.buffer = unit(30, \"mm\"), label.fontsize = c(14, 11),\n label.family = \"Roboto Condensed\", \n label.colour = c(\"#228B22\", \"black\")) +\n ## Gladbach desc.\n annotate(\"segment\",\n x = 0.288, xend = 0.37,\n y = 0.48, yend = 0.48) +\n annotate(\"segment\",\n x = 0.37, xend = 0.37,\n y = 0.48, yend = 0.348) +\n ## xG and xA league average\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.05, y = 0.94, hjust = 0, #color = \"red\",\n label = \"Average xA per 90: 0.15\") +\n annotate(\"text\", family = \"Roboto Condensed\", fontface = \"bold\",\n x = 0.62, y = 0.29, #color = \"red\",\n label = \"Average np-xG per 90: 0.3\") +\n scale_x_continuous(labels = seq(0, 0.9, 0.1), \n breaks = seq(0, 0.9, 0.1),\n limits = c(0, 0.65)) +\n scale_y_continuous(labels = seq(0, 0.9, 0.1), \n breaks = seq(0, 0.9, 0.1),\n limits = c(0, 0.95)) +\n labs(title = \"Gladbach's Trident & Bayern's Attackers Lead the League in xG per 90 & xA per 90\", \n subtitle = glue(\"\n Bundesliga (2019-2020) | Hinrunde | January 14th, 2020\n
Average (Median) for Midfielders/Forwards | Minimum 900 Minutes Played\"),\n caption = glue(\"\n Data: FBref | StatsBomb\n Ryo Nakagawara, Twitter: @R_by_Ryo\"),\n x = \"Expected Assists (xA) per 90\",\n y = \"non-Penalty Expected Goals (np-xG) per 90\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n plot.title = element_markdown(size = 18),\n plot.subtitle = element_markdown(size = 16),\n plot.caption = element_text(size = 14),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12),\n panel.grid.minor.x = element_blank())\n\nxG_xA_per90_plot\n```\n\n#### save\n\n```{r}\nggsave(plot = xG_xA_per90_plot, \n here::here(\"Bundesliga 2019-2020/output/xA_xG_per90_1920_hinrunde.png\"),\n height = 10, width = 12)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = here::here(\"Bundesliga 2019-2020/output/xA_xG_per90_1920_hinrunde.png\"),\n logo_path = here::here(\"../soccer_match_reports/img/Bundesliga_logo_(2017).svg\"),\n logo_position = \"top right\",\n logo_scale = 14)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n here::here(\"Bundesliga 2019-2020/output/xA_xG_per90_1920_hinrunde_logo.png\"))\n```\n\n\n\n\n\n\n\n"
},
{
"path": "Champions League & Europa League 2019-2020/europa_league_eloRatings.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"9/1/2019\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)\n```\n\n# Packages\n\n```{r}\npacman::p_load(tidyverse, scales, lubridate, \n ggrepel, glue, extrafont,\n polite, rvest)\nloadfonts(quiet = TRUE)\n```\n\n\n# Elo Ratings 8.31.19\n\n```{r}\n## Elo Ratings from 8.31.19\nelo_ratings_raw <- read.csv(\"http://api.clubelo.com/2019-08-31\")\n```\n\n\n# Europa League\n\n## webscrape\n\n```{r}\nurl <- \"https://en.wikipedia.org/wiki/2019%E2%80%9320_UEFA_Europa_League_group_stage\"\n\nsession <- bow(url)\n\nEL_teams <- scrape(session) %>% \n html_nodes(\".wikitable th+ td\") %>% \n html_text() %>% \n as_tibble() %>% \n rename(team_name = value) %>% \n mutate(team_name = team_name %>% trimws())\n\ncountry_league <- scrape(session) %>% \n html_nodes(\"th+ td .thumbborder\") %>% \n html_attr(\"alt\") %>% \n as_tibble() %>% \n rename(country_league = value)\n\nEL_teams_clean <- EL_teams %>% \n bind_cols(country_league)\n```\n\n## clean\n\n```{r}\nEL_teams_df <- EL_teams_clean %>% \n mutate(team_name = team_name %>% \n iconv(from = \"UTF-8\", to = \"ASCII//TRANSLIT\"),\n elo_name = case_when(\n team_name == \"Qarabag\" ~ \"Karabakh Agdam\",\n team_name == \"F91 Dudelange\" ~ \"Dudelange\",\n team_name == \"Copenhagen\" ~ \"FC Kobenhavn\",\n team_name == \"Malmo FF\" ~ \"Malmoe\",\n team_name == \"Krasnodar\" ~ \"FC Krasnodar\",\n team_name == \"Sporting CP\" ~ \"Sporting\",\n team_name == \"PSV Eindhoven\" ~ \"PSV\",\n team_name == \"Eintracht Frankfurt\" ~ \"Frankfurt\",\n team_name == \"Standard Liege\" ~ \"Standard\",\n team_name == \"Vitoria de Guimaraes\" ~ \"Guimaraes\",\n team_name == \"CSKA Moscow\" ~ \"CSKA Moskva\",\n team_name == \"Ludogorets Razgrad\" ~ \"Razgrad\",\n team_name == \"Ferencvaros\" ~ \"Ferencvaros\",\n team_name == \"VfL Wolfsburg\" ~ \"Wolfsburg\",\n team_name == \"KAA Gent\" ~ \"Gent\",\n team_name == \"Saint-Etienne\" ~ \"Saint-Etienne\",\n team_name == \"Oleksandriya\" ~ \"Olexandriya\",\n team_name == \"Borussia Monchengladbach\" ~ \"Gladbach\",\n team_name == \"Istanbul Basaksehir\" ~ \"Bueyueksehir\",\n team_name == \"Wolfsberger AC\" ~ \"Wolfsberg\",\n team_name == \"Beşiktas\" ~ \"Besiktas\",\n team_name == \"Wolverhampton Wanderers\" ~ \"Wolves\",\n team_name == \"Manchester United\" ~ \"Man United\",\n team_name == \"Astana\" ~ \"FK Astana\",\n team_name == \"AZ\" ~ \"Alkmaar\",\n TRUE ~ team_name\n )) %>% \n ## join Club info to Elo data\n left_join(elo_ratings_raw, by = c(\"elo_name\" = \"Club\")) %>% \n janitor::clean_names() %>% \n select(-level, -from, -to, -elo_name) %>% \n ## fill out group names per 4 rows\n mutate(group = rep(LETTERS[1:12], each = 4, length.out = 48) %>% \n as.factor()) %>% \n ## per group stats\n group_by(group) %>% \n mutate(avg_elo = mean(elo),\n med_elo = median(elo),\n max_elo = max(elo),\n min_elo = min(elo)) %>% \n ungroup() %>% \n ## manually change names\n ## manually spread out the labels\n mutate(\n team_name = case_when(\n team_name == \"Wolverhampton Wanderers\" ~ \"Wolves\",\n team_name == \"PSV Eindhoven\" ~ \"PSV\",\n team_name == \"Borussia Monchengladbach\" ~ \"Gladbach\",\n team_name == \"Sporting CP\" ~ \"Sporting\",\n team_name == \"Vitoria de Guimaraes\" ~ \"Vitoria S.C.\",\n TRUE ~ team_name),\n elo_2 = case_when(\n team_name == \"CFR Cluj\" ~ elo - 10,\n team_name == \"Sporting\" ~ elo + 10,\n team_name == \"PSV\" ~ elo - 10,\n team_name == \"Braga\" ~ elo + 10,\n team_name == \"Besiktas\" ~ elo - 10,\n team_name == \"AZ\" ~ elo + 10,\n team_name == \"Partizan\" ~ elo - 5,\n TRUE ~ elo),\n group = forcats::fct_reorder(group, med_elo))\n```\n\n\n## plot\n\n```{r, fig.height = 7, fig.width=15}\nEL_teams_df %>% \n ggplot(aes(x = group, y = elo, group = group)) +\n geom_segment(aes(x = group, xend = group,\n y = max_elo, yend = min_elo,\n group = group),\n size = 2.25, color = \"lightgrey\") +\n geom_point(aes(y = med_elo, group = group),\n size = 4.5, color = \"red\") +\n geom_text(aes(y = elo_2, label = team_name), \n vjust = 0.5,\n size = 4.5, family = \"Roboto Condensed\",\n show.legend = FALSE) +\n geom_curve(aes(x = 12.8, xend = 12.1, \n y = 1675, yend = 1675),\n arrow = arrow(length = unit(0.07, \"inch\")), \n size = 0.5, color = \"black\", curvature = 0.35) +\n geom_text(x = 12.85, y = 1675,\n hjust = 0, color = \"red\",\n family = \"Roboto Condensed\",\n size = 4,\n label = glue::glue(\"\n Median ELO \n (per group)\")) +\n scale_x_discrete(expand = expand_scale(add = c(0.5, 1.75))) +\n labs(title = \"Europa League (2019/2020) Elo Ratings\",\n subtitle = \"Ratings as of August 31st, 2019\",\n x = \"Group (Ordered by Median Elo Rating per Group)\", y = \"Elo Rating\",\n caption = \"@R_by_Ryo Source: ClubElo.com\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n plot.title = element_text(size = 22),\n plot.subtitle = element_text(size = 18),\n plot.caption = element_text(size = 14, hjust = 0),\n axis.title = element_text(size = 16),\n axis.text = element_text(size = 14))\n```\n\n\n```{r}\nggsave(filename = here::here(\n \"Champions League & Europa League 2019-2020/outputs/euroleague_eloPlot2.png\"),\n width = 15, height = 7)\n```\n\n\n\n# Champions League\n\n## webscrape\n\n```{r}\nurl2 <- \"https://en.wikipedia.org/wiki/2019%E2%80%9320_UEFA_Champions_League_group_stage\"\n\nsession2 <- bow(url2)\n\nCL_teams <- scrape(session2) %>% \n html_nodes(\"h3+ .wikitable .flagicon+ a\") %>% \n html_text() %>% \n as_tibble() %>% \n rename(team_name = value) %>% \n mutate(team_name = team_name %>% trimws())\n\ncountry_leagueCL <- scrape(session2) %>% \n html_nodes(\"h3+ .wikitable .thumbborder\") %>% \n html_attr(\"alt\") %>% \n as_tibble() %>% \n rename(country_league = value)\n\nCL_teams_clean <- CL_teams %>% \n bind_cols(country_leagueCL)\n```\n\n\n## clean\n\n```{r}\nCL_teams_df <- CL_teams_clean %>% \n mutate(\n team_name = team_name %>% \n iconv(from = \"UTF-8\", to = \"ASCII//TRANSLIT\"),\n elo_name = case_when(\n team_name == \"Paris Saint-Germain\" ~ \"Paris SG\",\n team_name == \"Club Brugge\" ~ \"Brugge\",\n team_name == \"Bayern Munich\" ~ \"Bayern\",\n team_name == \"Tottenham Hotspur\" ~ \"Tottenham\",\n team_name == \"Olympiacos\" ~ \"Olympiakos\",\n team_name == \"Red Star Belgrade\" ~ \"Crvena Zvezda\",\n team_name == \"Manchester City\" ~ \"Man City\",\n team_name == \"Shakhtar Donetsk\" ~ \"Shakhtar\",\n team_name == \"Atletico Madrid\" ~ \"Atletico\",\n team_name == \"Bayer Leverkusen\" ~ \"Leverkusen\",\n team_name == \"Lokomotiv Moscow\" ~ \"Lok Moskva\",\n team_name == \"Red Bull Salzburg\" ~ \"Salzburg\",\n team_name == \"Borussia Dortmund\" ~ \"Dortmund\",\n team_name == \"Inter Milan\" ~ \"Inter\",\n team_name == \"Slavia Prague\" ~ \"Slavia Praha\",\n team_name == \"Zenit Saint Petersburg\" ~ \"Zenit\",\n TRUE ~ team_name)) %>% \n ## join Club info to Elo data\n left_join(elo_ratings_raw, by = c(\"elo_name\" = \"Club\")) %>% \n janitor::clean_names() %>% \n select(-level, -from, -to, -elo_name) %>% \n ## fill out group names per 4 rows\n mutate(group = rep(LETTERS[1:12], each = 4, length.out = 32) %>% \n as.factor()) %>% \n ## per group stats\n group_by(group) %>% \n mutate(avg_elo = mean(elo),\n med_elo = median(elo),\n max_elo = max(elo),\n min_elo = min(elo)) %>% \n ungroup() %>% \n mutate(group = forcats::fct_reorder(group, med_elo),\n elo_2 = case_when(\n team_name == \"RB Leipzig\" ~ elo + 10,\n team_name == \"Benfica\" ~ elo - 10,\n team_name == \"Shakhtar\" ~ elo + 10,\n team_name == \"Atalanta\" ~ elo - 10,\n TRUE ~ elo))\n```\n\n\n## plot\n\n```{r, fig.height = 7, fig.width=15}\nCL_teams_df %>% \n ggplot(aes(x = group, y = elo, group = group)) +\n geom_segment(aes(x = group, xend = group,\n y = max_elo, yend = min_elo,\n group = group),\n size = 2.25, color = \"lightgrey\") +\n geom_point(aes(y = med_elo, group = group),\n size = 4.5, color = \"red\") +\n geom_text(aes(y = elo_2, label = team_name), \n #nudge_y = 10,\n vjust = 0.5,\n size = 4.5, family = \"Roboto Condensed\",\n show.legend = FALSE) +\n geom_curve(aes(x = 8.8, xend = 8.1, \n y = 1825, yend = 1825),\n arrow = arrow(length = unit(0.07, \"inch\")), \n size = 0.5, color = \"black\", curvature = 0.35) +\n geom_text(x = 8.85, y = 1825,\n hjust = 0, color = \"red\",\n family = \"Roboto Condensed\",\n size = 4,\n label = glue::glue(\"\n Median ELO \n (per group)\")) +\n scale_x_discrete(expand = expand_scale(add = c(0.5, 1.35))) +\n labs(title = \"Champions League (2019/2020) Elo Ratings\",\n subtitle = \"Ratings as of August 31st, 2019\",\n x = \"Group (Ordered by Median Elo Rating per Group)\", \n y = \"Elo Rating\",\n caption = \"@R_by_Ryo Source: ClubElo.com\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n plot.title = element_text(size = 22),\n plot.subtitle = element_text(size = 18),\n plot.caption = element_text(size = 14, hjust = 0),\n axis.title = element_text(size = 16),\n axis.text = element_text(size = 14))\n```\n\n\n\n```{r}\nggsave(filename = here::here(\n \"Champions League & Europa League 2019-2020/outputs/champleague_eloPlot2.png\"),\n width = 15, height = 7)\n```\n\n\n\n\n\n```{r}\ntop3_teams <- CL_teams_df %>% \n group_by(group) %>% \n arrange(desc(elo), .by_group = TRUE) %>% \n mutate(group_rank = row_number()) %>% \n filter(group_rank != 4) %>% \n group_by(group) %>% \n summarize(avg_top3_elo = mean(elo),\n med_top3_elo = median(elo),\n max_top3_elo = max(elo),\n min_top3_elo = min(elo))\n\nCL_top3_df <- CL_teams_df %>% \n left_join(top3_teams, by = \"group\")\n```\n\n\n\n\n```{r, fig.height = 7, fig.width=15}\nCL_top3_df %>% \n mutate(group = forcats::fct_reorder(group, med_top3_elo)) %>% \n ggplot(aes(x = group, y = elo, group = group)) +\n geom_segment(aes(x = group, xend = group,\n y = max_top3_elo, yend = min_top3_elo,\n group = group),\n size = 2.25, color = \"lightgrey\") +\n geom_point(aes(y = med_top3_elo, group = group),\n size = 4.5, color = \"red\") +\n geom_text(aes(y = elo_2, label = team_name), \n vjust = 0.5,\n size = 4.5, family = \"Roboto Condensed\",\n show.legend = FALSE) +\n geom_segment(aes(x = 8.6, xend = 8.05, \n y = 1840, yend = 1875),\n arrow = arrow(length = unit(0.09, \"inch\")), \n size = 0.5, color = \"black\") +\n geom_text(x = 8.65, y = 1840,\n hjust = 0, color = \"red\",\n family = \"Roboto Condensed\",\n size = 4,\n label = glue::glue(\"\n Median ELO \n (per group)\")) +\n scale_x_discrete(expand = expand_scale(add = c(0.5, 1.35))) +\n labs(title = \"Champions League (2019/2020) Elo Ratings\",\n subtitle = \"Ratings as of August 31st, 2019 | Median of Top Three Teams per Group\",\n x = \"Group (Ordered by Median Elo Rating per Group)\", \n y = \"Elo Rating\",\n caption = \"@R_by_Ryo Source: ClubElo.com\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n plot.title = element_text(size = 22),\n plot.subtitle = element_text(size = 18),\n plot.caption = element_text(size = 14, hjust = 0),\n axis.title = element_text(size = 16),\n axis.text = element_text(size = 14))\n```\n\n\n```{r}\nggsave(filename = here::here(\n \"Champions League & Europa League 2019-2020/outputs/champleague_top3_eloPlot.png\"),\n width = 15, height = 7)\n```\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
},
{
"path": "Copa America 2019/1-copa_america2019.md",
"content": "Another summer and another edition of the Copa América! Along with the\nAfrica Cup of Nations, Nations League finals, the Women’s World Cup,\nUnder-21 European Championship AND the Gold Cup this is yet another\nsoccer-filled season after last year’s World Cup and the Asian Cup\nearlier this year (I also did a blog post on these last two tournaments\nwhich you can see [here (World\nCup)](https://ryo-n7.github.io/2018-06-29-visualize-worldcup/) and [here\n(Asian Cup)](https://ryo-n7.github.io/2019-01-11-visualize-asian-cup/)).\nThere is so much football going on at once even I can’t keep up,\nespecially with the time difference! To not redo all the previous\nvisualizations with Copa América data I tried to find new sources of\ndata and other forms of visualizations to give some insight into the\nplayers and teams competing to be the champion of South America. You can\nfind all the code I used in this blogpost here and you can also find\nother soccer related data viz in my\n[soccer\\_ggplot](https://github.com/Ryo-N7/soccer_ggplots) Github repo.\n\nThe sections will go from a very macro-level view of the **historical\nrecords** of the tournament, to the **squads** competing, the teams’\n**match record** in the Copa América, and finally to a micro-level view\nof various attacking players using **xG** statistics.\n\n¡Vámonos!\n\nPackages\n--------\n\n``` r\nlibrary(dplyr) ## data wrangling\nlibrary(tidyr) ## data wrangling\nlibrary(purrr) ## data wrangling and iteration\nlibrary(stringr) ## data wrangling\nlibrary(rvest) ## webscraping\nlibrary(polite) ## webscraping (Github only pkg)\nlibrary(ggplot2) ## plotting\nlibrary(scales) ## plotting scales\nlibrary(ggimage) ## images for flags\nlibrary(ggforce) ## plotting text labels\nlibrary(cowplot) ## plotting grid\nlibrary(glue) ## text\nlibrary(ggrepel) ## plotting text labels\nlibrary(magick) ## plotting\nlibrary(DT) ## tables\nlibrary(ggtextures) ## soccer ball emoji as geom_col()\nlibrary(extrafont) ## fonts: Roboto Condensed\n\nloadfonts()\n```\n\ntheme\\_copaAmerica\n------------------\n\nI wanted to have all the plots in this blogpost to have a consistent\ncolor theme. As the tournament is going to be held in Brazil, I went\nwith a color theme based on its flag with blue, yellow, and green being\nthe primary colors.\n\n``` r\ntheme_copaAmerica <- function(\n title.size = 24,\n subtitle.size = 14,\n caption.size = 8,\n axis.text.size = 14,\n axis.text.x.size = 12,\n axis.text.y.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(size = 0.5, color = \"white\"),\n panel.grid.major.y = element_line(size = 0.5, color = \"white\"),\n panel.grid.minor.x = element_blank(),\n panel.grid.minor.y = element_blank(),\n axis.ticks = element_line(color = \"white\")) {\n ## Theme:\n theme(text = element_text(family = \"Roboto Condensed\", color = \"white\"),\n plot.title = element_text(family = \"Roboto Condensed\", face = \"bold\", \n size = title.size, color = \"yellow\"),\n plot.subtitle = element_text(size = subtitle.size),\n plot.caption = element_text(size = caption.size),\n panel.background = element_rect(fill = \"#009b3a\"),\n plot.background = element_rect(fill = \"#002776\"),\n axis.text = element_text(size = axis.text.size, color = \"white\"),\n axis.text.x = element_text(size = axis.text.x.size, color = \"white\"),\n axis.text.y = element_text(size = axis.text.y.size, color = \"white\"),\n axis.title = element_text(size = axis.title.size),\n axis.line.x = element_blank(),\n axis.line.y = element_blank(),\n panel.grid.major.x = panel.grid.major.x,\n panel.grid.major.y = panel.grid.major.y,\n panel.grid.minor.x = panel.grid.minor.x,\n panel.grid.minor.y = panel.grid.minor.y,\n strip.text = element_text(color = \"yellow\", face = \"bold\", \n size = strip.text.size, \n margin = margin(4.4, 4.4, 4.4, 4.4)),\n strip.background = element_blank(),\n axis.ticks = axis.ticks\n )\n}\n```\n\nTop Goal Scorers // Goleadores\n------------------------------\n\nFor this plot I took the stats from the Spanish version of the Wikipedia\npage as it had more content. I used `purrr::flatten_df()` to squish the\nlist output into a dataframe then set the names of each column using\n`purrr::set_names()`.\n\n``` r\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_top_scorers <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(95)\") %>% \n html_table() %>% \n flatten_df() %>% \n set_names(c(\"player\", \"country\", \"goals\")) %>% \n mutate(image = \"https://www.emoji.co.uk/files/microsoft-emojis/activity-windows10/8356-soccer-ball.png\")\n```\n\n``` r\nglimpse(copa_top_scorers)\n```\n\n ## Observations: 22\n ## Variables: 4\n ## $ player \"Norberto Méndez\", \"Zizinho\", \"Lolo Fernández\", \"Sever...\n ## $ country \"ARG Argentina\", \"BRA Brasil\", \"PER Perú\", \"URU Urugua...\n ## $ goals 17, 17, 15, 15, 13, 13, 13, 13, 13, 12, 12, 11, 11, 11...\n ## $ image \"https://www.emoji.co.uk/files/microsoft-emojis/activi...\n\nLike in the Asian Cup blogpost I use [Claus\nWilke](https://twitter.com/ClausWilke/)’s\n[ggtextures](https://github.com/clauswilke/ggtextures) package to use\n**soccer ball emoji** as the column image in the plot.\n\n``` r\ncopa_goleadores_raw_plot <- copa_top_scorers %>% \n head(5) %>% \n ggplot(aes(x = reorder(player, goals), y = goals,\n image = image)) +\n geom_isotype_col(img_width = grid::unit(1, \"native\"), img_height = NULL,\n ncol = NA, nrow = 1, hjust = 0, vjust = 0.5) +\n geom_text(aes(label = goals, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18),\n expand = c(0, 0), \n limits = c(0, 19)) +\n labs(title = \"Top Scorers of the Copa América\",\n subtitle = glue(\"\n Most goals in a single tournament: 9 \n Humberto Maschio (Argentina), Javier Ambrois (Uruguay), Jair (Brazil)\"),\n y = \"Number of Goals\", x = NULL,\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 26,\n subtitle.size = 16,\n caption.size = 12,\n axis.text.size = 18,\n axis.title.size = 18,\n panel.grid.major.y = element_blank(),\n axis.ticks = element_blank())\n\n## Add flags to y-axis:\naxis_image <- axis_canvas(copa_goleadores_raw_plot, axis = 'y') + \n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 16.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/1/1a/Flag_of_Argentina.svg\", \n y = 12.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/f/fe/Flag_of_Uruguay.svg\", \n y = 9, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/d/df/Flag_of_Peru_%28state%29.svg\", \n y = 5.25, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 1.5, scale = 1.8)\n\ncopa_goleadores_plot <- ggdraw(insert_yaxis_grob(copa_goleadores_raw_plot, axis_image, position = \"left\"))\ncopa_goleadores_plot\n```\n\n\n\nMost of these players aren’t ones you might recognize. The Copa América\nused to be held a lot more regularly (and sometimes erratically) until\nthis century so players had a lot more opportunities to score goals. All\nfive of the players you see here played in the 1930s-1950s when there\nwas a tournament every one or two years. Out of currently active\nplayers, Peruvian legend Paolo Guerrero has 11 goals along with Eduardo\nVargas (from Chile). (Edit: after the Chile - Japan game, Vargas is on\n12…) Another player you might recognize that was actually tied with\nAdemir for 5th place, along with three other players, was Gabriel\nBatistuta (“Batigol”).\n\nWinners of the Copa América\n---------------------------\n\nAfter grabbing the data from the Wikipedia page I used a variety of\nfunctions to clean and reshape the dataset like `tidyr::separate()` to\nsplit the number of occurences and the year.\n\n``` r\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_campeones <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(10)\") %>% \n html_table() %>% \n flatten_df()\n\ncopa_campeones_limpia <- copa_campeones %>% \n janitor::clean_names() %>% \n slice(1:8) %>% \n select(1:4) %>% \n set_names(c(\"team\", \"winners\", \"runners_up\", \"third_place\")) %>% \n separate(winners, into = c(\"Champions\", \"first_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(runners_up, into = c(\"Runners-up\", \"second_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(third_place, into = c(\"Third Place\", \"third_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n mutate_all(list(~str_replace_all(., \"–\", \"0\"))) %>% \n mutate_at(vars(contains(\"num\")), funs(as.numeric)) %>% \n gather(key = \"key\", value = \"value\", -team, \n -first_place_year, -second_place_year, -third_place_year) %>% \n mutate(key = as.factor(key),\n value = as.numeric(value),\n team = team %>% str_replace(., \"[A-Z]{3}\", \"\") %>% str_trim(.),\n team = case_when(team == \"Brasil\" ~ \"Brazil\",\n TRUE ~ team)) %>% \n mutate(key = forcats::fct_relevel(key, \n \"Champions\",\n \"Runners-up\",\n \"Third Place\")) %>% \n arrange(key, desc(value)) %>% \n mutate(team = forcats::as_factor(team),\n order = row_number())\n```\n\nI also wanted to add flags to this plot but\n`cowplot::insert_yaxis_grob()` is unfortunately not compatible with\nfacets. I used `stringr::str_wrap()` to format the subtitle nicely while\nI used `glue::glue()` to avoid having the use ‘’ to create a new line\nfor the caption.\n\n``` r\ncopa_ganadores_plot <- copa_campeones_limpia %>% \n ggplot(aes(value, forcats::fct_rev(team), color = key)) +\n geom_point(size = 10) + # 10\n geom_text(aes(label = value), \n size = 5, color = \"black\", # 5 \n family = \"Roboto Condensed\", fontface = \"bold\") +\n scale_color_manual(values = c(\"Champions\" = \"#FFCC33\",\n \"Runners-up\" = \"#999999\",\n \"Third Place\" = \"#CC6600\"),\n guide = FALSE) +\n scale_x_continuous(breaks = c(1, 5, 10, 15),\n labels = c(1, 5, 10, 15),\n limits = c(-1, 16)) +\n labs(x = \"Number of Occurrence\", y = NULL,\n title = \"Most Successful Teams of the Copa América!\",\n subtitle = str_wrap(\"Ordered by number of Copa América(s) won. Argentina missed the chance to leapfrog Uruguay after consecutive final losses in the previous two tournaments!\", width = 80),\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n facet_wrap(~key) +\n theme_copaAmerica(subtitle.size = 14, \n caption.size = 10)\n\ncopa_ganadores_plot\n```\n\n\n\nWhat’s surprising to note is that Pele never won a Copa América with\nBrazil, although he did get Best Player and Top Scorer in the 1959\nedition of the tournament. Even more bizarrely Diego Maradona has never\nwon it either! He didn’t play in either of the 1991 and 1993 editions\nwhere Argentina won their 13th and 14th Copas.\n\nCopa América Squad Profiles\n---------------------------\n\nWe just looked at what happened in the past but who are the players\ncompeting in the tournament this year? To take a quick look I\nweb-scraped the squads of each of the competing teams from Wikipedia.\n\nI created a list of the `xpath`s for each of squads and using\n`purrr::map()` I grabbed the data for each participating country. After\nI got some meta-information about the country name and the group I\ncreated a list-column that stores the squad data as a dataframe in its\nown column. To explode this out I used `tidyr::unnest()` to reshape the\nentire dataframe to have one row with all the data for each player in\nevery squad.\n\nTo get a clean dataset I use some `stringr::str_*()` functions to\nproperly format the character strings such as the player positions,\nages, date of births.\n\n``` r\nsquads_df_clean <- squads_df_raw %>% \n janitor::clean_names() %>% \n select(-delete, squad_num = no, \n position = pos, birth_age = date_of_birth_age) %>% \n mutate(position = position %>% str_replace_all(., \"[1-9]\", \"\"),\n birth_age = birth_age %>% str_extract_all(., pattern = \"\\\\([^()]+\\\\)\")) %>% unnest(birth_age) %>% \n group_by(player) %>% \n mutate(colnum = seq_along(player)) %>% \n spread(key = colnum, value = birth_age) %>% \n ungroup() %>% \n select(everything(), dob = `1`, age = `2`) %>% \n mutate(dob = dob %>% str_replace_all(., \"[()]\", \"\") %>% lubridate::as_date(),\n age = age %>% str_extract(., \"[0-9]+\") %>% as.integer,\n country = forcats::fct_relevel(country, \n \"Brazil\", \"Argentina\", \"Uruguay\", \n \"Peru\", \"Qatar\", \"Chile\", \n \"Venezuela\", \"Paraguay\", \"Japan\", \n \"Bolivia\", \"Colombia\", \"Ecuador\",\n ),\n club = case_when(\n club == \"Barcelona\" & country == \"Ecuador\" ~ \"Barcelona (Ecuador)\",\n TRUE ~ club))\n```\n\n``` r\nglimpse(squads_df_clean)\n```\n\n ## Observations: 276\n ## Variables: 12\n ## $ name 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,...\n ## $ group \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A...\n ## $ country Brazil, Brazil, Brazil, Brazil, Brazil, Brazil,...\n ## $ squad_num 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ...\n ## $ position \"GK\", \"DF\", \"DF\", \"DF\", \"MF\", \"DF\", \"FW\", \"MF\",...\n ## $ player \"Alisson\", \"Thiago Silva\", \"Miranda\", \"Marquinh...\n ## $ caps 36, 79, 57, 36, 36, 40, 3, 10, 29, 65, 49, 15, ...\n ## $ goals 0, 7, 3, 1, 0, 2, 1, 0, 16, 8, 14, 1, 7, 0, 0, ...\n ## $ club \"Liverpool\", \"Paris Saint-Germain\", \"Internazio...\n ## $ country_league \"England\", \"France\", \"Italy\", \"France\", \"Spain\"...\n ## $ dob 1992-10-02, 1984-09-22, 1984-09-07, 1994-05-14...\n ## $ age 26, 34, 34, 25, 27, 33, 22, 22, 22, 30, 27, 28,...\n\n### Age-histogram\n\nUsing this data I can plot a bunch of histograms:\n\n``` r\nage_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_age = median(age)) %>% \n ungroup() %>% \n ggplot(aes(x = age)) +\n geom_histogram(fill = \"red\", binwidth = 1) +\n geom_vline(aes(xintercept = median_age), size = 1.2) +\n geom_label(aes(x = median_age, y = 8, \n label = glue::glue(\"Median: {median_age}\")),\n nudge_x = 0.5, hjust = 0.1, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Age Distribution of Copa América squads\",\n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Age\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0),\n breaks = scales::pretty_breaks()) +\n theme_copaAmerica(title.size = 22,\n subtitle.size = 14, \n caption.size = 8,\n axis.text.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\")) +\n facet_wrap(~country, ncol = 3)\n \nage_country_plot\n```\n\n\n\nIn terms of age, Japan have the youngest team with a median of 21, 4\nyears younger than the next youngest team, Qatar. The rest have a fairly\nbalanced spread of ages from 20 to early-mid 30s with most of the\nmedians hovering around 27 years of age. The reason for Japan’s\nextremely young squad is due to the fact that the full-strength Japan\nteam has played in both the World Cup and the Asian Cup in the past\nyear. Along with the fact that the Tokyo Olympics are next year, it was\ndecided to use the invitation to the Copa América as a trial-by-fire for\nthe young stars of the future. Much like in a real Olympic squad, the\nteam contains three “overage” players in World Cup 2010/2014/2018\ngoalkeeper Eiji Kawashima, Premier League winner Shinji Okazaki, and\nGetafe playmaker Gaku Shibasaki.\n\nThe oldest player will be Brazil captain Dani Alves at 36 with\nParaguay’s Oscar Cardozo only two weeks younger. On the other hand, the\nyoungest player is Japan’s 18-year old prodigy Takefusa Kubo, the\nex-Barcelona youth player who only just recently moved to Real Madrid!\nIn light of his transfer a lot of eyes will be on him to see if he can\nproduce some Captain Tsubasa-esque performances for a very inexperienced\nJapan team gearing up for the Tokyo Olympics!\n\n### Caps histogram\n\nWhen considering the experience of a squad it’s not enough to look at\nages but one needs to look at the caps or appearances for the national\nteam as well.\n\n``` r\ncaps_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_cap = median(caps)) %>% \n ungroup() %>% \n ggplot(aes(x = caps)) +\n geom_histogram(fill = \"red\", binwidth = 5) +\n geom_vline(aes(xintercept = median_cap), size = 1.25) +\n geom_label(aes(x = median_cap, y = 15, \n label = glue::glue(\"Median: {median_cap}\")),\n nudge_x = 0.5, hjust = 0.05, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Caps (Appearances) by Country\", \n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Caps\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0)) +\n theme_copaAmerica(\n title.size = 20,\n subtitle.size = 14, \n caption.size = 10,\n axis.text.size = 10,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(color = \"white\", size = 0.25),\n panel.grid.major.y = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.x = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.y = element_line(color = \"white\", size = 0.25)) +\n facet_wrap(~country, ncol = 3)\n\ncaps_country_plot\n```\n\n\n\nThe majority of Japan’s squad have 0 (ZERO) caps, with the\naforementioned three “overage” players taking up most of the proportion\nof caps on the team. Bolivia are also taking a untested squad with 8 of\ntheir players with 2 caps or less! Chile, Uruguay, and Argentina bring\ntheir veterans with multiple players over or around 100 caps. From this\ndata I was surprised that Jefferson Farfan and Paolo Guerrero didn’t\nhave 100 caps by now…\n\nThe player with the most caps is Lionel Messi (130) followed closely by\nDiego Godin (126), and Alexis Sanchez (124). On the other hand there are\n29 players hopeful of making their first national team appearance at\nthis tournament with the majority (17 players) coming from Japan.\n\n### Goal distribution\n\nNext I looked at the distribution of goals scored by the midfielders and\nstrikers of each team. I found out about using\n`ggplot2::position_nudge()` for slightly adjusting variables on a\ndiscrete scale in similar fashion to the `nudge_y =` and `nudge_x =`\narguments most people might be familiar with from other geoms. I also\nused `ggforce::geom_mark_hull()` to do some labelling.\n\n``` r\ngoals_country_plot <- squads_df_clean %>% \n filter(position %in% c(\"MF\", \"FW\")) %>% \n group_by(country) %>% \n mutate(median = median(goals)) %>% \n ungroup() %>% \n ggplot(aes(x = goals, y = reorder(country, median))) +\n ggridges::geom_density_ridges(fill = \"red\", color = \"white\", scale = 1.1) +\n geom_point(aes(x = median, y = country), position = position_nudge(y = 0.25),\n color = \"yellow\", size = 3) +\n ggforce::geom_mark_hull(aes(filter = country == \"Argentina\" & goals == 67, label = \"Lionel Messi: 67 goals\"),\n label.buffer = unit(15, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 55, label = \"Luis Suarez: 55 goals\"),\n label.buffer = unit(5, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Japan\" & goals == 50, label = \"Shinji Okazaki: 50 goals\"),\n label.buffer = unit(2, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 46, label = \"Edinson Cavani: 46 goals\"),\n label.buffer = unit(25, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Chile\" & goals == 41, label = \"Alexis Sanchez: 41 goals\"),\n label.buffer = unit(4, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n scale_x_continuous(limits = c(0, 73),\n expand = c(0.01, 0.01),\n breaks = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70),\n labels = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70)) +\n expand_limits(y = 13.5) +\n labs(title = \"Distribution of Goals Scored by Midfielders and Strikers\",\n subtitle = \"Copa América 2019 squads, Yellow dot = Median goals\",\n x = \"Goals\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n Data from prior to start of tournament\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18) \n\ngoals_country_plot\n```\n\n ## Picking joint bandwidth of 2.07\n\n\n\nWith a lot of these players being more defensively minded or new players\nthe distribution is heavily skewed but you can see little mounds showing\nthe top goalscorers for each country and see which countries have their\ngoalscorers spread out among multiple players such as Brazil, Qatar, and\nPeru.\n\nIf you know your South American players you can take a good guess at who\nare the top goal scorers for each nation. For Colombia the two outlying\nmounds are obviously James Rodriguez and Falcao, for example.\nVenezuela’s top scorer with 22 is Salomon Rondon and for Brazil, if not\nfor his injury, a lonesome mound would have appeared for Neymar with 60\ngoals!\n\n### Player contribution by league\n\nNow let’s check the player contribution to the squads at the Copa\nAmérica by league. I’m just going to use the country that the league is\nfrom for simplicity’s sake. Originally I wanted to `left_join()` it with\na ‘country <> domestic league’ table but couldn’t find one and the\nleague names itself aren’t very meaningful or have awful sponsor names\nthat obfuscate the country of origin even further.\n\n``` r\nplayer_contrib_league_plot <- squads_df_clean %>% \n group_by(country_league) %>%\n summarize(n = n()) %>%\n ungroup() %>% \n ggplot(aes(y = n, x = reorder(country_league, n))) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 4.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(labels = c(0, 5, 10, 15, 20, 25),\n breaks = c(0, 5, 10, 15, 20, 25),\n limits = c(0, 30),\n expand = c(0, 0)) +\n labs(title = \"Breakdown of Player Contributions by League\",\n subtitle = glue(\"\n Shown as Country Name \n Mexico (Liga MX) contributed 27 players to South American squads\"),\n x = \"League (Country name)\", y = \"Number of players\",\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12,\n caption.size = 10, \n axis.text.size = 14,\n axis.text.y.size = 11,\n axis.title.size = 16,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\"))\n\nplayer_contrib_league_plot\n```\n\n\n\nThe best of the best players from South American countries will move on\nto Europe so the Argentinean league (Superliga Argentina) and the\nBrazilian league (Brasileirão - Serie A) do not have as many players as\nyou might think and as a consequence, the top leagues of England, Spain,\nand Italy contribute quite a bit! A lot of the better players but not\nquite elite South American players might go to Mexico instead of a\nlower-mid European league. With the growth of the MLS a fair number of\nplayers ply their trade there as well.\n\nWe can take a more detailed look by creating a table of the proportion\nof players from each squad coming from either a domestic league or any\nother league. I had to do a lot of wrangling to get the proper output\nfor the table. After calculating the percentage of domestic players from\na country’s domestic league I added the full data back in. Then I had to\nmake sure that for each country, the country - domestic league country\nwas the first row in each of the country groups (so Bolivia - Bolivia,\nBolivia, China, Japan - Japan, Japan - England, etc.). By doing this I\ncan automatically `tidyr::fill()`-in the rest of the rows of that\ncountry with the ‘percentage of players from domestic league stat’.\n\n``` r\nsquads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n filter(country == country_league) %>% \n mutate(perc_from_domestic_league = percent(player_from_league / 23, accuracy = 0.1)) %>% \n right_join(squads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n ungroup()) %>% \n mutate(first = case_when(\n country == country_league ~ 1,\n TRUE ~ 0)) %>% \n arrange(country, desc(first)) %>% \n fill(perc_from_domestic_league) %>% \n group_by(country) %>% \n mutate(perc_from_league = percent(player_from_league / 23, accuracy = 0.1),\n country_league = glue::glue(\"{country_league} - league\")) %>% \n arrange(desc(player_from_league)) %>% \n select(Country = country, `League (country name)` = country_league,\n `Number of players from league` = player_from_league,\n `Percentage of players from league` = perc_from_league,\n `Percentage of players from domestic league` = perc_from_domestic_league) %>% \n DT::datatable(rownames = FALSE)\n```\n\n ## Joining, by = c(\"country\", \"country_league\", \"player_from_league\")\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n\n\nThree interesting facts I found:\n\n- 30% of players on the Brazil squad play for an English team, most\n out of any league - squad combination excluding domestic leagues.\n- 100% of the Qatar squad play in their domestic league!\n- Only one Uruguayan player (4.3%) plays in its domestic league.\n\n### Player contribution by club\n\nIn the final plot for this section, I looked at the top 10 clubs\ncontributing the most players to the tournament. I used\n`arrange(desc(n)) %>% slice()` instead of `top_n()` as there were too\nmany teams tied at 4 players. To set the team names inside the bars I\ncreated a midpoint value `midval` that calculated a value half of the\nnumber of players contributed so the labels were placed neatly.\n\n``` r\nplayer_contrib_club_plot <- squads_df_clean %>% \n group_by(club) %>% \n summarize(n = n()) %>% \n mutate(club = club %>% forcats::as_factor() %>% forcats::fct_reorder(n),\n midval = n / 2) %>% \n arrange(desc(n)) %>% \n slice(1:15) %>% \n ggplot(aes(x = club, y = n)) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n geom_text(aes(y = midval, label = club, \n family = \"Roboto Condensed\", fontface = \"bold\"),\n size = 5, color = \"white\") +\n coord_flip() +\n scale_y_continuous(breaks = scales::pretty_breaks(),\n expand = c(0, 0),\n limits = c(0, 10.5)) +\n labs(title = \"Top 15 Clubs contributing the most players to the Copa América\",\n x = \"Club\", y = \"Number of players\",\n caption = \"Source: Wikipedia\") +\n theme_copaAmerica(\n title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\")) +\n theme(axis.text.y = element_blank(),\n axis.ticks.y = element_blank())\n\nplayer_contrib_club_plot\n```\n\n\n\nWith 100% of its players coming from the domestic league it’s not\nsurprise that the Qatari team, Al-Sadd, is contributing the most players\nto the tournament. Tied with another Qatari team, Mexican club America\nfeatures 7 players yet none of them are Mexicans (2 Argentineans, 2\nColombians, 1 Ecuadorian, 1 Chilean, and 1 Paraguayan).\n\nAt first I thought Barcelona contributed 8 players until I realized the\nEcuadorian players were coming from the Ecuadorian team called\nBarcelona…I had to go all the way back up to the beginning of this\nsection to fix that small peculiarity. As futbol came to South America\nvia European colonists and immigrants a lot of teams took up the names\nand colors of the teams these Europeans were fond of. Other examples\ninclude Liverpool F.C. (Montevideo, Uruguay), Arsenal de Sarandi (Buenos\nAires, Argentina), and Club Atletico Juventus (Sao Paulo, Brazil -\nalthough they use the colors of Torino F.C.).\n\nIf you download the data and type in the code below you can see the\nentire club-country list.\n\n``` r\nsquads_df_clean %>% \n group_by(club, country) %>% \n summarize(n = n()) %>% View()\n```\n\nMatch Records\n-------------\n\nNow that we got a good look at the composition of the teams, we can take\na look at how they’ve done at every Copa América.\n\nThe next code chunk mainly comes from PH Julien and his excellent Kaggle\nkernel of [“A Journey Through The History of\nSoccer”](https://www.kaggle.com/phjulien/a-journey-through-the-history-of-soccer/).\n\n``` r\n## grab football federation affiliations data\nfederation_files <- Sys.glob(\"../data/federation_affiliations/*\")\n\ndf_federations = data.frame(country = NULL, federation = NULL)\nfor (f in federation_files) {\n federation = basename(f)\n content = read.csv(f, header=FALSE)\n content <- cbind(content,federation=rep(federation, dim(content)[1]))\n df_federations <- rbind(df_federations, content)\n}\n\ncolnames(df_federations) <- c(\"country\", \"federation\")\n\ndf_federations <- df_federations %>% \n mutate(country = as.character(country) %>% str_trim(side = \"both\"))\n\nresults_raw <- readr::read_csv(\"../data/results.csv\")\n\nresults_copa <- results_raw %>% \n filter(tournament == \"Copa América\") %>% \n rename(venue_country = country, \n venue_city = city) %>% \n mutate(match_num = row_number())\n\n## combine with federation affiliations\nresults_copa_home <- results_copa %>% \n left_join(df_federations, \n by = c(\"home_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(home_federation = federation) \n\nresults_copa_away <- results_copa %>% \n left_join(df_federations, \n by = c(\"away_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(away_federation = federation)\n\n## combine home-away\nresults_copa_cleaned <- results_copa_home %>% \n full_join(results_copa_away)\n```\n\nUnfortunately, this data does not have **penalty** results as those\ngames are all counted as a draw (as technically that is the actual\nresult). Considering there a lot of cagey knock-out rounds that finish\nin a penalty shoot-out (including the last two finals…) it is\nunfortunate but that’s just the data you have sometimes. There is a way\nto web-scrape all the Copa América results and assign Win-Lose to those\ngames that went to penalties but I’ll leave that for another time. Also,\nthere is no info on what stage of the tournament the match recorded is\nin.\n\n``` r\nresults_copa_cleaned <- results_copa_cleaned %>% \n mutate(\n home_federation = case_when(\n home_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ home_federation),\n away_federation = case_when(\n away_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ away_federation)) %>% \n select(-contains(\"federation\"), -contains(\"venue\"),\n -neutral, date, home_team, home_score, away_team, away_score, \n tournament, venue_city)\n```\n\n``` r\nglimpse(results_copa_cleaned)\n```\n\n ## Observations: 787\n ## Variables: 8\n ## $ date 1916-07-02, 1916-07-06, 1916-07-08, 1916-07-10, 19...\n ## $ home_team \"Chile\", \"Argentina\", \"Brazil\", \"Argentina\", \"Brazi...\n ## $ away_team \"Uruguay\", \"Chile\", \"Chile\", \"Brazil\", \"Uruguay\", \"...\n ## $ home_score 0, 6, 1, 1, 1, 0, 4, 4, 1, 4, 5, 1, 6, 2, 0, 3, 4, ...\n ## $ away_score 4, 1, 1, 1, 2, 0, 0, 2, 0, 0, 0, 0, 0, 3, 2, 1, 1, ...\n ## $ tournament \"Copa América\", \"Copa América\", \"Copa América\", \"Co...\n ## $ match_num 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...\n ## $ venue_city \"Buenos Aires\", \"Buenos Aires\", \"Buenos Aires\", \"Bu...\n\nNow that it’s nice and cleaned up I created a function that reshapes the\ndata so that it’s set from a certain team’s perspective with the “team”\nargument. You can also set the function to look for only results against\na certain opponent by filling in the `versus` argument.\n\n``` r\ncopaAmerica_resultados <- function(data, team, versus = NA) {\n \n ## team of interest: ex. 'Brazil'\n team_var <- enquo(team)\n \n todos_partidos <- data %>% \n ## filter only for results of team of interest\n filter(home_team == !!team_var | away_team == !!team_var) %>% \n ## reshape columns to team vs. opponent\n mutate(\n opponent = case_when(\n away_team != !!team_var ~ away_team,\n home_team != !!team_var ~ home_team),\n home_away = case_when(\n home_team == !!team_var ~ \"home\",\n away_team == !!team_var ~ \"away\"),\n equipo_goals = case_when(\n home_team == !!team_var ~ home_score,\n away_team == !!team_var ~ away_score),\n opp_goals = case_when(\n home_team != !!team_var ~ home_score,\n away_team != !!team_var ~ away_score)) %>% \n ## label results from team's perspective\n mutate(\n result = case_when(\n equipo_goals > opp_goals ~ \"Win\",\n equipo_goals < opp_goals ~ \"Loss\",\n equipo_goals == opp_goals ~ \"Draw\")) %>% \n mutate(result = result %>% forcats::as_factor() %>% forcats::fct_relevel(c(\"Win\", \"Draw\", \"Loss\"))) %>% \n select(-contains(\"score\"), -contains(\"team\"), -match_num) %>% \n rename(Date = date, Tournament = tournament, `Venue` = venue_city, Opponent = opponent, `Home / Away` = home_away,\n `Goals For` = equipo_goals, `Goals Against` = opp_goals, Result = result)\n \n if (is.na(versus) | is.null(versus)) {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n ## sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n ## spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric)\n \n missing_cols <- c(\"Win\", \"Draw\", \"Loss\") %>% \n map_dfr( ~tibble(!!.x := numeric()))\n \n resultados_totalmente <- resultados_totalmente %>% \n bind_rows(missing_cols) %>% \n mutate(Win = if_else(is.na(Win), 0, Win),\n Draw = if_else(is.na(Draw), 0, Draw),\n Loss = if_else(is.na(Loss), 0, Loss)) %>%\n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n } else { \n ## opponent: ex. 'Argentina'\n todos_partidos <- todos_partidos %>% \n filter(Opponent == versus)\n \n if (nrow(todos_partidos) == 0) {\n return(glue(\"{team} has never played {versus} at the Copa América!\")) \n } else {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n # sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n # spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric) %>% \n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n }\n }\n}\n```\n\nThe output is either a dataframe of all the games a team has been\ninvolved in as well as the record of the team against other teams in the\nCopa América or a message saying that the team you picked has never\nplayed against the opponent you picked.\n\n### Japan\n\n``` r\ncopaAmerica_resultados(data = results_copa_cleaned, \n team = \"Japan\", versus = \"Brazil\")\n```\n\n ## Japan has never played Brazil at the Copa América!\n\nOh… that’s right Japan has never played against Brazil at the Copa…\n\n``` r\nresultados_japon <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Japan\")\n```\n\n ## Warning: Unknown levels in `f`: Win\n\n``` r\nresultados_japon[[2]] %>% \n DT::datatable(caption = \"Japan's record in the Copa América\", rownames = FALSE)\n```\n\n\n\nJapan’s only previous journey to the Copa América was in the 1999\nedition where they lost all 3 games. They were invited for the 2011\nedition but withdrew due to the Tohoku Earthquake and were replaced by\nCosta Rica. Japanese football has come a long way since 1999 but with a\nyoung squad it will be a uphill battle to get 3 points against any of\ntheir Group C opponents, Uruguay, Chile, and Ecuador.\n\n### Colombia\n\n``` r\nresultados_colombia <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Colombia\") \n\nresultados_colombia[[2]] %>% \n DT::datatable(caption = \"Colombia's record in the Copa América\", rownames = FALSE)\n```\n\n\n\nDespite a recent resurgence of the Colombia national team they have not\nbeen able to match the feats of the 2001 side that won the Copa with\ntheir best place finish since then coming 3rd in 2004. The 2001 team\nwere not only unbeaten but also did not concede a single goal throughout\nthe tournament!\n\n### Superclasico Sudamericano: Brazil vs. Argentina\n\n``` r\nresultados_de_brazil <- copaAmerica_resultados(data = results_copa_cleaned, \n team = \"Brazil\", versus = \"Argentina\")\n\nresultados_de_brazil[[1]] %>% \n DT::datatable(caption = \"Brazil vs. Argentina in the Copa América\", rownames = FALSE)\n```\n\n\n\n``` r\nresultados_de_brazil[[2]] %>% \n DT::datatable(caption = \"Brazil vs. Argentina in the Copa América\", rownames = FALSE)\n```\n\n\n\nBrazil does not have a good overall record vs. Argentina but they have\nnot lost against their rivals at the Copa América since the 1991\nedition. The “draw” in 2004 was actually in the final where they won 4-2\non penalties.\n\nWhat I found odd was that the Copa América seems to have a very low\npriority to certain countries, especially Brazil who have repeatedly\nsent their B or C teams to the tournament in favor of sending their best\nteam to other tournaments or resting star players. Funnily enough these\nunderstrength Brazilian squads have actually won the entire tournament a\nfew times, most notably in 2007 against a full strength Argentina side\ncontaining the likes of Zanetti, Riquelme, Cambiasso, Tevez, a young\nMessi/Mascherano, Cambiasso, et al!\n\nPlayer Profiles\n---------------\n\nAfter looking at the history of the competition and the composition of\nthe squads I examined the players and their form coming into the Copa\nAmérica. In recent years football analytics has really taken off and\nthere have been many strides made in creating more informative\nstatistics to assess players’ abilities, the most prominently being the\n**xG** statistics. This is the first time I talk about **xG** in any\nlength/depth so this introduction is as much to solidify my\nunderstanding as well as yours!\n\n### What IS xG?\n\n- **xG**: Quantitative measure (between 0 and 1) that assigns a\n probability that a shot taken will result in a goal based on a\n variety of variables and is used for evaluating the quality of\n chances and predicting players’ and teams’ future performances.\n\n- **xA**: Quantitative measure (between 0 and 1) that assigns a\n probability that a given pass will result in an assist for a goal\n based on a variety of variables.\n\nCommon variables used in the models that output xG statistics are the\ndistance and angle of a shot, the body part used, rebound, among others.\nSimilar to how you might assess your favorite striker’s chances of\nscoring just as he is lining up to take a shot: Is the shot a header? Is\nhe trying to score from a cross in regular play or a corner kick? Are\nthere a crowd of defenders in front of him or is he one-on-one with the\ngoalkeeper? Etc. You might think **who** takes a shot would be a genuine\nfactor but in actuality it tells you a lot less about the chances of a\ngoal compared to the location of the shot.\n\nNote that there isn’t a SINGLE xG model. You can check out a blog post\ncomparing different people’s xG models\n[here](https://mackayanalytics.nl/2017/06/19/how-accurate-are-xg-models-ii-the-big-chance-dilemma/).\nPeople and organizations (from Statsbomb to OptaPro) have their own\nideas about what **could** be the important variables in play and as\nsuch it’s important to report from which source you got your data from\nas the stats can differ between models. A few things xG does not factor\nin are things like goalkeeper performance (someone pulling off\nincredible saves or letting in a poor shot) and one must also consider\nthe fact that team style of play and the quality of a player’s\nteammates. When judging players based on these stats it is important to\nbe aware of contextual factors like the team they play for, their\nopponent, and the player’s position/role in the team.\n\nFrom xG and xA more granular statistics such as xGChain and xGBuildup\nwere created to be able to dig a little deeper into who is contributing\nto chance creation, I’ll introduce the latter two a bit later. As the\nfield has grown new statistics have popped up such as [Karun\nSingh](https://twitter.com/karun1710/)’s “expected threat” or xT. You\ncan check out an introduction to xT from\n[here](https://karun.in/blog/expected-threat.html).\n\nOf course, these statistics only tell a part of the story and are\ndefinitenly not the be-all-and-end-all. In the context of this current\nblog post, these stats only tell the story about how these players did\nfor their club teams this past season rather than for their national\nteam. Even still it gives us a good idea of what kind of form these\nplayers are in coming into this tournament.\n\nYou might also want to watch these Youtube videos by\n[TifoFootball](https://www.youtube.com/channel/UCGYYNGmyhZ_kwBF_lqqXdAQ)\nfor a quick primer on [xG](https://www.youtube.com/watch?v=zSaeaFcm1SY)\nand [xA](https://www.youtube.com/watch?v=1MdlkuzLdj4).\n\n### understat data\n\nFor the data I used the website, `understat.com`. Their xG models were\ncreated via training a neural network on a dataset consisting of over\n100,000 shots using more than 10 different variables. Getting data from\n`understat` has been made easy by Ewen Henderson’s `understatr` package\navailable from [Github](https://github.com/ewenme/understatr) (he’s also\nthe guy that made the [ghibli](https://github.com/ewenme/ghibli) color\npalette!). I tried to pick a wide selection of attacking players but I\nwas also limited by the fact that `understat` only has data for\nteams/players from six European leagues (Premier League, Bundesliga,\nSerie A, La Liga, Ligue 1, and Russian Premier League).\n\nFor **Peru** I would have chosen Paolo Guerrero but as he plays in\nBrazil now I went with Jefferson Farfan (who hasn’t played as many games\nas the other players used for comparison unfortunately…). For **Chile**\nI would pick Eduardo Vargas but he as doesn’t play for a team covered by\nunderstat I went with Alexis Sanchez, who had a woeful season and only\nplayed \\~600 minutes despite appearing in \\~20 league matches and later\nadded Arturo Vidal. For **Brazil** I included Neymar initially but since\nhe won’t actually be playing I’ll keep him for comparison’s sake but\nalso include Gabriel Jesus and Roberto Firmino who have been fighting\nfor the starting striker spot. Note that these two aren’t the ones\nreplacing Neymar **positionally**. In Neymar’s left-wing position I can\nsee David Neres or Phil Coutinho replacing him (Richarlison and Willian\nmostly play on the right). (Edit: In the first match vs. Bolivia, David\nNeres started off on the left while Richarlison played on the right,\nCoutinho played just behind Bobby Firmino)\n\nThe other nation’s strikers/attacking midfielders don’t play for the six\nEuropean leagues covered by understat or like in Shinji Okazaki’s case\njust did not play as many minutes/games during the season. To get the\ndata I created a list of the player codes and use `purrr::map()` to\niterate each through the `understatr::get_player_seasons_stats()`\nfunction.\n\n``` r\nplayer_codes <- c(2097, 2099, 813, ## Messi, Neymar, Rondon\n 498, 4299, 696, ## Alexis, Farfan, Falcao\n 3294, 2098, 5543, ## Cavani, Suarez, G. Jesus\n 482, 1148, 2249, ## Bobby, Duvan, James\n 1089, 3553, 488, ## Cuadrado, Di Maria, Coutinho\n 222) ## Arturo Vidal\n\nunderstat_data <- player_codes %>% \n map(., ~ understatr::get_player_seasons_stats(.x)) %>% \n reduce(bind_rows) %>% \n select(-player_id, -position, -yellow, -red)\n```\n\n``` r\nglimpse(understat_data)\n```\n\n ## Observations: 83\n ## Variables: 15\n ## $ games 34, 36, 34, 33, 38, 17, 20, 30, 34, 33, 32, 36, 38...\n ## $ goals 36, 34, 37, 26, 43, 15, 19, 13, 24, 22, 11, 7, 8, ...\n ## $ shots 170, 196, 179, 158, 187, 55, 91, 105, 124, 95, 89,...\n ## $ time 2704, 2995, 2832, 2726, 3374, 1443, 1797, 2652, 30...\n ## $ xG 25.997169, 28.946281, 26.885174, 27.101910, 35.891...\n ## $ assists 13, 12, 9, 16, 18, 7, 13, 11, 12, 7, 7, 3, 2, 2, 0...\n ## $ xA 15.33516552, 15.10040562, 13.95513140, 15.87127814...\n ## $ key_passes 93, 87, 79, 77, 95, 43, 70, 91, 102, 52, 32, 23, 2...\n ## $ year 2018, 2017, 2016, 2015, 2014, 2018, 2017, 2016, 20...\n ## $ team_name \"Barcelona\", \"Barcelona\", \"Barcelona\", \"Barcelona\"...\n ## $ npg 32, 32, 31, 23, 38, 10, 15, 12, 19, 21, 11, 7, 8, ...\n ## $ npxG 22.280909, 25.973170, 21.682231, 21.899351, 31.432...\n ## $ xGChain 38.459877, 48.180634, 42.525045, 41.996866, 54.753...\n ## $ xGBuildup 10.6987990, 21.6344040, 18.1335122, 15.1963644, 19...\n ## $ player_name \"Lionel Messi\", \"Lionel Messi\", \"Lionel Messi\", \"L...\n\nAs you can see the data consists of a row for each player and each year\n(from the 2014/2015 season to the 2018/2019 season). I tried to mitigate\nthe fact that some players played a lot more minutes than others by\nstandardize everything to a ‘per 90 minutes’ value but this does have\nits own disadvantages. These include the fact that players who play a\nlot of minutes (as regular starting members) may not have as high ‘per\n90’ stat even though their production with all these minutes might\nsuggest that they are consistently performing and producing at a high\nlevel.\n\nIt’ll be a bit crowded (kind of like a spilt box of Skittles…) but let’s\ncheck out the key metrics for all the players at once.\n\nNote: npg = non-penalty goals, npxG = non-penalty goals xG\n\n``` r\ncomparison_data <- understat_data %>% \n filter(year == 2018) %>% \n select(-games, -team_name, -year) %>% \n rename(Shots = shots, KP = key_passes) %>% \n gather(key = \"key\", value = \"value\", -player_name, -time) %>% \n mutate(key = forcats::as_factor(key) %>% \n forcats::fct_relevel(., \n \"xG\", \"goals\", \"npxG\", \"npg\", \n \"xA\", \"assists\", \"xGChain\", \"xGBuildup\",\n \"Shots\", \"KP\"))\n\ncomparison_strikers_plot <- comparison_data %>%\n filter(key != \"Shots\", key != \"KP\",\n key != \"xGBuildup\", key != \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n geom_vline(xintercept = 4.5, size = 2) +\n geom_vline(xintercept = 5.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.26)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Comparison: Top attackers at the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_strikers_plot\n```\n\n\n\nAs usual in these types of charts, Messi is leading a lot of the metrics\nhere and showing consistency too with having played the third highest\namount of minutes out of the selected players. It’s helpful to have the\nxG/xA stats next to the actual goals/assists as it provides an\nindication of whether the player in question is scoring shots that he\nprobabilistically should be scoring. When a player’s actual goal count\nis higher than their xG stat this suggests that the player is\n**“exceeding their xG”** or that they are scoring from shots that are\nhistorically hard to score from. It can be seen as a marker of an elite\nfinisher as they are putting away chances from difficult situations\nconsistently. In terms of assists and xA Alexis Sanchez, who only played\nabout 600 minutes, looks a lot better than in reality due to the\naforementioned disadvantage of standardizing everything to a “per 90\nminutes” value. Normally you would have a cut-off based on a certain\n**minimum amount of minutes** but as I mentioned I was rather limited in\nmy choice of players.\n\nA way to take a closer look at xG - Goals and xA - Assists is to use a\nsimple dot plot with a line going through the 45 degree angle. Those\nbelow the line are underperforming relative to their xG or xA stat,\nthose over it are overachieving (“exceeding” their xG/xA stat) while\nthose just on the line are scoring or assisting right around what the\nmodel expects the player to be. I use non-penalty xG below as penalties\nhave around \\~0.75 xG (give or take a few percentage points depending on\nthe model) and can inflate the stats of those players who take a lot of\npenalties and score them, especially if they weren’t the ones who earned\nthe penalty themselves.\n\n``` r\nexpected_goal_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, npxG, xG, goals) %>% \n mutate_at(c(\"npxG\", \"xG\", \"goals\"), ~. / time * 90) %>% \n ggplot(aes(x = npxG, y = goals, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n scale_x_continuous(limits = c(0, 1.1),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 1.3),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Expected vs. Actual Goals\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"Non-penalty xG per 90 minutes\",\n y = \"Goals per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_goal_plot\n```\n\n\n\nGabriel Jesus is quite clearly below the 45 degree line meaning that he\nhas been very poor at finishing chances (and/or incredibly unlucky).\nAfter a poor World Cup where he scored 0 goals as a starter, he is\nreally going to have to step up to fill Neymar’s goalscoring boots for\nthis tournament. However, his build-up play for City has still been good\nthis past season and he has been scoring for Brazil in the friendlies\nleading up to the tournament so it’s going to be a hard decision for\nTite to decide on who starts against Bolivia (edit: Firmino started and\ncontributed an assist while Jesus replaced him in the 65th minute).\n\n``` r\nexpected_assists_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, xA, assists) %>% \n mutate_at(c(\"xA\", \"assists\"), ~. / time * 90) %>% \n ggplot(aes(x = xA, y = assists, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n labs(title = \"Expected vs. Actual Assists\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"xA per 90 minutes\",\n y = \"Assists per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n scale_x_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_assists_plot\n```\n\n\n\nOne thing to keep in mind is that xA does not take into account the\nrecipient of the assist pass. Even if the pass given had a high expected\nassist value the receiving player still might not have the quality to\nput it away through no fault of the passer. This might explain why most\nof the players with a higher xA among this group don’t have the assists\nto match. It can also be that these players are also the ones playing a\nlot more minutes and the volume of chances they create just aren’t\ntranslating to goals all the time.\n\n### Key Passes, Shots, xGChain, and xGBuildup (per 90)\n\nI separated “key passes” and “shots” as well as “xGChain” and\n“xGBuildup” from the rest as these two sets were on a very different\nscale.\n\n``` r\nkp_shots_plot <- comparison_data %>%\n filter(key == \"Shots\" | key == \"KP\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 6),\n breaks = c(0, 1, 2, 3, 4, 5, 6),\n labels = c(0, 1, 2, 3, 4, 5, 6)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = glue(\"\n KP = Key Passes\n For select group of attacking players with data available from understat.com\"),\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nkp_shots_plot\n```\n\n\n\n- xGChain: Quantitative measure that is the combined sum of the xG of\n every possession that ends in a shot that a player is involved in.\n The same derived value is given to each of the players involved and\n allows us to credit players for attacking contributions outside of\n just shots (xG) and assists (xA).\n\n- xGBuildup: Similar to xGChain but excluding shots and assists. This\n is in response to xGChain values still being dominated by the xG and\n xA from shots and assists, respectively.\n\n``` r\nxgbuildup_xgchain_plot <- comparison_data %>%\n filter(key == \"xGBuildup\" | key == \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.55),\n breaks = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5),\n labels = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nxgbuildup_xgchain_plot\n```\n\n\n\nAlthough Gabriel Jesus has been poor at finishing his chances as seen in\nprevious graphs, his xGChain and xGBuildup stat makes it clear that he\nis still contributing to City’s attack outside of scoring goals himself\n(not to mention all the defensive work he does as well).\n\nFor example below, the stats are able to clearly differentiate between\nJames, who is more of a playmaker, compared to Falcao and Duvan who are\ntraditional number 9s with his superior xGBuildup, xGChain, and Key\nPasses values. For a more detailed overview on xGChain and xGBuildup\ncheck out Statsbomb’s article\n[here](https://statsbomb.com/2018/08/introducing-xgchain-and-xgbuildup/).\n\n``` r\n## keep colors for Colombians consistent with other plots\ncolombia_pal <- c(\"#000033\", \"#005300\", \"#009FFF\", \"#00FFBE\")\n\ncomparison_colombia_plot <- comparison_data %>%\n filter(!key %in% c(\"xG\", \"goals\", \"npxG\", \"npg\", \"xA\", \"assists\"),\n player_name %in% c(\"James Rodríguez\", \"Falcao\", \"Duván Zapata\", \"Juan Cuadrado\")) %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.05, 0.05),\n breaks = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4),\n labels = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4)) +\n scale_fill_manual(values = colombia_pal, name = \"Player\") +\n labs(title = \"Comparison: Stars of Colombia\",\n subtitle = \"KP: Key Passes\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 20,\n subtitle.size = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_colombia_plot\n```\n\n\n\nThere are lots of different ways to visualize this data, most famously\nthe radar charts created by [Statsbomb](http://statsbomb.com/). Using\nthe data you can also compare and evaluate players in many different\nways and using `understatr` package you could add a few more players\nlike Paulo Dybala, Miguel Almiron, and more! I could probably do a whole\nother article using just this data but I’ll leave it here for now.\n\nConclusion\n----------\n\nThroughout this blog post I talked about some of the historical records,\nsquad compositions, match records, and finally the player profiles of\nattacking players at this summer’s Copa América. Using the power of R it\nis really easy to webscrape and visualize data in a way that is\ninformative and aesthetically pleasing. I wanted to finish this before\nthe tournament started but other life things got in the way as well as\nthe fact that the amount of content ballooned out of control (especially\nthe xG section) so I had to cut down a lot.\n\nIt’s been fun reading the articles on the Copa América website and\nseeing how far my “intermediate-but-very-out-of-practice”-level of\nSpanish can get me to understand the content, here is one that I\nparticularly liked reading: [14 Estadisticas de la Copa\nAmérica](https://copaamerica.com/es/noticias/a-14-dias-del-inicio-de-la-copa-14-estadisticas-de-la-copa-america).\nWith so many tournaments going on right now (and with the African Cup of\nNations starting in a few days) a lot of the news media is spread thin\nright now but there are still some quality articles out there to read\nabout the Copa, like [this\narticle](https://www.bbc.com/sport/football/48600098) from BBC’s South\nAmerican football expert, Tim Vickery.\n\nAfter the first round of games, a few points of discussion:\n\n- After an extremely lacklustre performance vs. Colombia, how does\n Argentina bounce back? What tactical changes need to be made?\n\n- Qatar impressed against Paraguay but can they pull off a major upset\n vs. Colombia?\n\n- How will Japan line-up against Uruguay after a losing by a scoreline\n that didn’t really do their performance justice? How will manager\n Moriyasu balance experience vs. youth, will he start with veteran\n Okazaki after Ueda’s numerous misses vs. Chile?\n\n- Can Brazil earn a early ticket to the next round vs. Venezuela after\n a clinical but not excellent performance vs. Bolivia? Will they be\n able to keep up their streak of winning the Copa every time they\n have hosted it?\n\nThanks for reading and…\n\n¡Buena suerte a todos equipos!\n"
},
{
"path": "Copa America 2019/COPY-2019-06-18-visualize-copa-america.md",
"content": "---\nlayout: post\ntitle: \"Visualizing the Copa América: Historical Records, Squad Profiles, and Player Profiles with xG statistics!\"\nfb-img: https://i.imgur.com/Elzd0Sc.png\nshare-img: https://i.imgur.com/Elzd0Sc.png\ntags: [brazil, messi, ggplot2, web-scraping, copa-america-2019, soccer, futbol, rvest, tidyverse]\n---\n\nAnother summer and another edition of the Copa América! Along with the\nAfrica Cup of Nations, Nations League finals, the Women’s World Cup,\nUnder-21 European Championship AND the Gold Cup this is yet another\nsoccer-filled season after last year’s World Cup and the Asian Cup\nearlier this year (I also did a blog post on these last two tournaments\nwhich you can see [here (World\nCup)](https://ryo-n7.github.io/2018-06-29-visualize-worldcup/) and [here\n(Asian Cup)](https://ryo-n7.github.io/2019-01-11-visualize-asian-cup/)).\nThere is so much football going on at once even I can’t keep up,\nespecially with the time difference! To not redo all the previous\nvisualizations with Copa América data I tried to find new sources of\ndata and other forms of visualizations to give some insight into the\nplayers and teams competing to be the champion of South America. You can\nfind all the code I used in this blogpost here and you can also find\nother soccer related data viz in my\n[soccer\\_ggplot](https://github.com/Ryo-N7/soccer_ggplots) Github repo.\n\nThe sections will go from a very macro-level view of the **historical\nrecords** of the tournament, to the **squads** competing, the teams’\n**match record** in the Copa América, and finally to a micro-level view\nof various attacking players using **xG** statistics.\n\n¡Vámonos!\n\nPackages\n--------\n\n``` r\nlibrary(dplyr) ## data wrangling\nlibrary(tidyr) ## data wrangling\nlibrary(purrr) ## data wrangling and iteration\nlibrary(stringr) ## data wrangling\nlibrary(rvest) ## webscraping\nlibrary(polite) ## webscraping (Github only pkg)\nlibrary(ggplot2) ## plotting\nlibrary(scales) ## plotting scales\nlibrary(ggimage) ## images for flags\nlibrary(ggforce) ## plotting text labels\nlibrary(cowplot) ## plotting grid\nlibrary(glue) ## text\nlibrary(ggrepel) ## plotting text labels\nlibrary(magick) ## plotting\nlibrary(DT) ## tables\nlibrary(ggtextures) ## soccer ball emoji as geom_col()\nlibrary(extrafont) ## fonts: Roboto Condensed\n\nloadfonts()\n```\n\ntheme\\_copaAmerica\n------------------\n\nI wanted to have all the plots in this blogpost to have a consistent\ncolor theme. As the tournament is going to be held in Brazil, I went\nwith a color theme based on its flag with blue, yellow, and green being\nthe primary colors.\n\n``` r\ntheme_copaAmerica <- function(\n title.size = 24,\n subtitle.size = 14,\n caption.size = 8,\n axis.text.size = 14,\n axis.text.x.size = 12,\n axis.text.y.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(size = 0.5, color = \"white\"),\n panel.grid.major.y = element_line(size = 0.5, color = \"white\"),\n panel.grid.minor.x = element_blank(),\n panel.grid.minor.y = element_blank(),\n axis.ticks = element_line(color = \"white\")) {\n ## Theme:\n theme(text = element_text(family = \"Roboto Condensed\", color = \"white\"),\n plot.title = element_text(family = \"Roboto Condensed\", face = \"bold\", \n size = title.size, color = \"yellow\"),\n plot.subtitle = element_text(size = subtitle.size),\n plot.caption = element_text(size = caption.size),\n panel.background = element_rect(fill = \"#009b3a\"),\n plot.background = element_rect(fill = \"#002776\"),\n axis.text = element_text(size = axis.text.size, color = \"white\"),\n axis.text.x = element_text(size = axis.text.x.size, color = \"white\"),\n axis.text.y = element_text(size = axis.text.y.size, color = \"white\"),\n axis.title = element_text(size = axis.title.size),\n axis.line.x = element_blank(),\n axis.line.y = element_blank(),\n panel.grid.major.x = panel.grid.major.x,\n panel.grid.major.y = panel.grid.major.y,\n panel.grid.minor.x = panel.grid.minor.x,\n panel.grid.minor.y = panel.grid.minor.y,\n strip.text = element_text(color = \"yellow\", face = \"bold\", \n size = strip.text.size, \n margin = margin(4.4, 4.4, 4.4, 4.4)),\n strip.background = element_blank(),\n axis.ticks = axis.ticks\n )\n}\n```\n\nTop Goal Scorers // Goleadores\n------------------------------\n\nFor this plot I took the stats from the Spanish version of the Wikipedia\npage as it had more content. I used `purrr::flatten_df()` to squish the\nlist output into a dataframe then set the names of each column using\n`purrr::set_names()`.\n\n``` r\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_top_scorers <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(95)\") %>% \n html_table() %>% \n flatten_df() %>% \n set_names(c(\"player\", \"country\", \"goals\")) %>% \n mutate(image = \"https://www.emoji.co.uk/files/microsoft-emojis/activity-windows10/8356-soccer-ball.png\")\n```\n\n``` r\nglimpse(copa_top_scorers)\n```\n\n ## Observations: 22\n ## Variables: 4\n ## $ player \"Norberto Méndez\", \"Zizinho\", \"Lolo Fernández\", \"Sever...\n ## $ country \"ARG Argentina\", \"BRA Brasil\", \"PER Perú\", \"URU Urugua...\n ## $ goals 17, 17, 15, 15, 13, 13, 13, 13, 13, 12, 12, 11, 11, 11...\n ## $ image \"https://www.emoji.co.uk/files/microsoft-emojis/activi...\n\nLike in the Asian Cup blogpost I use [Claus\nWilke](https://twitter.com/ClausWilke/)’s\n[ggtextures](https://github.com/clauswilke/ggtextures) package to use\n**soccer ball emoji** as the column image in the plot.\n\n``` r\ncopa_goleadores_raw_plot <- copa_top_scorers %>% \n head(5) %>% \n ggplot(aes(x = reorder(player, goals), y = goals,\n image = image)) +\n geom_isotype_col(img_width = grid::unit(1, \"native\"), img_height = NULL,\n ncol = NA, nrow = 1, hjust = 0, vjust = 0.5) +\n geom_text(aes(label = goals, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18),\n expand = c(0, 0), \n limits = c(0, 19)) +\n labs(title = \"Top Scorers of the Copa América\",\n subtitle = glue(\"\n Most goals in a single tournament: 9 \n Humberto Maschio (Argentina), Javier Ambrois (Uruguay), Jair (Brazil)\"),\n y = \"Number of Goals\", x = NULL,\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 26,\n subtitle.size = 16,\n caption.size = 12,\n axis.text.size = 18,\n axis.title.size = 18,\n panel.grid.major.y = element_blank(),\n axis.ticks = element_blank())\n\n## Add flags to y-axis:\naxis_image <- axis_canvas(copa_goleadores_raw_plot, axis = 'y') + \n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 16.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/1/1a/Flag_of_Argentina.svg\", \n y = 12.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/f/fe/Flag_of_Uruguay.svg\", \n y = 9, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/d/df/Flag_of_Peru_%28state%29.svg\", \n y = 5.25, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 1.5, scale = 1.8)\n\ncopa_goleadores_plot <- ggdraw(insert_yaxis_grob(copa_goleadores_raw_plot, axis_image, position = \"left\"))\ncopa_goleadores_plot\n```\n\n\n\nMost of these players aren’t ones you might recognize. The Copa América\nused to be held a lot more regularly (and sometimes erratically) until\nthis century so players had a lot more opportunities to score goals. All\nfive of the players you see here played in the 1930s-1950s when there\nwas a tournament every one or two years. Out of currently active\nplayers, Peruvian legend Paolo Guerrero has 11 goals along with Eduardo\nVargas (from Chile). (Edit: after the Chile - Japan game, Vargas is on\n12…) Another player you might recognize that was actually tied with\nAdemir for 5th place, along with three other players, was Gabriel\nBatistuta (“Batigol”).\n\nWinners of the Copa América\n---------------------------\n\nAfter grabbing the data from the Wikipedia page I used a variety of\nfunctions to clean and reshape the dataset like `tidyr::separate()` to\nsplit the number of occurences and the year.\n\n``` r\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_campeones <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(10)\") %>% \n html_table() %>% \n flatten_df()\n\ncopa_campeones_limpia <- copa_campeones %>% \n janitor::clean_names() %>% \n slice(1:8) %>% \n select(1:4) %>% \n set_names(c(\"team\", \"winners\", \"runners_up\", \"third_place\")) %>% \n separate(winners, into = c(\"Champions\", \"first_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(runners_up, into = c(\"Runners-up\", \"second_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(third_place, into = c(\"Third Place\", \"third_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n mutate_all(list(~str_replace_all(., \"–\", \"0\"))) %>% \n mutate_at(vars(contains(\"num\")), funs(as.numeric)) %>% \n gather(key = \"key\", value = \"value\", -team, \n -first_place_year, -second_place_year, -third_place_year) %>% \n mutate(key = as.factor(key),\n value = as.numeric(value),\n team = team %>% str_replace(., \"[A-Z]{3}\", \"\") %>% str_trim(.),\n team = case_when(team == \"Brasil\" ~ \"Brazil\",\n TRUE ~ team)) %>% \n mutate(key = forcats::fct_relevel(key, \n \"Champions\",\n \"Runners-up\",\n \"Third Place\")) %>% \n arrange(key, desc(value)) %>% \n mutate(team = forcats::as_factor(team),\n order = row_number())\n```\n\nI also wanted to add flags to this plot but\n`cowplot::insert_yaxis_grob()` is unfortunately not compatible with\nfacets. I used `stringr::str_wrap()` to format the subtitle nicely while\nI used `glue::glue()` to avoid having the use ‘’ to create a new line\nfor the caption.\n\n``` r\ncopa_ganadores_plot <- copa_campeones_limpia %>% \n ggplot(aes(value, forcats::fct_rev(team), color = key)) +\n geom_point(size = 10) + # 10\n geom_text(aes(label = value), \n size = 5, color = \"black\", # 5 \n family = \"Roboto Condensed\", fontface = \"bold\") +\n scale_color_manual(values = c(\"Champions\" = \"#FFCC33\",\n \"Runners-up\" = \"#999999\",\n \"Third Place\" = \"#CC6600\"),\n guide = FALSE) +\n scale_x_continuous(breaks = c(1, 5, 10, 15),\n labels = c(1, 5, 10, 15),\n limits = c(-1, 16)) +\n labs(x = \"Number of Occurrence\", y = NULL,\n title = \"Most Successful Teams of the Copa América!\",\n subtitle = str_wrap(\"Ordered by number of Copa América(s) won. Argentina missed the chance to leapfrog Uruguay after consecutive final losses in the previous two tournaments!\", width = 80),\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n facet_wrap(~key) +\n theme_copaAmerica(subtitle.size = 14, \n caption.size = 10)\n\ncopa_ganadores_plot\n```\n\n\n\nWhat’s surprising to note is that Pele never won a Copa América with\nBrazil, although he did get Best Player and Top Scorer in the 1959\nedition of the tournament. Even more bizarrely Diego Maradona has never\nwon it either! He didn’t play in either of the 1991 and 1993 editions\nwhere Argentina won their 13th and 14th Copas.\n\nCopa América Squad Profiles\n---------------------------\n\nWe just looked at what happened in the past but who are the players\ncompeting in the tournament this year? To take a quick look I\nweb-scraped the squads of each of the competing teams from Wikipedia.\n\nI created a list of the `xpath`s for each of squads and using\n`purrr::map()` I grabbed the data for each participating country. After\nI got some meta-information about the country name and the group I\ncreated a list-column that stores the squad data as a dataframe in its\nown column. To explode this out I used `tidyr::unnest()` to reshape the\nentire dataframe to have one row with all the data for each player in\nevery squad.\n\nTo get a clean dataset I use some `stringr::str_*()` functions to\nproperly format the character strings such as the player positions,\nages, date of births.\n\n``` r\nsquads_df_clean <- squads_df_raw %>% \n janitor::clean_names() %>% \n select(-delete, squad_num = no, \n position = pos, birth_age = date_of_birth_age) %>% \n mutate(position = position %>% str_replace_all(., \"[1-9]\", \"\"),\n birth_age = birth_age %>% str_extract_all(., pattern = \"\\\\([^()]+\\\\)\")) %>% unnest(birth_age) %>% \n group_by(player) %>% \n mutate(colnum = seq_along(player)) %>% \n spread(key = colnum, value = birth_age) %>% \n ungroup() %>% \n select(everything(), dob = `1`, age = `2`) %>% \n mutate(dob = dob %>% str_replace_all(., \"[()]\", \"\") %>% lubridate::as_date(),\n age = age %>% str_extract(., \"[0-9]+\") %>% as.integer,\n country = forcats::fct_relevel(country, \n \"Brazil\", \"Argentina\", \"Uruguay\", \n \"Peru\", \"Qatar\", \"Chile\", \n \"Venezuela\", \"Paraguay\", \"Japan\", \n \"Bolivia\", \"Colombia\", \"Ecuador\",\n ),\n club = case_when(\n club == \"Barcelona\" & country == \"Ecuador\" ~ \"Barcelona (Ecuador)\",\n TRUE ~ club))\n```\n\n``` r\nglimpse(squads_df_clean)\n```\n\n ## Observations: 276\n ## Variables: 12\n ## $ name 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,...\n ## $ group \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A...\n ## $ country Brazil, Brazil, Brazil, Brazil, Brazil, Brazil,...\n ## $ squad_num 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ...\n ## $ position \"GK\", \"DF\", \"DF\", \"DF\", \"MF\", \"DF\", \"FW\", \"MF\",...\n ## $ player \"Alisson\", \"Thiago Silva\", \"Miranda\", \"Marquinh...\n ## $ caps 36, 79, 57, 36, 36, 40, 3, 10, 29, 65, 49, 15, ...\n ## $ goals 0, 7, 3, 1, 0, 2, 1, 0, 16, 8, 14, 1, 7, 0, 0, ...\n ## $ club \"Liverpool\", \"Paris Saint-Germain\", \"Internazio...\n ## $ country_league \"England\", \"France\", \"Italy\", \"France\", \"Spain\"...\n ## $ dob 1992-10-02, 1984-09-22, 1984-09-07, 1994-05-14...\n ## $ age 26, 34, 34, 25, 27, 33, 22, 22, 22, 30, 27, 28,...\n\n### Age-histogram\n\nUsing this data I can plot a bunch of histograms:\n\n``` r\nage_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_age = median(age)) %>% \n ungroup() %>% \n ggplot(aes(x = age)) +\n geom_histogram(fill = \"red\", binwidth = 1) +\n geom_vline(aes(xintercept = median_age), size = 1.2) +\n geom_label(aes(x = median_age, y = 8, \n label = glue::glue(\"Median: {median_age}\")),\n nudge_x = 0.5, hjust = 0.1, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Age Distribution of Copa América squads\",\n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Age\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0),\n breaks = scales::pretty_breaks()) +\n theme_copaAmerica(title.size = 22,\n subtitle.size = 14, \n caption.size = 8,\n axis.text.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\")) +\n facet_wrap(~country, ncol = 3)\n \nage_country_plot\n```\n\n\n\nIn terms of age, Japan have the youngest team with a median of 21, 4\nyears younger than the next youngest team, Qatar. The rest have a fairly\nbalanced spread of ages from 20 to early-mid 30s with most of the\nmedians hovering around 27 years of age. The reason for Japan’s\nextremely young squad is due to the fact that the full-strength Japan\nteam has played in both the World Cup and the Asian Cup in the past\nyear. Along with the fact that the Tokyo Olympics are next year, it was\ndecided to use the invitation to the Copa América as a trial-by-fire for\nthe young stars of the future. Much like in a real Olympic squad, the\nteam contains three “overage” players in World Cup 2010/2014/2018\ngoalkeeper Eiji Kawashima, Premier League winner Shinji Okazaki, and\nGetafe playmaker Gaku Shibasaki.\n\nThe oldest player will be Brazil captain Dani Alves at 36 with\nParaguay’s Oscar Cardozo only two weeks younger. On the other hand, the\nyoungest player is Japan’s 18-year old prodigy Takefusa Kubo, the\nex-Barcelona youth player who only just recently moved to Real Madrid!\nIn light of his transfer a lot of eyes will be on him to see if he can\nproduce some Captain Tsubasa-esque performances for a very inexperienced\nJapan team gearing up for the Tokyo Olympics!\n\n### Caps histogram\n\nWhen considering the experience of a squad it’s not enough to look at\nages but one needs to look at the caps or appearances for the national\nteam as well.\n\n``` r\ncaps_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_cap = median(caps)) %>% \n ungroup() %>% \n ggplot(aes(x = caps)) +\n geom_histogram(fill = \"red\", binwidth = 5) +\n geom_vline(aes(xintercept = median_cap), size = 1.25) +\n geom_label(aes(x = median_cap, y = 15, \n label = glue::glue(\"Median: {median_cap}\")),\n nudge_x = 0.5, hjust = 0.05, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Caps (Appearances) by Country\", \n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Caps\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0)) +\n theme_copaAmerica(\n title.size = 20,\n subtitle.size = 14, \n caption.size = 10,\n axis.text.size = 10,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(color = \"white\", size = 0.25),\n panel.grid.major.y = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.x = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.y = element_line(color = \"white\", size = 0.25)) +\n facet_wrap(~country, ncol = 3)\n\ncaps_country_plot\n```\n\n\n\nThe majority of Japan’s squad have 0 (ZERO) caps, with the\naforementioned three “overage” players taking up most of the proportion\nof caps on the team. Bolivia are also taking a untested squad with 8 of\ntheir players with 2 caps or less! Chile, Uruguay, and Argentina bring\ntheir veterans with multiple players over or around 100 caps. From this\ndata I was surprised that Jefferson Farfan and Paolo Guerrero didn’t\nhave 100 caps by now…\n\nThe player with the most caps is Lionel Messi (130) followed closely by\nDiego Godin (126), and Alexis Sanchez (124). On the other hand there are\n29 players hopeful of making their first national team appearance at\nthis tournament with the majority (17 players) coming from Japan.\n\n### Goal distribution\n\nNext I looked at the distribution of goals scored by the midfielders and\nstrikers of each team. I found out about using\n`ggplot2::position_nudge()` for slightly adjusting variables on a\ndiscrete scale in similar fashion to the `nudge_y =` and `nudge_x =`\narguments most people might be familiar with from other geoms. I also\nused `ggforce::geom_mark_hull()` to do some labelling.\n\n``` r\ngoals_country_plot <- squads_df_clean %>% \n filter(position %in% c(\"MF\", \"FW\")) %>% \n group_by(country) %>% \n mutate(median = median(goals)) %>% \n ungroup() %>% \n ggplot(aes(x = goals, y = reorder(country, median))) +\n ggridges::geom_density_ridges(fill = \"red\", color = \"white\", scale = 1.1) +\n geom_point(aes(x = median, y = country), position = position_nudge(y = 0.25),\n color = \"yellow\", size = 3) +\n ggforce::geom_mark_hull(aes(filter = country == \"Argentina\" & goals == 67, label = \"Lionel Messi: 67 goals\"),\n label.buffer = unit(15, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 55, label = \"Luis Suarez: 55 goals\"),\n label.buffer = unit(5, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Japan\" & goals == 50, label = \"Shinji Okazaki: 50 goals\"),\n label.buffer = unit(2, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 46, label = \"Edinson Cavani: 46 goals\"),\n label.buffer = unit(25, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Chile\" & goals == 41, label = \"Alexis Sanchez: 41 goals\"),\n label.buffer = unit(4, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n scale_x_continuous(limits = c(0, 73),\n expand = c(0.01, 0.01),\n breaks = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70),\n labels = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70)) +\n expand_limits(y = 13.5) +\n labs(title = \"Distribution of Goals Scored by Midfielders and Strikers\",\n subtitle = \"Copa América 2019 squads, Yellow dot = Median goals\",\n x = \"Goals\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n Data from prior to start of tournament\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18) \n\ngoals_country_plot\n```\n\n ## Picking joint bandwidth of 2.07\n\n\n\nWith a lot of these players being more defensively minded or new players\nthe distribution is heavily skewed but you can see little mounds showing\nthe top goalscorers for each country and see which countries have their\ngoalscorers spread out among multiple players such as Brazil, Qatar, and\nPeru.\n\nIf you know your South American players you can take a good guess at who\nare the top goal scorers for each nation. For Colombia the two outlying\nmounds are obviously James Rodriguez and Falcao, for example.\nVenezuela’s top scorer with 22 is Salomon Rondon and for Brazil, if not\nfor his injury, a lonesome mound would have appeared for Neymar with 60\ngoals!\n\n### Player contribution by league\n\nNow let’s check the player contribution to the squads at the Copa\nAmérica by league. I’m just going to use the country that the league is\nfrom for simplicity’s sake. Originally I wanted to `left_join()` it with\na ‘country <> domestic league’ table but couldn’t find one and the\nleague names itself aren’t very meaningful or have awful sponsor names\nthat obfuscate the country of origin even further.\n\n``` r\nplayer_contrib_league_plot <- squads_df_clean %>% \n group_by(country_league) %>%\n summarize(n = n()) %>%\n ungroup() %>% \n ggplot(aes(y = n, x = reorder(country_league, n))) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 4.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(labels = c(0, 5, 10, 15, 20, 25),\n breaks = c(0, 5, 10, 15, 20, 25),\n limits = c(0, 30),\n expand = c(0, 0)) +\n labs(title = \"Breakdown of Player Contributions by League\",\n subtitle = glue(\"\n Shown as Country Name \n Mexico (Liga MX) contributed 27 players to South American squads\"),\n x = \"League (Country name)\", y = \"Number of players\",\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12,\n caption.size = 10, \n axis.text.size = 14,\n axis.text.y.size = 11,\n axis.title.size = 16,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\"))\n\nplayer_contrib_league_plot\n```\n\n\n\nThe best of the best players from South American countries will move on\nto Europe so the Argentinean league (Superliga Argentina) and the\nBrazilian league (Brasileirão - Serie A) do not have as many players as\nyou might think and as a consequence, the top leagues of England, Spain,\nand Italy contribute quite a bit! A lot of the better players but not\nquite elite South American players might go to Mexico instead of a\nlower-mid European league. With the growth of the MLS a fair number of\nplayers ply their trade there as well.\n\nWe can take a more detailed look by creating a table of the proportion\nof players from each squad coming from either a domestic league or any\nother league. I had to do a lot of wrangling to get the proper output\nfor the table. After calculating the percentage of domestic players from\na country’s domestic league I added the full data back in. Then I had to\nmake sure that for each country, the country - domestic league country\nwas the first row in each of the country groups (so Bolivia - Bolivia,\nBolivia, China, Japan - Japan, Japan - England, etc.). By doing this I\ncan automatically `tidyr::fill()`-in the rest of the rows of that\ncountry with the ‘percentage of players from domestic league stat’.\n\n``` r\nsquads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n filter(country == country_league) %>% \n mutate(perc_from_domestic_league = percent(player_from_league / 23, accuracy = 0.1)) %>% \n right_join(squads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n ungroup()) %>% \n mutate(first = case_when(\n country == country_league ~ 1,\n TRUE ~ 0)) %>% \n arrange(country, desc(first)) %>% \n fill(perc_from_domestic_league) %>% \n group_by(country) %>% \n mutate(perc_from_league = percent(player_from_league / 23, accuracy = 0.1),\n country_league = glue::glue(\"{country_league} - league\")) %>% \n arrange(desc(player_from_league)) %>% \n select(Country = country, `League (country name)` = country_league,\n `Number of players from league` = player_from_league,\n `Percentage of players from league` = perc_from_league,\n `Percentage of players from domestic league` = perc_from_domestic_league) %>% \n DT::datatable(rownames = FALSE)\n```\n\n ## Joining, by = c(\"country\", \"country_league\", \"player_from_league\")\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n ## Warning in mutate_impl(.data, dots, caller_env()): Vectorizing 'glue'\n ## elements may not preserve their attributes\n\n\n\nThree interesting facts I found:\n\n- 30% of players on the Brazil squad play for an English team, most\n out of any league - squad combination excluding domestic leagues.\n- 100% of the Qatar squad play in their domestic league!\n- Only one Uruguayan player (4.3%) plays in its domestic league.\n\n### Player contribution by club\n\nIn the final plot for this section, I looked at the top 10 clubs\ncontributing the most players to the tournament. I used\n`arrange(desc(n)) %>% slice()` instead of `top_n()` as there were too\nmany teams tied at 4 players. To set the team names inside the bars I\ncreated a midpoint value `midval` that calculated a value half of the\nnumber of players contributed so the labels were placed neatly.\n\n``` r\nplayer_contrib_club_plot <- squads_df_clean %>% \n group_by(club) %>% \n summarize(n = n()) %>% \n mutate(club = club %>% forcats::as_factor() %>% forcats::fct_reorder(n),\n midval = n / 2) %>% \n arrange(desc(n)) %>% \n slice(1:15) %>% \n ggplot(aes(x = club, y = n)) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n geom_text(aes(y = midval, label = club, \n family = \"Roboto Condensed\", fontface = \"bold\"),\n size = 5, color = \"white\") +\n coord_flip() +\n scale_y_continuous(breaks = scales::pretty_breaks(),\n expand = c(0, 0),\n limits = c(0, 10.5)) +\n labs(title = \"Top 15 Clubs contributing the most players to the Copa América\",\n x = \"Club\", y = \"Number of players\",\n caption = \"Source: Wikipedia\") +\n theme_copaAmerica(\n title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\")) +\n theme(axis.text.y = element_blank(),\n axis.ticks.y = element_blank())\n\nplayer_contrib_club_plot\n```\n\n\n\nWith 100% of its players coming from the domestic league it’s not\nsurprise that the Qatari team, Al-Sadd, is contributing the most players\nto the tournament. Tied with another Qatari team, Mexican club America\nfeatures 7 players yet none of them are Mexicans (2 Argentineans, 2\nColombians, 1 Ecuadorian, 1 Chilean, and 1 Paraguayan).\n\nAt first I thought Barcelona contributed 8 players until I realized the\nEcuadorian players were coming from the Ecuadorian team called\nBarcelona…I had to go all the way back up to the beginning of this\nsection to fix that small peculiarity. As futbol came to South America\nvia European colonists and immigrants a lot of teams took up the names\nand colors of the teams these Europeans were fond of. Other examples\ninclude Liverpool F.C. (Montevideo, Uruguay), Arsenal de Sarandi (Buenos\nAires, Argentina), and Club Atletico Juventus (Sao Paulo, Brazil -\nalthough they use the colors of Torino F.C.).\n\nIf you download the data and type in the code below you can see the\nentire club-country list.\n\n``` r\nsquads_df_clean %>% \n group_by(club, country) %>% \n summarize(n = n()) %>% View()\n```\n\nMatch Records\n-------------\n\nNow that we got a good look at the composition of the teams, we can take\na look at how they’ve done at every Copa América.\n\nThe next code chunk mainly comes from PH Julien and his excellent Kaggle\nkernel of [“A Journey Through The History of\nSoccer”](https://www.kaggle.com/phjulien/a-journey-through-the-history-of-soccer/).\n\n``` r\n## grab football federation affiliations data\nfederation_files <- Sys.glob(\"../data/federation_affiliations/*\")\n\ndf_federations = data.frame(country = NULL, federation = NULL)\nfor (f in federation_files) {\n federation = basename(f)\n content = read.csv(f, header=FALSE)\n content <- cbind(content,federation=rep(federation, dim(content)[1]))\n df_federations <- rbind(df_federations, content)\n}\n\ncolnames(df_federations) <- c(\"country\", \"federation\")\n\ndf_federations <- df_federations %>% \n mutate(country = as.character(country) %>% str_trim(side = \"both\"))\n\nresults_raw <- readr::read_csv(\"../data/results.csv\")\n\nresults_copa <- results_raw %>% \n filter(tournament == \"Copa América\") %>% \n rename(venue_country = country, \n venue_city = city) %>% \n mutate(match_num = row_number())\n\n## combine with federation affiliations\nresults_copa_home <- results_copa %>% \n left_join(df_federations, \n by = c(\"home_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(home_federation = federation) \n\nresults_copa_away <- results_copa %>% \n left_join(df_federations, \n by = c(\"away_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(away_federation = federation)\n\n## combine home-away\nresults_copa_cleaned <- results_copa_home %>% \n full_join(results_copa_away)\n```\n\nUnfortunately, this data does not have **penalty** results as those\ngames are all counted as a draw (as technically that is the actual\nresult). Considering there a lot of cagey knock-out rounds that finish\nin a penalty shoot-out (including the last two finals…) it is\nunfortunate but that’s just the data you have sometimes. There is a way\nto web-scrape all the Copa América results and assign Win-Lose to those\ngames that went to penalties but I’ll leave that for another time. Also,\nthere is no info on what stage of the tournament the match recorded is\nin.\n\n``` r\nresults_copa_cleaned <- results_copa_cleaned %>% \n mutate(\n home_federation = case_when(\n home_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ home_federation),\n away_federation = case_when(\n away_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ away_federation)) %>% \n select(-contains(\"federation\"), -contains(\"venue\"),\n -neutral, date, home_team, home_score, away_team, away_score, \n tournament, venue_city)\n```\n\n``` r\nglimpse(results_copa_cleaned)\n```\n\n ## Observations: 787\n ## Variables: 8\n ## $ date 1916-07-02, 1916-07-06, 1916-07-08, 1916-07-10, 19...\n ## $ home_team \"Chile\", \"Argentina\", \"Brazil\", \"Argentina\", \"Brazi...\n ## $ away_team \"Uruguay\", \"Chile\", \"Chile\", \"Brazil\", \"Uruguay\", \"...\n ## $ home_score 0, 6, 1, 1, 1, 0, 4, 4, 1, 4, 5, 1, 6, 2, 0, 3, 4, ...\n ## $ away_score 4, 1, 1, 1, 2, 0, 0, 2, 0, 0, 0, 0, 0, 3, 2, 1, 1, ...\n ## $ tournament \"Copa América\", \"Copa América\", \"Copa América\", \"Co...\n ## $ match_num 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...\n ## $ venue_city \"Buenos Aires\", \"Buenos Aires\", \"Buenos Aires\", \"Bu...\n\nNow that it’s nice and cleaned up I created a function that reshapes the\ndata so that it’s set from a certain team’s perspective with the “team”\nargument. You can also set the function to look for only results against\na certain opponent by filling in the `versus` argument.\n\n``` r\ncopaAmerica_resultados <- function(data, team, versus = NA) {\n \n ## team of interest: ex. 'Brazil'\n team_var <- enquo(team)\n \n todos_partidos <- data %>% \n ## filter only for results of team of interest\n filter(home_team == !!team_var | away_team == !!team_var) %>% \n ## reshape columns to team vs. opponent\n mutate(\n opponent = case_when(\n away_team != !!team_var ~ away_team,\n home_team != !!team_var ~ home_team),\n home_away = case_when(\n home_team == !!team_var ~ \"home\",\n away_team == !!team_var ~ \"away\"),\n equipo_goals = case_when(\n home_team == !!team_var ~ home_score,\n away_team == !!team_var ~ away_score),\n opp_goals = case_when(\n home_team != !!team_var ~ home_score,\n away_team != !!team_var ~ away_score)) %>% \n ## label results from team's perspective\n mutate(\n result = case_when(\n equipo_goals > opp_goals ~ \"Win\",\n equipo_goals < opp_goals ~ \"Loss\",\n equipo_goals == opp_goals ~ \"Draw\")) %>% \n mutate(result = result %>% forcats::as_factor() %>% forcats::fct_relevel(c(\"Win\", \"Draw\", \"Loss\"))) %>% \n select(-contains(\"score\"), -contains(\"team\"), -match_num) %>% \n rename(Date = date, Tournament = tournament, `Venue` = venue_city, Opponent = opponent, `Home / Away` = home_away,\n `Goals For` = equipo_goals, `Goals Against` = opp_goals, Result = result)\n \n if (is.na(versus) | is.null(versus)) {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n ## sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n ## spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric)\n \n missing_cols <- c(\"Win\", \"Draw\", \"Loss\") %>% \n map_dfr( ~tibble(!!.x := numeric()))\n \n resultados_totalmente <- resultados_totalmente %>% \n bind_rows(missing_cols) %>% \n mutate(Win = if_else(is.na(Win), 0, Win),\n Draw = if_else(is.na(Draw), 0, Draw),\n Loss = if_else(is.na(Loss), 0, Loss)) %>%\n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n } else { \n ## opponent: ex. 'Argentina'\n todos_partidos <- todos_partidos %>% \n filter(Opponent == versus)\n \n if (nrow(todos_partidos) == 0) {\n return(glue(\"{team} has never played {versus} at the Copa América!\")) \n } else {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n # sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n # spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric) %>% \n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n }\n }\n}\n```\n\nThe output is either a dataframe of all the games a team has been\ninvolved in as well as the record of the team against other teams in the\nCopa América or a message saying that the team you picked has never\nplayed against the opponent you picked.\n\n### Japan\n\n``` r\ncopaAmerica_resultados(data = results_copa_cleaned, \n team = \"Japan\", versus = \"Brazil\")\n```\n\n ## Japan has never played Brazil at the Copa América!\n\nOh… that’s right Japan has never played against Brazil at the Copa…\n\n``` r\nresultados_japon <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Japan\")\n```\n\n ## Warning: Unknown levels in `f`: Win\n\n``` r\nresultados_japon[[2]] %>% \n DT::datatable(caption = \"Japan's record in the Copa América\", rownames = FALSE)\n```\n\n\n\nJapan’s only previous journey to the Copa América was in the 1999\nedition where they lost all 3 games. They were invited for the 2011\nedition but withdrew due to the Tohoku Earthquake and were replaced by\nCosta Rica. Japanese football has come a long way since 1999 but with a\nyoung squad it will be a uphill battle to get 3 points against any of\ntheir Group C opponents, Uruguay, Chile, and Ecuador.\n\n### Colombia\n\n``` r\nresultados_colombia <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Colombia\") \n\nresultados_colombia[[2]] %>% \n DT::datatable(caption = \"Colombia's record in the Copa América\", rownames = FALSE)\n```\n\n\n\nDespite a recent resurgence of the Colombia national team they have not\nbeen able to match the feats of the 2001 side that won the Copa with\ntheir best place finish since then coming 3rd in 2004. The 2001 team\nwere not only unbeaten but also did not concede a single goal throughout\nthe tournament!\n\n### Superclasico Sudamericano: Brazil vs. Argentina\n\n``` r\nresultados_de_brazil <- copaAmerica_resultados(data = results_copa_cleaned, \n team = \"Brazil\", versus = \"Argentina\")\n\nresultados_de_brazil[[1]] %>% \n DT::datatable(caption = \"Brazil vs. Argentina in the Copa América\", rownames = FALSE)\n```\n\n\n\n``` r\nresultados_de_brazil[[2]] %>% \n DT::datatable(caption = \"Brazil vs. Argentina in the Copa América\", rownames = FALSE)\n```\n\n\n\nBrazil does not have a good overall record vs. Argentina but they have\nnot lost against their rivals at the Copa América since the 1991\nedition. The “draw” in 2004 was actually in the final where they won 4-2\non penalties.\n\nWhat I found odd was that the Copa América seems to have a very low\npriority to certain countries, especially Brazil who have repeatedly\nsent their B or C teams to the tournament in favor of sending their best\nteam to other tournaments or resting star players. Funnily enough these\nunderstrength Brazilian squads have actually won the entire tournament a\nfew times, most notably in 2007 against a full strength Argentina side\ncontaining the likes of Zanetti, Riquelme, Cambiasso, Tevez, a young\nMessi/Mascherano, Cambiasso, et al!\n\nPlayer Profiles\n---------------\n\nAfter looking at the history of the competition and the composition of\nthe squads I examined the players and their form coming into the Copa\nAmérica. In recent years football analytics has really taken off and\nthere have been many strides made in creating more informative\nstatistics to assess players’ abilities, the most prominently being the\n**xG** statistics. This is the first time I talk about **xG** in any\nlength/depth so this introduction is as much to solidify my\nunderstanding as well as yours!\n\n### What IS xG?\n\n- **xG**: Quantitative measure (between 0 and 1) that assigns a\n probability that a shot taken will result in a goal based on a\n variety of variables and is used for evaluating the quality of\n chances and predicting players’ and teams’ future performances.\n\n- **xA**: Quantitative measure (between 0 and 1) that assigns a\n probability that a given pass will result in an assist for a goal\n based on a variety of variables.\n\nCommon variables used in the models that output xG statistics are the\ndistance and angle of a shot, the body part used, rebound, among others.\nSimilar to how you might assess your favorite striker’s chances of\nscoring just as he is lining up to take a shot: Is the shot a header? Is\nhe trying to score from a cross in regular play or a corner kick? Are\nthere a crowd of defenders in front of him or is he one-on-one with the\ngoalkeeper? Etc. You might think **who** takes a shot would be a genuine\nfactor but in actuality it tells you a lot less about the chances of a\ngoal compared to the location of the shot.\n\nNote that there isn’t a SINGLE xG model. You can check out a blog post\ncomparing different people’s xG models\n[here](https://mackayanalytics.nl/2017/06/19/how-accurate-are-xg-models-ii-the-big-chance-dilemma/).\nPeople and organizations (from Statsbomb to OptaPro) have their own\nideas about what **could** be the important variables in play and as\nsuch it’s important to report from which source you got your data from\nas the stats can differ between models. A few things xG does not factor\nin are things like goalkeeper performance (someone pulling off\nincredible saves or letting in a poor shot) and one must also consider\nthe fact that team style of play and the quality of a player’s\nteammates. When judging players based on these stats it is important to\nbe aware of contextual factors like the team they play for, their\nopponent, and the player’s position/role in the team.\n\nFrom xG and xA more granular statistics such as xGChain and xGBuildup\nwere created to be able to dig a little deeper into who is contributing\nto chance creation, I’ll introduce the latter two a bit later. As the\nfield has grown new statistics have popped up such as [Karun\nSingh](https://twitter.com/karun1710/)’s “expected threat” or xT. You\ncan check out an introduction to xT from\n[here](https://karun.in/blog/expected-threat.html).\n\nOf course, these statistics only tell a part of the story and are\ndefinitenly not the be-all-and-end-all. In the context of this current\nblog post, these stats only tell the story about how these players did\nfor their club teams this past season rather than for their national\nteam. Even still it gives us a good idea of what kind of form these\nplayers are in coming into this tournament.\n\nYou might also want to watch these Youtube videos by\n[TifoFootball](https://www.youtube.com/channel/UCGYYNGmyhZ_kwBF_lqqXdAQ)\nfor a quick primer on [xG](https://www.youtube.com/watch?v=zSaeaFcm1SY)\nand [xA](https://www.youtube.com/watch?v=1MdlkuzLdj4).\n\n### understat data\n\nFor the data I used the website, `understat.com`. Their xG models were\ncreated via training a neural network on a dataset consisting of over\n100,000 shots using more than 10 different variables. Getting data from\n`understat` has been made easy by Ewen Henderson’s `understatr` package\navailable from [Github](https://github.com/ewenme/understatr) (he’s also\nthe guy that made the [ghibli](https://github.com/ewenme/ghibli) color\npalette!). I tried to pick a wide selection of attacking players but I\nwas also limited by the fact that `understat` only has data for\nteams/players from six European leagues (Premier League, Bundesliga,\nSerie A, La Liga, Ligue 1, and Russian Premier League).\n\nFor **Peru** I would have chosen Paolo Guerrero but as he plays in\nBrazil now I went with Jefferson Farfan (who hasn’t played as many games\nas the other players used for comparison unfortunately…). For **Chile**\nI would pick Eduardo Vargas but he as doesn’t play for a team covered by\nunderstat I went with Alexis Sanchez, who had a woeful season and only\nplayed \\~600 minutes despite appearing in \\~20 league matches and later\nadded Arturo Vidal. For **Brazil** I included Neymar initially but since\nhe won’t actually be playing I’ll keep him for comparison’s sake but\nalso include Gabriel Jesus and Roberto Firmino who have been fighting\nfor the starting striker spot. Note that these two aren’t the ones\nreplacing Neymar **positionally**. In Neymar’s left-wing position I can\nsee David Neres or Phil Coutinho replacing him (Richarlison and Willian\nmostly play on the right). (Edit: In the first match vs. Bolivia, David\nNeres started off on the left while Richarlison played on the right,\nCoutinho played just behind Bobby Firmino)\n\nThe other nation’s strikers/attacking midfielders don’t play for the six\nEuropean leagues covered by understat or like in Shinji Okazaki’s case\njust did not play as many minutes/games during the season. To get the\ndata I created a list of the player codes and use `purrr::map()` to\niterate each through the `understatr::get_player_seasons_stats()`\nfunction.\n\n``` r\nplayer_codes <- c(2097, 2099, 813, ## Messi, Neymar, Rondon\n 498, 4299, 696, ## Alexis, Farfan, Falcao\n 3294, 2098, 5543, ## Cavani, Suarez, G. Jesus\n 482, 1148, 2249, ## Bobby, Duvan, James\n 1089, 3553, 488, ## Cuadrado, Di Maria, Coutinho\n 222) ## Arturo Vidal\n\nunderstat_data <- player_codes %>% \n map(., ~ understatr::get_player_seasons_stats(.x)) %>% \n reduce(bind_rows) %>% \n select(-player_id, -position, -yellow, -red)\n```\n\n``` r\nglimpse(understat_data)\n```\n\n ## Observations: 83\n ## Variables: 15\n ## $ games 34, 36, 34, 33, 38, 17, 20, 30, 34, 33, 32, 36, 38...\n ## $ goals 36, 34, 37, 26, 43, 15, 19, 13, 24, 22, 11, 7, 8, ...\n ## $ shots 170, 196, 179, 158, 187, 55, 91, 105, 124, 95, 89,...\n ## $ time 2704, 2995, 2832, 2726, 3374, 1443, 1797, 2652, 30...\n ## $ xG 25.997169, 28.946281, 26.885174, 27.101910, 35.891...\n ## $ assists 13, 12, 9, 16, 18, 7, 13, 11, 12, 7, 7, 3, 2, 2, 0...\n ## $ xA 15.33516552, 15.10040562, 13.95513140, 15.87127814...\n ## $ key_passes 93, 87, 79, 77, 95, 43, 70, 91, 102, 52, 32, 23, 2...\n ## $ year 2018, 2017, 2016, 2015, 2014, 2018, 2017, 2016, 20...\n ## $ team_name \"Barcelona\", \"Barcelona\", \"Barcelona\", \"Barcelona\"...\n ## $ npg 32, 32, 31, 23, 38, 10, 15, 12, 19, 21, 11, 7, 8, ...\n ## $ npxG 22.280909, 25.973170, 21.682231, 21.899351, 31.432...\n ## $ xGChain 38.459877, 48.180634, 42.525045, 41.996866, 54.753...\n ## $ xGBuildup 10.6987990, 21.6344040, 18.1335122, 15.1963644, 19...\n ## $ player_name \"Lionel Messi\", \"Lionel Messi\", \"Lionel Messi\", \"L...\n\nAs you can see the data consists of a row for each player and each year\n(from the 2014/2015 season to the 2018/2019 season). I tried to mitigate\nthe fact that some players played a lot more minutes than others by\nstandardize everything to a ‘per 90 minutes’ value but this does have\nits own disadvantages. These include the fact that players who play a\nlot of minutes (as regular starting members) may not have as high ‘per\n90’ stat even though their production with all these minutes might\nsuggest that they are consistently performing and producing at a high\nlevel.\n\nIt’ll be a bit crowded (kind of like a spilt box of Skittles…) but let’s\ncheck out the key metrics for all the players at once.\n\nNote: npg = non-penalty goals, npxG = non-penalty goals xG\n\n``` r\ncomparison_data <- understat_data %>% \n filter(year == 2018) %>% \n select(-games, -team_name, -year) %>% \n rename(Shots = shots, KP = key_passes) %>% \n gather(key = \"key\", value = \"value\", -player_name, -time) %>% \n mutate(key = forcats::as_factor(key) %>% \n forcats::fct_relevel(., \n \"xG\", \"goals\", \"npxG\", \"npg\", \n \"xA\", \"assists\", \"xGChain\", \"xGBuildup\",\n \"Shots\", \"KP\"))\n\ncomparison_strikers_plot <- comparison_data %>%\n filter(key != \"Shots\", key != \"KP\",\n key != \"xGBuildup\", key != \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n geom_vline(xintercept = 4.5, size = 2) +\n geom_vline(xintercept = 5.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.26)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Comparison: Top attackers at the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_strikers_plot\n```\n\n\n\nAs usual in these types of charts, Messi is leading a lot of the metrics\nhere and showing consistency too with having played the third highest\namount of minutes out of the selected players. It’s helpful to have the\nxG/xA stats next to the actual goals/assists as it provides an\nindication of whether the player in question is scoring shots that he\nprobabilistically should be scoring. When a player’s actual goal count\nis higher than their xG stat this suggests that the player is\n**“exceeding their xG”** or that they are scoring from shots that are\nhistorically hard to score from. It can be seen as a marker of an elite\nfinisher as they are putting away chances from difficult situations\nconsistently. In terms of assists and xA Alexis Sanchez, who only played\nabout 600 minutes, looks a lot better than in reality due to the\naforementioned disadvantage of standardizing everything to a “per 90\nminutes” value. Normally you would have a cut-off based on a certain\n**minimum amount of minutes** but as I mentioned I was rather limited in\nmy choice of players.\n\nA way to take a closer look at xG - Goals and xA - Assists is to use a\nsimple dot plot with a line going through the 45 degree angle. Those\nbelow the line are underperforming relative to their xG or xA stat,\nthose over it are overachieving (“exceeding” their xG/xA stat) while\nthose just on the line are scoring or assisting right around what the\nmodel expects the player to be. I use non-penalty xG below as penalties\nhave around \\~0.75 xG (give or take a few percentage points depending on\nthe model) and can inflate the stats of those players who take a lot of\npenalties and score them, especially if they weren’t the ones who earned\nthe penalty themselves.\n\n``` r\nexpected_goal_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, npxG, xG, goals) %>% \n mutate_at(c(\"npxG\", \"xG\", \"goals\"), ~. / time * 90) %>% \n ggplot(aes(x = npxG, y = goals, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n scale_x_continuous(limits = c(0, 1.1),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 1.3),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Expected vs. Actual Goals\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"Non-penalty xG per 90 minutes\",\n y = \"Goals per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_goal_plot\n```\n\n\n\nGabriel Jesus is quite clearly below the 45 degree line meaning that he\nhas been very poor at finishing chances (and/or incredibly unlucky).\nAfter a poor World Cup where he scored 0 goals as a starter, he is\nreally going to have to step up to fill Neymar’s goalscoring boots for\nthis tournament. However, his build-up play for City has still been good\nthis past season and he has been scoring for Brazil in the friendlies\nleading up to the tournament so it’s going to be a hard decision for\nTite to decide on who starts against Bolivia (edit: Firmino started and\ncontributed an assist while Jesus replaced him in the 65th minute).\n\n``` r\nexpected_assists_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, xA, assists) %>% \n mutate_at(c(\"xA\", \"assists\"), ~. / time * 90) %>% \n ggplot(aes(x = xA, y = assists, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n labs(title = \"Expected vs. Actual Assists\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"xA per 90 minutes\",\n y = \"Assists per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n scale_x_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_assists_plot\n```\n\n\n\nOne thing to keep in mind is that xA does not take into account the\nrecipient of the assist pass. Even if the pass given had a high expected\nassist value the receiving player still might not have the quality to\nput it away through no fault of the passer. This might explain why most\nof the players with a higher xA among this group don’t have the assists\nto match. It can also be that these players are also the ones playing a\nlot more minutes and the volume of chances they create just aren’t\ntranslating to goals all the time.\n\n### Key Passes, Shots, xGChain, and xGBuildup (per 90)\n\nI separated “key passes” and “shots” as well as “xGChain” and\n“xGBuildup” from the rest as these two sets were on a very different\nscale.\n\n``` r\nkp_shots_plot <- comparison_data %>%\n filter(key == \"Shots\" | key == \"KP\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 6),\n breaks = c(0, 1, 2, 3, 4, 5, 6),\n labels = c(0, 1, 2, 3, 4, 5, 6)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = glue(\"\n KP = Key Passes\n For select group of attacking players with data available from understat.com\"),\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nkp_shots_plot\n```\n\n\n\n- xGChain: Quantitative measure that is the combined sum of the xG of\n every possession that ends in a shot that a player is involved in.\n The same derived value is given to each of the players involved and\n allows us to credit players for attacking contributions outside of\n just shots (xG) and assists (xA).\n\n- xGBuildup: Similar to xGChain but excluding shots and assists. This\n is in response to xGChain values still being dominated by the xG and\n xA from shots and assists, respectively.\n\n``` r\nxgbuildup_xgchain_plot <- comparison_data %>%\n filter(key == \"xGBuildup\" | key == \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.55),\n breaks = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5),\n labels = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nxgbuildup_xgchain_plot\n```\n\n\n\nAlthough Gabriel Jesus has been poor at finishing his chances as seen in\nprevious graphs, his xGChain and xGBuildup stat makes it clear that he\nis still contributing to City’s attack outside of scoring goals himself\n(not to mention all the defensive work he does as well).\n\nFor example below, the stats are able to clearly differentiate between\nJames, who is more of a playmaker, compared to Falcao and Duvan who are\ntraditional number 9s with his superior xGBuildup, xGChain, and Key\nPasses values. For a more detailed overview on xGChain and xGBuildup\ncheck out Statsbomb’s article\n[here](https://statsbomb.com/2018/08/introducing-xgchain-and-xgbuildup/).\n\n``` r\n## keep colors for Colombians consistent with other plots\ncolombia_pal <- c(\"#000033\", \"#005300\", \"#009FFF\", \"#00FFBE\")\n\ncomparison_colombia_plot <- comparison_data %>%\n filter(!key %in% c(\"xG\", \"goals\", \"npxG\", \"npg\", \"xA\", \"assists\"),\n player_name %in% c(\"James Rodríguez\", \"Falcao\", \"Duván Zapata\", \"Juan Cuadrado\")) %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.05, 0.05),\n breaks = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4),\n labels = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4)) +\n scale_fill_manual(values = colombia_pal, name = \"Player\") +\n labs(title = \"Comparison: Stars of Colombia\",\n subtitle = \"KP: Key Passes\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 20,\n subtitle.size = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_colombia_plot\n```\n\n\n\nThere are lots of different ways to visualize this data, most famously\nthe radar charts created by [Statsbomb](http://statsbomb.com/). Using\nthe data you can also compare and evaluate players in many different\nways and using `understatr` package you could add a few more players\nlike Paulo Dybala, Miguel Almiron, and more! I could probably do a whole\nother article using just this data but I’ll leave it here for now.\n\nConclusion\n----------\n\nThroughout this blog post I talked about some of the historical records,\nsquad compositions, match records, and finally the player profiles of\nattacking players at this summer’s Copa América. Using the power of R it\nis really easy to webscrape and visualize data in a way that is\ninformative and aesthetically pleasing. I wanted to finish this before\nthe tournament started but other life things got in the way as well as\nthe fact that the amount of content ballooned out of control (especially\nthe xG section) so I had to cut down a lot.\n\nIt’s been fun reading the articles on the Copa América website and\nseeing how far my “intermediate-but-very-out-of-practice”-level of\nSpanish can get me to understand the content, here is one that I\nparticularly liked reading: [14 Estadisticas de la Copa\nAmérica](https://copaamerica.com/es/noticias/a-14-dias-del-inicio-de-la-copa-14-estadisticas-de-la-copa-america).\nWith so many tournaments going on right now (and with the African Cup of\nNations starting in a few days) a lot of the news media is spread thin\nright now but there are still some quality articles out there to read\nabout the Copa, like [this\narticle](https://www.bbc.com/sport/football/48600098) from BBC’s South\nAmerican football expert, Tim Vickery.\n\nAfter the first round of games, a few points of discussion:\n\n- After an extremely lacklustre performance vs. Colombia, how does\n Argentina bounce back? What tactical changes need to be made?\n\n- Qatar impressed against Paraguay but can they pull off a major upset\n vs. Colombia?\n\n- How will Japan line-up against Uruguay after a losing by a scoreline\n that didn’t really do their performance justice? How will manager\n Moriyasu balance experience vs. youth, will he start with veteran\n Okazaki after Ueda’s numerous misses vs. Chile?\n\n- Can Brazil earn a early ticket to the next round vs. Venezuela after\n a clinical but not excellent performance vs. Bolivia? Will they be\n able to keep up their streak of winning the Copa every time they\n have hosted it?\n\nThanks for reading and…\n\n¡Buena suerte a todos equipos!\n"
},
{
"path": "Copa America 2019/copa_america2019.md",
"content": "Another summer and another edition of the Copa América! Along with the\nAfrica Cup of Nations, Nations League finals, the Women’s World Cup,\nUnder-21 European Championship AND the Gold Cup this is yet another\nsoccer-filled season after last year’s World Cup and the Asian Cup\nearlier this year (I also did a blog post on these last two tournaments\nwhich you can see [here (World\nCup)](https://ryo-n7.github.io/2018-06-29-visualize-worldcup/) and [here\n(Asian Cup)](https://ryo-n7.github.io/2019-01-11-visualize-asian-cup/)).\nThere is so much football going on at once even I can’t keep up,\nespecially with the time difference! To not redo all the previous\nvisualizations with Copa América data I tried to find new sources of\ndata and other forms of visualizations to give some insight into the\nplayers and teams competing to be the champion of South America. You can\nfind all the code I used in this blogpost here and you can also find\nother soccer related data viz in my\n[soccer\\_ggplot](https://github.com/Ryo-N7/soccer_ggplots) Github repo.\n\nThe sections will go from a very macro-level view of the **historical\nrecords** of the tournament, to the **squads** competing, the teams’\n**match record** in the Copa América, and finally to a micro-level view\nof various attacking players using **xG** statistics.\n\n¡Vámonos!\n\nPackages\n--------\n\n``` r\nlibrary(dplyr) ## data wrangling\nlibrary(tidyr) ## data wrangling\nlibrary(purrr) ## data wrangling and iteration\nlibrary(stringr) ## data wrangling\nlibrary(rvest) ## webscraping\nlibrary(polite) ## webscraping (Github only pkg)\nlibrary(ggplot2) ## plotting\nlibrary(scales) ## plotting scales\nlibrary(ggimage) ## images for flags\nlibrary(ggforce) ## plotting text labels\nlibrary(cowplot) ## plotting grid\nlibrary(glue) ## text\nlibrary(ggrepel) ## plotting text labels\nlibrary(magick) ## plotting\nlibrary(DT) ## tables\nlibrary(ggtextures) ## soccer ball emoji as geom_col()\nlibrary(extrafont) ## fonts: Roboto Condensed\n\nloadfonts()\n```\n\ntheme\\_copaAmerica\n------------------\n\nI wanted to have all the plots in this blogpost to have a consistent\ncolor theme. As the tournament is going to be held in Brazil, I went\nwith a color theme based on its flag with blue, yellow, and green being\nthe primary colors.\n\n``` r\ntheme_copaAmerica <- function(\n title.size = 24,\n subtitle.size = 14,\n caption.size = 8,\n axis.text.size = 14,\n axis.text.x.size = 12,\n axis.text.y.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(size = 0.5, color = \"white\"),\n panel.grid.major.y = element_line(size = 0.5, color = \"white\"),\n panel.grid.minor.x = element_blank(),\n panel.grid.minor.y = element_blank(),\n axis.ticks = element_line(color = \"white\")) {\n ## Theme:\n theme(text = element_text(family = \"Roboto Condensed\", color = \"white\"),\n plot.title = element_text(family = \"Roboto Condensed\", face = \"bold\", \n size = title.size, color = \"yellow\"),\n plot.subtitle = element_text(size = subtitle.size),\n plot.caption = element_text(size = caption.size),\n panel.background = element_rect(fill = \"#009b3a\"),\n plot.background = element_rect(fill = \"#002776\"),\n axis.text = element_text(size = axis.text.size, color = \"white\"),\n axis.text.x = element_text(size = axis.text.x.size, color = \"white\"),\n axis.text.y = element_text(size = axis.text.y.size, color = \"white\"),\n axis.title = element_text(size = axis.title.size),\n axis.line.x = element_blank(),\n axis.line.y = element_blank(),\n panel.grid.major.x = panel.grid.major.x,\n panel.grid.major.y = panel.grid.major.y,\n panel.grid.minor.x = panel.grid.minor.x,\n panel.grid.minor.y = panel.grid.minor.y,\n strip.text = element_text(color = \"yellow\", face = \"bold\", \n size = strip.text.size, \n margin = margin(4.4, 4.4, 4.4, 4.4)),\n strip.background = element_blank(),\n axis.ticks = axis.ticks\n )\n}\n```\n\nTop Goal Scorers // Goleadores\n------------------------------\n\nFor this plot I took the stats from the Spanish version of the Wikipedia\npage as it had more content. I used `purrr::flatten_df()` to squish the\nlist output into a dataframe then set the names of each column using\n`purrr::set_names()`.\n\n``` r\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_top_scorers <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(95)\") %>% \n html_table() %>% \n flatten_df() %>% \n set_names(c(\"player\", \"country\", \"goals\")) %>% \n mutate(image = \"https://www.emoji.co.uk/files/microsoft-emojis/activity-windows10/8356-soccer-ball.png\")\n```\n\n``` r\nglimpse(copa_top_scorers)\n```\n\n ## Observations: 22\n ## Variables: 4\n ## $ player \"Norberto Méndez\", \"Zizinho\", \"Lolo Fernández\", \"Sever...\n ## $ country \"ARG Argentina\", \"BRA Brasil\", \"PER Perú\", \"URU Urugua...\n ## $ goals 17, 17, 15, 15, 13, 13, 13, 13, 13, 12, 12, 11, 11, 11...\n ## $ image \"https://www.emoji.co.uk/files/microsoft-emojis/activi...\n\nLike in the Asian Cup blogpost I use [Claus\nWilke](https://twitter.com/ClausWilke/)’s\n[ggtextures](https://github.com/clauswilke/ggtextures) package to use\n**soccer ball emoji** as the column image in the plot.\n\n``` r\ncopa_goleadores_raw_plot <- copa_top_scorers %>% \n head(5) %>% \n ggplot(aes(x = reorder(player, goals), y = goals,\n image = image)) +\n geom_isotype_col(img_width = grid::unit(1, \"native\"), img_height = NULL,\n ncol = NA, nrow = 1, hjust = 0, vjust = 0.5) +\n geom_text(aes(label = goals, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18),\n expand = c(0, 0), \n limits = c(0, 19)) +\n labs(title = \"Top Scorers of the Copa América\",\n subtitle = glue(\"\n Most goals in a single tournament: 9 \n Humberto Maschio (Argentina), Javier Ambrois (Uruguay), Jair (Brazil)\"),\n y = \"Number of Goals\", x = NULL,\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 26,\n subtitle.size = 16,\n caption.size = 12,\n axis.text.size = 18,\n axis.title.size = 18,\n panel.grid.major.y = element_blank(),\n axis.ticks = element_blank())\n\n## Add flags to y-axis:\naxis_image <- axis_canvas(copa_goleadores_raw_plot, axis = 'y') + \n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 16.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/1/1a/Flag_of_Argentina.svg\", \n y = 12.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/f/fe/Flag_of_Uruguay.svg\", \n y = 9, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/d/df/Flag_of_Peru_%28state%29.svg\", \n y = 5.25, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 1.5, scale = 1.8)\n\ncopa_goleadores_plot <- ggdraw(insert_yaxis_grob(copa_goleadores_raw_plot, axis_image, position = \"left\"))\ncopa_goleadores_plot\n```\n\n\n\nMost of these players aren’t ones you might recognize. The Copa América\nused to be held a lot more regularly (and sometimes erratically) until\nthis century so players had a lot more opportunities to score goals. All\nfive of the players you see here played in the 1930s-1950s when there\nwas a tournament every one or two years. Out of currently active\nplayers, Peruvian legend Paolo Guerrero has 11 goals along with Eduardo\nVargas (from Chile). (Edit: after the Chile - Japan game, Vargas is on\n12…) Another player you might recognize that was actually tied with\nAdemir for 5th place, along with three other players, was Gabriel\nBatistuta (“Batigol”).\n\nWinners of the Copa América\n---------------------------\n\nAfter grabbing the data from the Wikipedia page I used a variety of\nfunctions to clean and reshape the dataset like `tidyr::separate()` to\nsplit the number of occurences and the year.\n\n``` r\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_campeones <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(10)\") %>% \n html_table() %>% \n flatten_df()\n\ncopa_campeones_limpia <- copa_campeones %>% \n janitor::clean_names() %>% \n slice(1:8) %>% \n select(1:4) %>% \n set_names(c(\"team\", \"winners\", \"runners_up\", \"third_place\")) %>% \n separate(winners, into = c(\"Champions\", \"first_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(runners_up, into = c(\"Runners-up\", \"second_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(third_place, into = c(\"Third Place\", \"third_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n mutate_all(list(~str_replace_all(., \"–\", \"0\"))) %>% \n mutate_at(vars(contains(\"num\")), funs(as.numeric)) %>% \n gather(key = \"key\", value = \"value\", -team, \n -first_place_year, -second_place_year, -third_place_year) %>% \n mutate(key = as.factor(key),\n value = as.numeric(value),\n team = team %>% str_replace(., \"[A-Z]{3}\", \"\") %>% str_trim(.),\n team = case_when(team == \"Brasil\" ~ \"Brazil\",\n TRUE ~ team)) %>% \n mutate(key = forcats::fct_relevel(key, \n \"Champions\",\n \"Runners-up\",\n \"Third Place\")) %>% \n arrange(key, desc(value)) %>% \n mutate(team = forcats::as_factor(team),\n order = row_number())\n```\n\nI also wanted to add flags to this plot but\n`cowplot::insert_yaxis_grob()` is unfortunately not compatible with\nfacets. I used `stringr::str_wrap()` to format the subtitle nicely while\nI used `glue::glue()` to avoid having the use ‘’ to create a new line\nfor the caption.\n\n``` r\ncopa_ganadores_plot <- copa_campeones_limpia %>% \n ggplot(aes(value, forcats::fct_rev(team), color = key)) +\n geom_point(size = 10) + # 10\n geom_text(aes(label = value), \n size = 5, color = \"black\", # 5 \n family = \"Roboto Condensed\", fontface = \"bold\") +\n scale_color_manual(values = c(\"Champions\" = \"#FFCC33\",\n \"Runners-up\" = \"#999999\",\n \"Third Place\" = \"#CC6600\"),\n guide = FALSE) +\n scale_x_continuous(breaks = c(1, 5, 10, 15),\n labels = c(1, 5, 10, 15),\n limits = c(-1, 16)) +\n labs(x = \"Number of Occurrence\", y = NULL,\n title = \"Most Successful Teams of the Copa América!\",\n subtitle = str_wrap(\"Ordered by number of Copa América(s) won. Argentina missed the chance to leapfrog Uruguay after consecutive final losses in the previous two tournaments!\", width = 80),\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n facet_wrap(~key) +\n theme_copaAmerica(subtitle.size = 14, \n caption.size = 10)\n\ncopa_ganadores_plot\n```\n\n\n\nWhat’s surprising to note is that Pele never won a Copa América with\nBrazil, although he did get Best Player and Top Scorer in the 1959\nedition of the tournament. Even more bizarrely Diego Maradona has never\nwon it either! He didn’t play in either of the 1991 and 1993 editions\nwhere Argentina won their 13th and 14th Copas.\n\nCopa América Squad Profiles\n---------------------------\n\nWe just looked at what happened in the past but who are the players\ncompeting in the tournament this year? To take a quick look I\nweb-scraped the squads of each of the competing teams from Wikipedia.\n\nI created a list of the `xpath`s for each of squads and using\n`purrr::map()` I grabbed the data for each participating country. After\nI got some meta-information about the country name and the group I\ncreated a list-column that stores the squad data as a dataframe in its\nown column. To explode this out I used `tidyr::unnest()` to reshape the\nentire dataframe to have one row with all the data for each player in\nevery squad.\n\nTo get a clean dataset I use some `stringr::str_*()` functions to\nproperly format the character strings such as the player positions,\nages, date of births.\n\n``` r\nsquads_df_clean <- squads_df_raw %>% \n janitor::clean_names() %>% \n select(-delete, squad_num = no, \n position = pos, birth_age = date_of_birth_age) %>% \n mutate(position = position %>% str_replace_all(., \"[1-9]\", \"\"),\n birth_age = birth_age %>% str_extract_all(., pattern = \"\\\\([^()]+\\\\)\")) %>% unnest(birth_age) %>% \n group_by(player) %>% \n mutate(colnum = seq_along(player)) %>% \n spread(key = colnum, value = birth_age) %>% \n ungroup() %>% \n select(everything(), dob = `1`, age = `2`) %>% \n mutate(dob = dob %>% str_replace_all(., \"[()]\", \"\") %>% lubridate::as_date(),\n age = age %>% str_extract(., \"[0-9]+\") %>% as.integer,\n country = forcats::fct_relevel(country, \n \"Brazil\", \"Argentina\", \"Uruguay\", \n \"Peru\", \"Qatar\", \"Chile\", \n \"Venezuela\", \"Paraguay\", \"Japan\", \n \"Bolivia\", \"Colombia\", \"Ecuador\",\n ),\n club = case_when(\n club == \"Barcelona\" & country == \"Ecuador\" ~ \"Barcelona (Ecuador)\",\n TRUE ~ club))\n```\n\n``` r\nglimpse(squads_df_clean)\n```\n\n ## Observations: 276\n ## Variables: 12\n ## $ name 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,...\n ## $ group \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A\", \"A...\n ## $ country Brazil, Brazil, Brazil, Brazil, Brazil, Brazil,...\n ## $ squad_num 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ...\n ## $ position \"GK\", \"DF\", \"DF\", \"DF\", \"MF\", \"DF\", \"FW\", \"MF\",...\n ## $ player \"Alisson\", \"Thiago Silva\", \"Miranda\", \"Marquinh...\n ## $ caps 36, 79, 57, 36, 36, 40, 3, 10, 29, 65, 49, 15, ...\n ## $ goals 0, 7, 3, 1, 0, 2, 1, 0, 16, 8, 14, 1, 7, 0, 0, ...\n ## $ club \"Liverpool\", \"Paris Saint-Germain\", \"Internazio...\n ## $ country_league \"England\", \"France\", \"Italy\", \"France\", \"Spain\"...\n ## $ dob 1992-10-02, 1984-09-22, 1984-09-07, 1994-05-14...\n ## $ age 26, 34, 34, 25, 27, 33, 22, 22, 22, 30, 27, 28,...\n\n### Age-histogram\n\nUsing this data I can plot a bunch of histograms:\n\n``` r\nage_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_age = median(age)) %>% \n ungroup() %>% \n ggplot(aes(x = age)) +\n geom_histogram(fill = \"red\", binwidth = 1) +\n geom_vline(aes(xintercept = median_age), size = 1.2) +\n geom_label(aes(x = median_age, y = 8, \n label = glue::glue(\"Median: {median_age}\")),\n nudge_x = 0.5, hjust = 0.1, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Age Distribution of Copa América squads\",\n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Age\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0),\n breaks = scales::pretty_breaks()) +\n theme_copaAmerica(title.size = 22,\n subtitle.size = 14, \n caption.size = 8,\n axis.text.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\")) +\n facet_wrap(~country, ncol = 3)\n \nage_country_plot\n```\n\n\n\nIn terms of age, Japan have the youngest team with a median of 21, 4\nyears younger than the next youngest team, Qatar. The rest have a fairly\nbalanced spread of ages from 20 to early-mid 30s with most of the\nmedians hovering around 27 years of age. The reason for Japan’s\nextremely young squad is due to the fact that the full-strength Japan\nteam has played in both the World Cup and the Asian Cup in the past\nyear. Along with the fact that the Tokyo Olympics are next year, it was\ndecided to use the invitation to the Copa América as a trial-by-fire for\nthe young stars of the future. Much like in a real Olympic squad, the\nteam contains three “overage” players in World Cup 2010/2014/2018\ngoalkeeper Eiji Kawashima, Premier League winner Shinji Okazaki, and\nGetafe playmaker Gaku Shibasaki.\n\nThe oldest player will be Brazil captain Dani Alves at 36 with\nParaguay’s Oscar Cardozo only two weeks younger. On the other hand, the\nyoungest player is Japan’s 18-year old prodigy Takefusa Kubo, the\nex-Barcelona youth player who only just recently moved to Real Madrid!\nIn light of his transfer a lot of eyes will be on him to see if he can\nproduce some Captain Tsubasa-esque performances for a very inexperienced\nJapan team gearing up for the Tokyo Olympics!\n\n### Caps histogram\n\nWhen considering the experience of a squad it’s not enough to look at\nages but one needs to look at the caps or appearances for the national\nteam as well.\n\n``` r\ncaps_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_cap = median(caps)) %>% \n ungroup() %>% \n ggplot(aes(x = caps)) +\n geom_histogram(fill = \"red\", binwidth = 5) +\n geom_vline(aes(xintercept = median_cap), size = 1.25) +\n geom_label(aes(x = median_cap, y = 15, \n label = glue::glue(\"Median: {median_cap}\")),\n nudge_x = 0.5, hjust = 0.05, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Caps (Appearances) by Country\", \n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Caps\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0)) +\n theme_copaAmerica(\n title.size = 20,\n subtitle.size = 14, \n caption.size = 10,\n axis.text.size = 10,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(color = \"white\", size = 0.25),\n panel.grid.major.y = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.x = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.y = element_line(color = \"white\", size = 0.25)) +\n facet_wrap(~country, ncol = 3)\n\ncaps_country_plot\n```\n\n\n\nThe majority of Japan’s squad have 0 (ZERO) caps, with the\naforementioned three “overage” players taking up most of the proportion\nof caps on the team. Bolivia are also taking a untested squad with 8 of\ntheir players with 2 caps or less! Chile, Uruguay, and Argentina bring\ntheir veterans with multiple players over or around 100 caps. From this\ndata I was surprised that Jefferson Farfan and Paolo Guerrero didn’t\nhave 100 caps by now…\n\nThe player with the most caps is Lionel Messi (130) followed closely by\nDiego Godin (126), and Alexis Sanchez (124). On the other hand there are\n29 players hopeful of making their first national team appearance at\nthis tournament with the majority (17 players) coming from Japan.\n\n### Goal distribution\n\nNext I looked at the distribution of goals scored by the midfielders and\nstrikers of each team. I found out about using\n`ggplot2::position_nudge()` for slightly adjusting variables on a\ndiscrete scale in similar fashion to the `nudge_y =` and `nudge_x =`\narguments most people might be familiar with from other geoms. I also\nused `ggforce::geom_mark_hull()` to do some labelling.\n\n``` r\ngoals_country_plot <- squads_df_clean %>% \n filter(position %in% c(\"MF\", \"FW\")) %>% \n group_by(country) %>% \n mutate(median = median(goals)) %>% \n ungroup() %>% \n ggplot(aes(x = goals, y = reorder(country, median))) +\n ggridges::geom_density_ridges(fill = \"red\", color = \"white\", scale = 1.1) +\n geom_point(aes(x = median, y = country), position = position_nudge(y = 0.25),\n color = \"yellow\", size = 3) +\n ggforce::geom_mark_hull(aes(filter = country == \"Argentina\" & goals == 67, label = \"Lionel Messi: 67 goals\"),\n label.buffer = unit(15, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 55, label = \"Luis Suarez: 55 goals\"),\n label.buffer = unit(5, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Japan\" & goals == 50, label = \"Shinji Okazaki: 50 goals\"),\n label.buffer = unit(2, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 46, label = \"Edinson Cavani: 46 goals\"),\n label.buffer = unit(25, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Chile\" & goals == 41, label = \"Alexis Sanchez: 41 goals\"),\n label.buffer = unit(4, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n scale_x_continuous(limits = c(0, 73),\n expand = c(0.01, 0.01),\n breaks = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70),\n labels = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70)) +\n expand_limits(y = 13.5) +\n labs(title = \"Distribution of Goals Scored by Midfielders and Strikers\",\n subtitle = \"Copa América 2019 squads, Yellow dot = Median goals\",\n x = \"Goals\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n Data from prior to start of tournament\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18) \n\ngoals_country_plot\n```\n\n\n\nWith a lot of these players being more defensively minded or new players\nthe distribution is heavily skewed but you can see little mounds showing\nthe top goalscorers for each country and see which countries have their\ngoalscorers spread out among multiple players such as Brazil, Qatar, and\nPeru.\n\nIf you know your South American players you can take a good guess at who\nare the top goal scorers for each nation. For Colombia the two outlying\nmounds are obviously James Rodriguez and Falcao, for example.\nVenezuela’s top scorer with 22 is Salomon Rondon and for Brazil, if not\nfor his injury, a lonesome mound would have appeared for Neymar with 60\ngoals!\n\n### Player contribution by league\n\nNow let’s check the player contribution to the squads at the Copa\nAmérica by league. I’m just going to use the country that the league is\nfrom for simplicity’s sake. Originally I wanted to `left_join()` it with\na ‘country <> domestic league’ table but couldn’t find one and the\nleague names itself aren’t very meaningful or have awful sponsor names\nthat obfuscate the country of origin even further.\n\n``` r\nplayer_contrib_league_plot <- squads_df_clean %>% \n group_by(country_league) %>%\n summarize(n = n()) %>%\n ungroup() %>% \n ggplot(aes(y = n, x = reorder(country_league, n))) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 4.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(labels = c(0, 5, 10, 15, 20, 25),\n breaks = c(0, 5, 10, 15, 20, 25),\n limits = c(0, 30),\n expand = c(0, 0)) +\n labs(title = \"Breakdown of Player Contributions by League\",\n subtitle = glue(\"\n Shown as Country Name \n Mexico (Liga MX) contributed 27 players to South American squads\"),\n x = \"League (Country name)\", y = \"Number of players\",\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12,\n caption.size = 10, \n axis.text.size = 14,\n axis.text.y.size = 11,\n axis.title.size = 16,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\"))\n\nplayer_contrib_league_plot\n```\n\n\n\nThe best of the best players from South American countries will move on\nto Europe so the Argentinean league (Superliga Argentina) and the\nBrazilian league (Brasileirão - Serie A) do not have as many players as\nyou might think and as a consequence, the top leagues of England, Spain,\nand Italy contribute quite a bit! A lot of the better players but not\nquite elite South American players might go to Mexico instead of a\nlower-mid European league. With the growth of the MLS a fair number of\nplayers ply their trade there as well.\n\nWe can take a more detailed look by creating a table of the proportion\nof players from each squad coming from either a domestic league or any\nother league. I had to do a lot of wrangling to get the proper output\nfor the table. After calculating the percentage of domestic players from\na country’s domestic league I added the full data back in. Then I had to\nmake sure that for each country, the country - domestic league country\nwas the first row in each of the country groups (so Bolivia - Bolivia,\nBolivia, China, Japan - Japan, Japan - England, etc.). By doing this I\ncan automatically `tidyr::fill()`-in the rest of the rows of that\ncountry with the ‘percentage of players from domestic league stat’.\n\n``` r\nsquads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n filter(country == country_league) %>% \n mutate(perc_from_domestic_league = percent(player_from_league / 23, accuracy = 0.1)) %>% \n right_join(squads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n ungroup()) %>% \n mutate(first = case_when(\n country == country_league ~ 1,\n TRUE ~ 0)) %>% \n arrange(country, desc(first)) %>% \n fill(perc_from_domestic_league) %>% \n group_by(country) %>% \n mutate(perc_from_league = percent(player_from_league / 23, accuracy = 0.1),\n country_league = glue::glue(\"{country_league} - league\")) %>% \n arrange(desc(player_from_league)) %>% \n select(Country = country, `League (country name)` = country_league,\n `Number of players from league` = player_from_league,\n `Percentage of players from league` = perc_from_league,\n `Percentage of players from domestic league` = perc_from_domestic_league) %>% \n head(10) %>% \n knitr::kable(format = \"html\",\n caption = \"Breakdown of Player Contribution by League\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\n\n\nBreakdown of Player Contribution by League\n\n\n\n| \nCountry\n | \n\nLeague (country name)\n | \n\nNumber of players from league\n | \n\nPercentage of players from league\n | \n\nPercentage of players from domestic league\n | \n
\n\n\n\n| \nQatar\n | \n\nQatar - league\n | \n\n23\n | \n\n100.0%\n | \n\n100.0%\n | \n
\n\n| \nBolivia\n | \n\nBolivia - league\n | \n\n20\n | \n\n87.0%\n | \n\n87.0%\n | \n
\n\n| \nJapan\n | \n\nJapan - league\n | \n\n14\n | \n\n60.9%\n | \n\n60.9%\n | \n
\n\n| \nEcuador\n | \n\nEcuador - league\n | \n\n9\n | \n\n39.1%\n | \n\n39.1%\n | \n
\n\n| \nParaguay\n | \n\nParaguay - league\n | \n\n8\n | \n\n34.8%\n | \n\n34.8%\n | \n
\n\n| \nBrazil\n | \n\nEngland - league\n | \n\n7\n | \n\n30.4%\n | \n\n13.0%\n | \n
\n\n| \nUruguay\n | \n\nSpain - league\n | \n\n6\n | \n\n26.1%\n | \n\n4.3%\n | \n
\n\n| \nPeru\n | \n\nPeru - league\n | \n\n6\n | \n\n26.1%\n | \n\n26.1%\n | \n
\n\n| \nChile\n | \n\nChile - league\n | \n\n6\n | \n\n26.1%\n | \n\n26.1%\n | \n
\n\n| \nArgentina\n | \n\nArgentina - league\n | \n\n5\n | \n\n21.7%\n | \n\n21.7%\n | \n
\n\n
\n\nThree interesting facts I found:\n\n- 30% of players on the Brazil squad play for an English team, most\n out of any league - squad combination excluding domestic leagues.\n- 100% of the Qatar squad play in their domestic league!\n- Only one Uruguayan player (4.3%) plays in its domestic league.\n\n### Player contribution by club\n\nIn the final plot for this section, I looked at the top 10 clubs\ncontributing the most players to the tournament. I used\n`arrange(desc(n)) %>% slice()` instead of `top_n()` as there were too\nmany teams tied at 4 players. To set the team names inside the bars I\ncreated a midpoint value `midval` that calculated a value half of the\nnumber of players contributed so the labels were placed neatly.\n\n``` r\nplayer_contrib_club_plot <- squads_df_clean %>% \n group_by(club) %>% \n summarize(n = n()) %>% \n mutate(club = club %>% forcats::as_factor() %>% forcats::fct_reorder(n),\n midval = n / 2) %>% \n arrange(desc(n)) %>% \n slice(1:15) %>% \n ggplot(aes(x = club, y = n)) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n geom_text(aes(y = midval, label = club, \n family = \"Roboto Condensed\", fontface = \"bold\"),\n size = 5, color = \"white\") +\n coord_flip() +\n scale_y_continuous(breaks = scales::pretty_breaks(),\n expand = c(0, 0),\n limits = c(0, 10.5)) +\n labs(title = \"Top 15 Clubs contributing the most players to the Copa América\",\n x = \"Club\", y = \"Number of players\",\n caption = \"Source: Wikipedia\") +\n theme_copaAmerica(\n title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\")) +\n theme(axis.text.y = element_blank(),\n axis.ticks.y = element_blank())\n\nplayer_contrib_club_plot\n```\n\n\n\nWith 100% of its players coming from the domestic league it’s not\nsurprise that the Qatari team, Al-Sadd, is contributing the most players\nto the tournament. Tied with another Qatari team, Mexican club America\nfeatures 7 players yet none of them are Mexicans (2 Argentineans, 2\nColombians, 1 Ecuadorian, 1 Chilean, and 1 Paraguayan).\n\nAt first I thought Barcelona contributed 8 players until I realized the\nEcuadorian players were coming from the Ecuadorian team called\nBarcelona…I had to go all the way back up to the beginning of this\nsection to fix that small peculiarity. As futbol came to South America\nvia European colonists and immigrants a lot of teams took up the names\nand colors of the teams these Europeans were fond of. Other examples\ninclude Liverpool F.C. (Montevideo, Uruguay), Arsenal de Sarandi (Buenos\nAires, Argentina), and Club Atletico Juventus (Sao Paulo, Brazil -\nalthough they use the colors of Torino F.C.).\n\nIf you download the data and type in the code below you can see the\nentire club-country list.\n\n``` r\nsquads_df_clean %>% \n group_by(club, country) %>% \n summarize(n = n()) %>% View()\n```\n\nMatch Records\n-------------\n\nNow that we got a good look at the composition of the teams, we can take\na look at how they’ve done at every Copa América.\n\nThe next code chunk mainly comes from PH Julien and his excellent Kaggle\nkernel of [“A Journey Through The History of\nSoccer”](https://www.kaggle.com/phjulien/a-journey-through-the-history-of-soccer/).\n\n``` r\n## grab football federation affiliations data\nfederation_files <- Sys.glob(\"../data/federation_affiliations/*\")\n\ndf_federations = data.frame(country = NULL, federation = NULL)\nfor (f in federation_files) {\n federation = basename(f)\n content = read.csv(f, header=FALSE)\n content <- cbind(content,federation=rep(federation, dim(content)[1]))\n df_federations <- rbind(df_federations, content)\n}\n\ncolnames(df_federations) <- c(\"country\", \"federation\")\n\ndf_federations <- df_federations %>% \n mutate(country = as.character(country) %>% str_trim(side = \"both\"))\n\nresults_raw <- readr::read_csv(\"../data/results.csv\")\n\nresults_copa <- results_raw %>% \n filter(tournament == \"Copa América\") %>% \n rename(venue_country = country, \n venue_city = city) %>% \n mutate(match_num = row_number())\n\n## combine with federation affiliations\nresults_copa_home <- results_copa %>% \n left_join(df_federations, \n by = c(\"home_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(home_federation = federation) \n\nresults_copa_away <- results_copa %>% \n left_join(df_federations, \n by = c(\"away_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(away_federation = federation)\n\n## combine home-away\nresults_copa_cleaned <- results_copa_home %>% \n full_join(results_copa_away)\n```\n\nUnfortunately, this data does not have **penalty** results as those\ngames are all counted as a draw (as technically that is the actual\nresult). Considering there a lot of cagey knock-out rounds that finish\nin a penalty shoot-out (including the last two finals…) it is\nunfortunate but that’s just the data you have sometimes. There is a way\nto web-scrape all the Copa América results and assign Win-Lose to those\ngames that went to penalties but I’ll leave that for another time. Also,\nthere is no info on what stage of the tournament the match recorded is\nin.\n\n``` r\nresults_copa_cleaned <- results_copa_cleaned %>% \n mutate(\n home_federation = case_when(\n home_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ home_federation),\n away_federation = case_when(\n away_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ away_federation)) %>% \n select(-contains(\"federation\"), -contains(\"venue\"),\n -neutral, date, home_team, home_score, away_team, away_score, \n tournament, venue_city)\n```\n\n``` r\nglimpse(results_copa_cleaned)\n```\n\n ## Observations: 787\n ## Variables: 8\n ## $ date 1916-07-02, 1916-07-06, 1916-07-08, 1916-07-10, 19...\n ## $ home_team \"Chile\", \"Argentina\", \"Brazil\", \"Argentina\", \"Brazi...\n ## $ away_team \"Uruguay\", \"Chile\", \"Chile\", \"Brazil\", \"Uruguay\", \"...\n ## $ home_score 0, 6, 1, 1, 1, 0, 4, 4, 1, 4, 5, 1, 6, 2, 0, 3, 4, ...\n ## $ away_score 4, 1, 1, 1, 2, 0, 0, 2, 0, 0, 0, 0, 0, 3, 2, 1, 1, ...\n ## $ tournament \"Copa América\", \"Copa América\", \"Copa América\", \"Co...\n ## $ match_num 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...\n ## $ venue_city \"Buenos Aires\", \"Buenos Aires\", \"Buenos Aires\", \"Bu...\n\nNow that it’s nice and cleaned up I created a function that reshapes the\ndata so that it’s set from a certain team’s perspective with the “team”\nargument. You can also set the function to look for only results against\na certain opponent by filling in the `versus` argument.\n\n``` r\ncopaAmerica_resultados <- function(data, team, versus = NA) {\n \n ## team of interest: ex. 'Brazil'\n team_var <- enquo(team)\n \n todos_partidos <- data %>% \n ## filter only for results of team of interest\n filter(home_team == !!team_var | away_team == !!team_var) %>% \n ## reshape columns to team vs. opponent\n mutate(\n opponent = case_when(\n away_team != !!team_var ~ away_team,\n home_team != !!team_var ~ home_team),\n home_away = case_when(\n home_team == !!team_var ~ \"home\",\n away_team == !!team_var ~ \"away\"),\n equipo_goals = case_when(\n home_team == !!team_var ~ home_score,\n away_team == !!team_var ~ away_score),\n opp_goals = case_when(\n home_team != !!team_var ~ home_score,\n away_team != !!team_var ~ away_score)) %>% \n ## label results from team's perspective\n mutate(\n result = case_when(\n equipo_goals > opp_goals ~ \"Win\",\n equipo_goals < opp_goals ~ \"Loss\",\n equipo_goals == opp_goals ~ \"Draw\")) %>% \n mutate(result = result %>% forcats::as_factor() %>% forcats::fct_relevel(c(\"Win\", \"Draw\", \"Loss\"))) %>% \n select(-contains(\"score\"), -contains(\"team\"), -match_num) %>% \n rename(Date = date, Tournament = tournament, `Venue` = venue_city, Opponent = opponent, `Home / Away` = home_away,\n `Goals For` = equipo_goals, `Goals Against` = opp_goals, Result = result)\n \n if (is.na(versus) | is.null(versus)) {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n ## sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n ## spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric)\n \n missing_cols <- c(\"Win\", \"Draw\", \"Loss\") %>% \n map_dfr( ~tibble(!!.x := numeric()))\n \n resultados_totalmente <- resultados_totalmente %>% \n bind_rows(missing_cols) %>% \n mutate(Win = if_else(is.na(Win), 0, Win),\n Draw = if_else(is.na(Draw), 0, Draw),\n Loss = if_else(is.na(Loss), 0, Loss)) %>%\n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n } else { \n ## opponent: ex. 'Argentina'\n todos_partidos <- todos_partidos %>% \n filter(Opponent == versus)\n \n if (nrow(todos_partidos) == 0) {\n return(glue(\"{team} has never played {versus} at the Copa América!\")) \n } else {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n # sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n # spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric) %>% \n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n }\n }\n}\n```\n\nThe output is either a dataframe of all the games a team has been\ninvolved in as well as the record of the team against other teams in the\nCopa América or a message saying that the team you picked has never\nplayed against the opponent you picked.\n\n### Japan\n\n``` r\ncopaAmerica_resultados(data = results_copa_cleaned, \n team = \"Japan\", versus = \"Brazil\")\n```\n\n ## Japan has never played Brazil at the Copa América!\n\nOh… that’s right Japan has never played against Brazil at the Copa…\n\n``` r\nresultados_japon <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Japan\")\n\nresultados_japon[[2]] %>% \n knitr::kable(format = \"html\",\n caption = \"Japan's record in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\n\n\nJapan’s record in the Copa América\n\n\n\n| \nDate\n | \n\nTournament\n | \n\nVenue\n | \n\nOpponent\n | \n\nHome / Away\n | \n\nGoals For\n | \n\nGoals Against\n | \n\nResult\n | \n
\n\n\n\n| \n1999-06-29\n | \n\nCopa América\n | \n\nAsunción\n | \n\nPeru\n | \n\naway\n | \n\n2\n | \n\n3\n | \n\nLoss\n | \n
\n\n| \n1999-07-02\n | \n\nCopa América\n | \n\nAsunción\n | \n\nParaguay\n | \n\naway\n | \n\n0\n | \n\n4\n | \n\nLoss\n | \n
\n\n| \n1999-07-05\n | \n\nCopa América\n | \n\nPedro Juan Caballero\n | \n\nBolivia\n | \n\naway\n | \n\n1\n | \n\n1\n | \n\nDraw\n | \n
\n\n
\n\nJapan’s only previous journey to the Copa América was in the 1999\nedition where they lost all 3 games. They were invited for the 2011\nedition but withdrew due to the Tohoku Earthquake and were replaced by\nCosta Rica. Japanese football has come a long way since 1999 but with a\nyoung squad it will be a uphill battle to get 3 points against any of\ntheir Group C opponents, Uruguay, Chile, and Ecuador.\n\n### Colombia\n\n``` r\nresultados_colombia <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Colombia\") \n\nresultados_colombia[[2]] %>% \n slice(87:92) %>% \n knitr::kable(format = \"html\",\n caption = \"Colombia's record in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\n\n\nColombia’s record in the Copa América\n\n\n\n| \nDate\n | \n\nTournament\n | \n\nVenue\n | \n\nOpponent\n | \n\nHome / Away\n | \n\nGoals For\n | \n\nGoals Against\n | \n\nResult\n | \n
\n\n\n\n| \n2001-07-11\n | \n\nCopa América\n | \n\nBarranquilla\n | \n\nVenezuela\n | \n\nhome\n | \n\n2\n | \n\n0\n | \n\nWin\n | \n
\n\n| \n2001-07-14\n | \n\nCopa América\n | \n\nBarranquilla\n | \n\nEcuador\n | \n\nhome\n | \n\n1\n | \n\n0\n | \n\nWin\n | \n
\n\n| \n2001-07-17\n | \n\nCopa América\n | \n\nBarranquilla\n | \n\nChile\n | \n\nhome\n | \n\n2\n | \n\n0\n | \n\nWin\n | \n
\n\n| \n2001-07-23\n | \n\nCopa América\n | \n\nArmenia\n | \n\nPeru\n | \n\nhome\n | \n\n3\n | \n\n0\n | \n\nWin\n | \n
\n\n| \n2001-07-26\n | \n\nCopa América\n | \n\nManizales\n | \n\nHonduras\n | \n\nhome\n | \n\n2\n | \n\n0\n | \n\nWin\n | \n
\n\n| \n2001-07-29\n | \n\nCopa América\n | \n\nBogotá\n | \n\nMexico\n | \n\nhome\n | \n\n1\n | \n\n0\n | \n\nWin\n | \n
\n\n
\n\nDespite a recent resurgence of the Colombia national team they have not\nbeen able to match the feats of the 2001 side that won the Copa with\ntheir best place finish since then coming 3rd in 2004. The 2001 team\nwere not only unbeaten but also did not concede a single goal throughout\nthe tournament!\n\n### Superclasico Sudamericano: Brazil vs. Argentina\n\n``` r\nresultados_de_brazil <- copaAmerica_resultados(data = results_copa_cleaned, \n team = \"Brazil\", versus = \"Argentina\")\n\nresultados_de_brazil[[1]] %>% \n knitr::kable(format = \"html\",\n caption = \"Brazil vs. Argentina in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\n\n\nBrazil vs. Argentina in the Copa América\n\n\n\n| \nOpponent\n | \n\nWin\n | \n\nDraw\n | \n\nLoss\n | \n\nGoals For\n | \n\nGoals Against\n | \n
\n\n\n\n| \nArgentina\n | \n\n9\n | \n\n8\n | \n\n15\n | \n\n38\n | \n\n52\n | \n
\n\n
\n\n``` r\nresultados_de_brazil[[2]] %>% \n tail(5) %>% \n knitr::kable(format = \"html\",\n caption = \"Brazil vs. Argentina in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\n\n\nBrazil vs. Argentina in the Copa América\n\n\n\n| \nDate\n | \n\nTournament\n | \n\nVenue\n | \n\nOpponent\n | \n\nHome / Away\n | \n\nGoals For\n | \n\nGoals Against\n | \n\nResult\n | \n
\n\n\n\n| \n1993-06-27\n | \n\nCopa América\n | \n\nGuayaquil\n | \n\nArgentina\n | \n\nhome\n | \n\n1\n | \n\n1\n | \n\nDraw\n | \n
\n\n| \n1995-07-17\n | \n\nCopa América\n | \n\nRivera\n | \n\nArgentina\n | \n\nhome\n | \n\n2\n | \n\n2\n | \n\nDraw\n | \n
\n\n| \n1999-07-11\n | \n\nCopa América\n | \n\nCiudad del Este\n | \n\nArgentina\n | \n\nhome\n | \n\n2\n | \n\n1\n | \n\nWin\n | \n
\n\n| \n2004-07-25\n | \n\nCopa América\n | \n\nLima\n | \n\nArgentina\n | \n\naway\n | \n\n2\n | \n\n2\n | \n\nDraw\n | \n
\n\n| \n2007-07-15\n | \n\nCopa América\n | \n\nMaracaibo\n | \n\nArgentina\n | \n\nhome\n | \n\n3\n | \n\n0\n | \n\nWin\n | \n
\n\n
\n\nBrazil does not have a good overall record vs. Argentina but they have\nnot lost against their rivals at the Copa América since the 1993 edition\nwhere they lost 5-6 on penalties in the Quarter Finals. The “draw” in\n1995 was won on penalties while the “draw” in 2004 was actually in the\nfinal where they won 4-2 on penalties.\n\nWhat I found odd was that the Copa América seems to have a very low\npriority to certain countries, especially Brazil who have repeatedly\nsent their B or C teams to the tournament in favor of sending their best\nteam to other tournaments or resting star players. Funnily enough these\nunderstrength Brazilian squads have actually won the entire tournament a\nfew times, most notably in 2007 against a full strength Argentina side\ncontaining the likes of Zanetti, Riquelme, Cambiasso, Tevez, a young\nMessi/Mascherano, Cambiasso, et al!\n\nPlayer Profiles\n---------------\n\nAfter looking at the history of the competition and the composition of\nthe squads I examined the players and their form coming into the Copa\nAmérica. In recent years football analytics has really taken off and\nthere have been many strides made in creating more informative\nstatistics to assess players’ abilities, the most prominently being the\n**xG** statistics. This is the first time I talk about **xG** in any\nlength/depth so this introduction is as much to solidify my\nunderstanding as well as yours!\n\n### What IS xG?\n\n- **xG**: Quantitative measure (between 0 and 1) that assigns a\n probability that a shot taken will result in a goal based on a\n variety of variables and is used for evaluating the quality of\n chances and predicting players’ and teams’ future performances.\n\n- **xA**: Quantitative measure (between 0 and 1) that assigns a\n probability that a given pass will result in an assist for a goal\n based on a variety of variables.\n\nCommon variables used in the models that output xG statistics are the\ndistance and angle of a shot, the body part used, rebound, among others.\nSimilar to how you might assess your favorite striker’s chances of\nscoring just as he is lining up to take a shot: Is the shot a header? Is\nhe trying to score from a cross in regular play or a corner kick? Are\nthere a crowd of defenders in front of him or is he one-on-one with the\ngoalkeeper? Etc. You might think **who** takes a shot would be a genuine\nfactor but in actuality it tells you a lot less about the chances of a\ngoal compared to the location of the shot.\n\nNote that there isn’t a SINGLE xG model. You can check out a blog post\ncomparing different people’s xG models\n[here](https://mackayanalytics.nl/2017/06/19/how-accurate-are-xg-models-ii-the-big-chance-dilemma/).\nPeople and organizations (from Statsbomb to OptaPro) have their own\nideas about what **could** be the important variables in play and as\nsuch it’s important to report from which source you got your data from\nas the stats can differ between models. A few things xG does not factor\nin are things like goalkeeper performance (someone pulling off\nincredible saves or letting in a poor shot) and one must also consider\nthe fact that team style of play and the quality of a player’s\nteammates. When judging players based on these stats it is important to\nbe aware of contextual factors like the team they play for, their\nopponent, and the player’s position/role in the team.\n\nFrom xG and xA more granular statistics such as xGChain and xGBuildup\nwere created to be able to dig a little deeper into who is contributing\nto chance creation, I’ll introduce the latter two a bit later. As the\nfield has grown new statistics have popped up such as [Karun\nSingh](https://twitter.com/karun1710/)’s “expected threat” or xT. You\ncan check out an introduction to xT from\n[here](https://karun.in/blog/expected-threat.html).\n\nOf course, these statistics only tell a part of the story and are\ndefinitenly not the be-all-and-end-all. In the context of this current\nblog post, these stats only tell the story about how these players did\nfor their club teams this past season rather than for their national\nteam. Even still it gives us a good idea of what kind of form these\nplayers are in coming into this tournament.\n\nYou might also want to watch these Youtube videos by\n[TifoFootball](https://www.youtube.com/channel/UCGYYNGmyhZ_kwBF_lqqXdAQ)\nfor a quick primer on [xG](https://www.youtube.com/watch?v=zSaeaFcm1SY)\nand [xA](https://www.youtube.com/watch?v=1MdlkuzLdj4).\n\n### understat data\n\nFor the data I used the website, `understat.com`. Their xG models were\ncreated via training a neural network on a dataset consisting of over\n100,000 shots using more than 10 different variables. Getting data from\n`understat` has been made easy by Ewen Henderson’s `understatr` package\navailable from [Github](https://github.com/ewenme/understatr) (he’s also\nthe guy that made the [ghibli](https://github.com/ewenme/ghibli) color\npalette!). I tried to pick a wide selection of attacking players but I\nwas also limited by the fact that `understat` only has data for\nteams/players from six European leagues (Premier League, Bundesliga,\nSerie A, La Liga, Ligue 1, and Russian Premier League).\n\nFor **Peru** I would have chosen Paolo Guerrero but as he plays in\nBrazil now I went with Jefferson Farfan (who hasn’t played as many games\nas the other players used for comparison unfortunately…). For **Chile**\nI would pick Eduardo Vargas but he as doesn’t play for a team covered by\nunderstat I went with Alexis Sanchez, who had a woeful season and only\nplayed \\~600 minutes despite appearing in \\~20 league matches and later\nadded Arturo Vidal. For **Brazil** I included Neymar initially but since\nhe won’t actually be playing I’ll keep him for comparison’s sake but\nalso include Gabriel Jesus and Roberto Firmino who have been fighting\nfor the starting striker spot. Note that these two aren’t the ones\nreplacing Neymar **positionally**. In Neymar’s left-wing position I can\nsee David Neres or Phil Coutinho replacing him (Richarlison and Willian\nmostly play on the right). (Edit: In the first match vs. Bolivia, David\nNeres started off on the left while Richarlison played on the right,\nCoutinho played just behind Bobby Firmino)\n\nThe other nation’s strikers/attacking midfielders don’t play for the six\nEuropean leagues covered by understat or like in Shinji Okazaki’s case\njust did not play as many minutes/games during the season. To get the\ndata I created a list of the player codes and use `purrr::map()` to\niterate each through the `understatr::get_player_seasons_stats()`\nfunction.\n\n``` r\nplayer_codes <- c(2097, 2099, 813, ## Messi, Neymar, Rondon\n 498, 4299, 696, ## Alexis, Farfan, Falcao\n 3294, 2098, 5543, ## Cavani, Suarez, G. Jesus\n 482, 1148, 2249, ## Bobby, Duvan, James\n 1089, 3553, 488, ## Cuadrado, Di Maria, Coutinho\n 222) ## Arturo Vidal\n\nunderstat_data <- player_codes %>% \n map(., ~ understatr::get_player_seasons_stats(.x)) %>% \n reduce(bind_rows) %>% \n select(-player_id, -position, -yellow, -red)\n```\n\n``` r\nglimpse(understat_data)\n```\n\n ## Observations: 83\n ## Variables: 15\n ## $ games 34, 36, 34, 33, 38, 17, 20, 30, 34, 33, 32, 36, 38...\n ## $ goals 36, 34, 37, 26, 43, 15, 19, 13, 24, 22, 11, 7, 8, ...\n ## $ shots 170, 196, 179, 158, 187, 55, 91, 105, 124, 95, 89,...\n ## $ time 2704, 2995, 2832, 2726, 3374, 1443, 1797, 2652, 30...\n ## $ xG 25.997169, 28.946281, 26.885174, 27.101910, 35.891...\n ## $ assists 13, 12, 9, 16, 18, 7, 13, 11, 12, 7, 7, 3, 2, 2, 0...\n ## $ xA 15.33516552, 15.10040562, 13.95513140, 15.87127814...\n ## $ key_passes 93, 87, 79, 77, 95, 43, 70, 91, 102, 52, 32, 23, 2...\n ## $ year 2018, 2017, 2016, 2015, 2014, 2018, 2017, 2016, 20...\n ## $ team_name \"Barcelona\", \"Barcelona\", \"Barcelona\", \"Barcelona\"...\n ## $ npg 32, 32, 31, 23, 38, 10, 15, 12, 19, 21, 11, 7, 8, ...\n ## $ npxG 22.280909, 25.973170, 21.682231, 21.899351, 31.432...\n ## $ xGChain 38.459877, 48.180634, 42.525045, 41.996866, 54.753...\n ## $ xGBuildup 10.6987990, 21.6344040, 18.1335122, 15.1963644, 19...\n ## $ player_name \"Lionel Messi\", \"Lionel Messi\", \"Lionel Messi\", \"L...\n\nAs you can see the data consists of a row for each player and each year\n(from the 2014/2015 season to the 2018/2019 season). I tried to mitigate\nthe fact that some players played a lot more minutes than others by\nstandardize everything to a ‘per 90 minutes’ value but this does have\nits own disadvantages. These include the fact that players who play a\nlot of minutes (as regular starting members) may not have as high ‘per\n90’ stat even though their production with all these minutes might\nsuggest that they are consistently performing and producing at a high\nlevel.\n\nIt’ll be a bit crowded (kind of like a spilt box of Skittles…) but let’s\ncheck out the key metrics for all the players at once.\n\nNote: npg = non-penalty goals, npxG = non-penalty goals xG\n\n``` r\ncomparison_data <- understat_data %>% \n filter(year == 2018) %>% \n select(-games, -team_name, -year) %>% \n rename(Shots = shots, KP = key_passes) %>% \n gather(key = \"key\", value = \"value\", -player_name, -time) %>% \n mutate(key = forcats::as_factor(key) %>% \n forcats::fct_relevel(., \n \"xG\", \"goals\", \"npxG\", \"npg\", \n \"xA\", \"assists\", \"xGChain\", \"xGBuildup\",\n \"Shots\", \"KP\"))\n\ncomparison_strikers_plot <- comparison_data %>%\n filter(key != \"Shots\", key != \"KP\",\n key != \"xGBuildup\", key != \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n geom_vline(xintercept = 4.5, size = 2) +\n geom_vline(xintercept = 5.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.26)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Comparison: Top attackers at the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_strikers_plot\n```\n\n\n\nAs usual in these types of charts, Messi is leading a lot of the metrics\nhere and showing consistency too with having played the third highest\namount of minutes out of the selected players. It’s helpful to have the\nxG/xA stats next to the actual goals/assists as it provides an\nindication of whether the player in question is scoring shots that he\nprobabilistically should be scoring. When a player’s actual goal count\nis higher than their xG stat this suggests that the player is\n**“exceeding their xG”** or that they are scoring from shots that are\nhistorically hard to score from. It can be seen as a marker of an elite\nfinisher as they are putting away chances from difficult situations\nconsistently. In terms of assists and xA Alexis Sanchez, who only played\nabout 600 minutes, looks a lot better than in reality due to the\naforementioned disadvantage of standardizing everything to a “per 90\nminutes” value. Normally you would have a cut-off based on a certain\n**minimum amount of minutes** but as I mentioned I was rather limited in\nmy choice of players.\n\nA way to take a closer look at xG - Goals and xA - Assists is to use a\nsimple dot plot with a line going through the 45 degree angle. Those\nbelow the line are underperforming relative to their xG or xA stat,\nthose over it are overachieving (“exceeding” their xG/xA stat) while\nthose just on the line are scoring or assisting right around what the\nmodel expects the player to be. I use non-penalty xG below as penalties\nhave around \\~0.75 xG (give or take a few percentage points depending on\nthe model) and can inflate the stats of those players who take a lot of\npenalties and score them, especially if they weren’t the ones who earned\nthe penalty themselves.\n\n``` r\nexpected_goal_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, npxG, xG, goals) %>% \n mutate_at(c(\"npxG\", \"xG\", \"goals\"), ~. / time * 90) %>% \n ggplot(aes(x = npxG, y = goals, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n scale_x_continuous(limits = c(0, 1.1),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 1.3),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Expected vs. Actual Goals\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"Non-penalty xG per 90 minutes\",\n y = \"Goals per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_goal_plot\n```\n\n\n\nGabriel Jesus is quite clearly below the 45 degree line meaning that he\nhas been very poor at finishing chances (and/or incredibly unlucky).\nAfter a poor World Cup where he scored 0 goals as a starter, he is\nreally going to have to step up to fill Neymar’s goalscoring boots for\nthis tournament. However, his build-up play for City has still been good\nthis past season and he has been scoring for Brazil in the friendlies\nleading up to the tournament so it’s going to be a hard decision for\nTite to decide on who starts against Bolivia (edit: Firmino started and\ncontributed an assist while Jesus replaced him in the 65th minute).\n\n``` r\nexpected_assists_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, xA, assists) %>% \n mutate_at(c(\"xA\", \"assists\"), ~. / time * 90) %>% \n ggplot(aes(x = xA, y = assists, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n labs(title = \"Expected vs. Actual Assists\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"xA per 90 minutes\",\n y = \"Assists per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n scale_x_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_assists_plot\n```\n\n\n\nOne thing to keep in mind is that xA does not take into account the\nrecipient of the assist pass. Even if the pass given had a high expected\nassist value the receiving player still might not have the quality to\nput it away through no fault of the passer. This might explain why most\nof the players with a higher xA among this group don’t have the assists\nto match. It can also be that these players are also the ones playing a\nlot more minutes and the volume of chances they create just aren’t\ntranslating to goals all the time.\n\n### Key Passes, Shots, xGChain, and xGBuildup (per 90)\n\nI separated “key passes” and “shots” as well as “xGChain” and\n“xGBuildup” from the rest as these two sets were on a very different\nscale.\n\n``` r\nkp_shots_plot <- comparison_data %>%\n filter(key == \"Shots\" | key == \"KP\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 6),\n breaks = c(0, 1, 2, 3, 4, 5, 6),\n labels = c(0, 1, 2, 3, 4, 5, 6)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = glue(\"\n KP = Key Passes\n For select group of attacking players with data available from understat.com\"),\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nkp_shots_plot\n```\n\n\n\n- xGChain: Quantitative measure that is the combined sum of the xG of\n every possession that ends in a shot that a player is involved in.\n The same derived value is given to each of the players involved and\n allows us to credit players for attacking contributions outside of\n just shots (xG) and assists (xA).\n\n- xGBuildup: Similar to xGChain but excluding shots and assists. This\n is in response to xGChain values still being dominated by the xG and\n xA from shots and assists, respectively.\n\n``` r\nxgbuildup_xgchain_plot <- comparison_data %>%\n filter(key == \"xGBuildup\" | key == \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.55),\n breaks = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5),\n labels = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nxgbuildup_xgchain_plot\n```\n\n\n\nAlthough Gabriel Jesus has been poor at finishing his chances as seen in\nprevious graphs, his xGChain and xGBuildup stat makes it clear that he\nis still contributing to City’s attack outside of scoring goals himself\n(not to mention all the defensive work he does as well).\n\nFor example below, the stats are able to clearly differentiate between\nJames, who is more of a playmaker, compared to Falcao and Duvan who are\ntraditional number 9s with his superior xGBuildup, xGChain, and Key\nPasses values. For a more detailed overview on xGChain and xGBuildup\ncheck out Statsbomb’s article\n[here](https://statsbomb.com/2018/08/introducing-xgchain-and-xgbuildup/).\n\n``` r\n## keep colors for Colombians consistent with other plots\ncolombia_pal <- c(\"#000033\", \"#005300\", \"#009FFF\", \"#00FFBE\")\n\ncomparison_colombia_plot <- comparison_data %>%\n filter(!key %in% c(\"xG\", \"goals\", \"npxG\", \"npg\", \"xA\", \"assists\"),\n player_name %in% c(\"James Rodríguez\", \"Falcao\", \"Duván Zapata\", \"Juan Cuadrado\")) %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.05, 0.05),\n breaks = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4),\n labels = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4)) +\n scale_fill_manual(values = colombia_pal, name = \"Player\") +\n labs(title = \"Comparison: Stars of Colombia\",\n subtitle = \"KP: Key Passes\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 20,\n subtitle.size = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_colombia_plot\n```\n\n\n\nThere are lots of different ways to visualize this data, most famously\nthe radar charts created by [Statsbomb](http://statsbomb.com/). Using\nthe data you can also compare and evaluate players in many different\nways and using `understatr` package you could add a few more players\nlike Paulo Dybala, Miguel Almiron, and more! I could probably do a whole\nother article using just this data but I’ll leave it here for now.\n\nConclusion\n----------\n\nThroughout this blog post I talked about some of the historical records,\nsquad compositions, match records, and finally the player profiles of\nattacking players at this summer’s Copa América. Using the power of R it\nis really easy to webscrape and visualize data in a way that is\ninformative and aesthetically pleasing. I wanted to finish this before\nthe tournament started but other life things got in the way as well as\nthe fact that the amount of content ballooned out of control (especially\nthe xG section) so I had to cut down a lot.\n\nIt’s been fun reading the articles on the Copa América website and\nseeing how far my “intermediate-but-very-out-of-practice”-level of\nSpanish can get me to understand the content, here is one that I\nparticularly liked reading: [14 Estadisticas de la Copa\nAmérica](https://copaamerica.com/es/noticias/a-14-dias-del-inicio-de-la-copa-14-estadisticas-de-la-copa-america).\nWith so many tournaments going on right now (and with the African Cup of\nNations starting in a few days) a lot of the news media is spread thin\nright now but there are still some quality articles out there to read\nabout the Copa, like [this\narticle](https://www.bbc.com/sport/football/48600098) from BBC’s South\nAmerican football expert, Tim Vickery.\n\nAfter the first round of games, a few points of discussion:\n\n- After an extremely lacklustre performance vs. Colombia, how does\n Argentina bounce back? What tactical changes need to be made?\n\n- Qatar impressed against Paraguay but can they pull off a major upset\n vs. Colombia?\n\n- How will Japan line-up against Uruguay after a losing by a scoreline\n that didn’t really do their performance justice? How will manager\n Moriyasu balance experience vs. youth, will he start with veteran\n Okazaki after Ueda’s numerous misses vs. Chile?\n\n- Can Brazil earn a early ticket to the next round vs. Venezuela after\n a clinical but not excellent performance vs. Bolivia? Will they be\n able to keep up their streak of winning the Copa every time they\n have hosted it?\n\nThanks for reading and…\n\n¡Buena suerte a todos equipos!\n"
},
{
"path": "Copa America 2019/copa_america2019.rmd",
"content": "---\ntitle: \"Visualizing the Copa América: Historical Records, Squad Profiles, and Player Profiles with xG statistics!\"\nalways_allow_html: yes\noutput: \n md_document:\n variant: markdown_github\n---\n\n```{r setup, include=FALSE, message=FALSE, warning=FALSE}\nknitr::opts_chunk$set(echo = TRUE, message=FALSE, warning=FALSE)\n```\n\n```{r echo=FALSE, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, ggforce, ggtextures, DT, \n cowplot, rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\nAnother summer and another edition of the Copa América! Along with the Africa Cup of Nations, Nations League finals, the Women's World Cup, Under-21 European Championship AND the Gold Cup this is yet another soccer-filled season after last year's World Cup and the Asian Cup earlier this year (I also did a blog post on these last two tournaments which you can see [here (World Cup)](https://ryo-n7.github.io/2018-06-29-visualize-worldcup/) and [here (Asian Cup)](https://ryo-n7.github.io/2019-01-11-visualize-asian-cup/)). There is so much football going on at once even I can't keep up, especially with the time difference! To not redo all the previous visualizations with Copa América data I tried to find new sources of data and other forms of visualizations to give some insight into the players and teams competing to be the champion of South America. You can find all the code I used in this blogpost here and you can also find other soccer related data viz in my [soccer_ggplot](https://github.com/Ryo-N7/soccer_ggplots) Github repo. \n\nThe sections will go from a very macro-level view of the __historical records__ of the tournament, to the __squads__ competing, the teams' __match record__ in the Copa América, and finally to a micro-level view of various attacking players using __xG__ statistics.\n\n¡Vámonos!\n\n## Packages\n\n```{r eval=FALSE, message=FALSE, warning=FALSE}\nlibrary(dplyr) ## data wrangling\nlibrary(tidyr) ## data wrangling\nlibrary(purrr) ## data wrangling and iteration\nlibrary(stringr) ## data wrangling\nlibrary(rvest) ## webscraping\nlibrary(polite) ## webscraping (Github only pkg)\nlibrary(ggplot2) ## plotting\nlibrary(scales) ## plotting scales\nlibrary(ggimage) ## images for flags\nlibrary(ggforce) ## plotting text labels\nlibrary(cowplot) ## plotting grid\nlibrary(glue) ## text\nlibrary(ggrepel) ## plotting text labels\nlibrary(magick) ## plotting\nlibrary(DT) ## tables\nlibrary(ggtextures) ## soccer ball emoji as geom_col()\nlibrary(extrafont) ## fonts: Roboto Condensed\n\nloadfonts()\n```\n\n## theme_copaAmerica\n\nI wanted to have all the plots in this blogpost to have a consistent color theme. As the tournament is going to be held in Brazil, I went with a color theme based on its flag with blue, yellow, and green being the primary colors.\n\n```{r}\ntheme_copaAmerica <- function(\n title.size = 24,\n subtitle.size = 14,\n caption.size = 8,\n axis.text.size = 14,\n axis.text.x.size = 12,\n axis.text.y.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(size = 0.5, color = \"white\"),\n panel.grid.major.y = element_line(size = 0.5, color = \"white\"),\n panel.grid.minor.x = element_blank(),\n panel.grid.minor.y = element_blank(),\n axis.ticks = element_line(color = \"white\")) {\n ## Theme:\n theme(text = element_text(family = \"Roboto Condensed\", color = \"white\"),\n plot.title = element_text(family = \"Roboto Condensed\", face = \"bold\", \n size = title.size, color = \"yellow\"),\n plot.subtitle = element_text(size = subtitle.size),\n plot.caption = element_text(size = caption.size),\n panel.background = element_rect(fill = \"#009b3a\"),\n plot.background = element_rect(fill = \"#002776\"),\n axis.text = element_text(size = axis.text.size, color = \"white\"),\n axis.text.x = element_text(size = axis.text.x.size, color = \"white\"),\n axis.text.y = element_text(size = axis.text.y.size, color = \"white\"),\n axis.title = element_text(size = axis.title.size),\n axis.line.x = element_blank(),\n axis.line.y = element_blank(),\n panel.grid.major.x = panel.grid.major.x,\n panel.grid.major.y = panel.grid.major.y,\n panel.grid.minor.x = panel.grid.minor.x,\n panel.grid.minor.y = panel.grid.minor.y,\n strip.text = element_text(color = \"yellow\", face = \"bold\", \n size = strip.text.size, \n margin = margin(4.4, 4.4, 4.4, 4.4)),\n strip.background = element_blank(),\n axis.ticks = axis.ticks\n )\n}\n```\n\n## Top Goal Scorers // Goleadores\n\nFor this plot I took the stats from the Spanish version of the Wikipedia page as it had more content. I used `purrr::flatten_df()` to squish the list output into a dataframe then set the names of each column using `purrr::set_names()`.\n\n```{r, eval=FALSE}\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_top_scorers <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(95)\") %>% \n html_table() %>% \n flatten_df() %>% \n set_names(c(\"player\", \"country\", \"goals\")) %>% \n mutate(image = \"https://www.emoji.co.uk/files/microsoft-emojis/activity-windows10/8356-soccer-ball.png\")\n```\n\n```{r, eval=FALSE, echo=FALSE}\nsaveRDS(copa_top_scorers, file = here::here(\"data/copa_top_scorers.RDS\"))\n```\n\n```{r, echo=FALSE}\ncopa_top_scorers <- readRDS(file = here::here(\"data/copa_top_scorers.RDS\"))\n```\n\n```{r}\nglimpse(copa_top_scorers)\n```\n\nLike in the Asian Cup blogpost I use [Claus Wilke](https://twitter.com/ClausWilke/)'s [ggtextures](https://github.com/clauswilke/ggtextures) package to use __soccer ball emoji__ as the column image in the plot.\n\n```{r, fig.height = 8, fig.width = 10}\ncopa_goleadores_raw_plot <- copa_top_scorers %>% \n head(5) %>% \n ggplot(aes(x = reorder(player, goals), y = goals,\n image = image)) +\n geom_isotype_col(img_width = grid::unit(1, \"native\"), img_height = NULL,\n ncol = NA, nrow = 1, hjust = 0, vjust = 0.5) +\n geom_text(aes(label = goals, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18),\n expand = c(0, 0), \n limits = c(0, 19)) +\n labs(title = \"Top Scorers of the Copa América\",\n subtitle = glue(\"\n Most goals in a single tournament: 9 \n Humberto Maschio (Argentina), Javier Ambrois (Uruguay), Jair (Brazil)\"),\n y = \"Number of Goals\", x = NULL,\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 26,\n subtitle.size = 16,\n caption.size = 12,\n axis.text.size = 18,\n axis.title.size = 18,\n panel.grid.major.y = element_blank(),\n axis.ticks = element_blank())\n\n## Add flags to y-axis:\naxis_image <- axis_canvas(copa_goleadores_raw_plot, axis = 'y') + \n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 16.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/1/1a/Flag_of_Argentina.svg\", \n y = 12.5, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/f/fe/Flag_of_Uruguay.svg\", \n y = 9, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/commons/d/df/Flag_of_Peru_%28state%29.svg\", \n y = 5.25, scale = 1.8) +\n draw_image(\"https://upload.wikimedia.org/wikipedia/en/0/05/Flag_of_Brazil.svg\", \n y = 1.5, scale = 1.8)\n\ncopa_goleadores_plot <- ggdraw(insert_yaxis_grob(copa_goleadores_raw_plot, axis_image, position = \"left\"))\ncopa_goleadores_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = copa_goleadores_plot, filename = here::here(\"Copa America 2019/output/copa_goleadores_plot.png\"),\n height = 8, width = 10)\n```\n\nMost of these players aren't ones you might recognize. The Copa América used to be held a lot more regularly (and sometimes erratically) until this century so players had a lot more opportunities to score goals. All five of the players you see here played in the 1930s-1950s when there was a tournament every one or two years. Out of currently active players, Peruvian legend Paolo Guerrero has 11 goals along with Eduardo Vargas (from Chile). (Edit: after the Chile - Japan game, Vargas is on 12...) Another player you might recognize that was actually tied with Ademir for 5th place, along with three other players, was Gabriel Batistuta (\"Batigol\").\n\n## Winners of the Copa América\n\nAfter grabbing the data from the Wikipedia page I used a variety of functions to clean and reshape the dataset like `tidyr::separate()` to split the number of occurences and the year.\n\n```{r, warning=FALSE, eval=FALSE}\nurl <- \"https://es.wikipedia.org/wiki/Anexo:Estad%C3%ADsticas_de_la_Copa_Am%C3%A9rica\"\n\nsession <- bow(url)\n\ncopa_campeones <- scrape(session) %>% \n html_nodes(\".mw-parser-output > table:nth-child(10)\") %>% \n html_table() %>% \n flatten_df()\n\ncopa_campeones_limpia <- copa_campeones %>% \n janitor::clean_names() %>% \n slice(1:8) %>% \n select(1:4) %>% \n set_names(c(\"team\", \"winners\", \"runners_up\", \"third_place\")) %>% \n separate(winners, into = c(\"Champions\", \"first_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(runners_up, into = c(\"Runners-up\", \"second_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(third_place, into = c(\"Third Place\", \"third_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n mutate_all(list(~str_replace_all(., \"–\", \"0\"))) %>% \n mutate_at(vars(contains(\"num\")), funs(as.numeric)) %>% \n gather(key = \"key\", value = \"value\", -team, \n -first_place_year, -second_place_year, -third_place_year) %>% \n mutate(key = as.factor(key),\n value = as.numeric(value),\n team = team %>% str_replace(., \"[A-Z]{3}\", \"\") %>% str_trim(.),\n team = case_when(team == \"Brasil\" ~ \"Brazil\",\n TRUE ~ team)) %>% \n mutate(key = forcats::fct_relevel(key, \n \"Champions\",\n \"Runners-up\",\n \"Third Place\")) %>% \n arrange(key, desc(value)) %>% \n mutate(team = forcats::as_factor(team),\n order = row_number())\n```\n\n```{r, eval=FALSE, echo=FALSE}\nsaveRDS(copa_campeones_limpia, file = here::here(\"data/copa_campeones_clean.RDS\"))\n```\n\n```{r, echo=FALSE}\ncopa_campeones_limpia <- readRDS(file = here::here(\"data/copa_campeones_clean.RDS\"))\n```\n\nI also wanted to add flags to this plot but `cowplot::insert_yaxis_grob()` is unfortunately not compatible with facets. I used `stringr::str_wrap()` to format the subtitle nicely while I used `glue::glue()` to avoid having the use '\\n' to create a new line for the caption.\n\n```{r, fig.height = 6, fig.width = 8}\ncopa_ganadores_plot <- copa_campeones_limpia %>% \n ggplot(aes(value, forcats::fct_rev(team), color = key)) +\n geom_point(size = 10) + # 10\n geom_text(aes(label = value), \n size = 5, color = \"black\", # 5 \n family = \"Roboto Condensed\", fontface = \"bold\") +\n scale_color_manual(values = c(\"Champions\" = \"#FFCC33\",\n \"Runners-up\" = \"#999999\",\n \"Third Place\" = \"#CC6600\"),\n guide = FALSE) +\n scale_x_continuous(breaks = c(1, 5, 10, 15),\n labels = c(1, 5, 10, 15),\n limits = c(-1, 16)) +\n labs(x = \"Number of Occurrence\", y = NULL,\n title = \"Most Successful Teams of the Copa América!\",\n subtitle = str_wrap(\"Ordered by number of Copa América(s) won. Argentina missed the chance to leapfrog Uruguay after consecutive final losses in the previous two tournaments!\", width = 80),\n caption = glue(\"\n Source: Wikipedia\n By @R_by_Ryo\")) +\n facet_wrap(~key) +\n theme_copaAmerica(subtitle.size = 14, \n caption.size = 10)\n\ncopa_ganadores_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(filename = here::here(\"Copa America 2019/output/copa_ganadores_plot.png\"),\n height = 6, width = 8)\n```\n\nWhat's surprising to note is that Pele never won a Copa América with Brazil, although he did get Best Player and Top Scorer in the 1959 edition of the tournament. Even more bizarrely Diego Maradona has never won it either! He didn't play in either of the 1991 and 1993 editions where Argentina won their 13th and 14th Copas.\n\n## Copa América Squad Profiles\n\nWe just looked at what happened in the past but who are the players competing in the tournament this year? To take a quick look I web-scraped the squads of each of the competing teams from Wikipedia.\n\nI created a list of the `xpath`s for each of squads and using `purrr::map()` I grabbed the data for each participating country. After I got some meta-information about the country name and the group I created a list-column that stores the squad data as a dataframe in its own column. To explode this out I used `tidyr::unnest()` to reshape the entire dataframe to have one row with all the data for each player in every squad.\n\n```{r, eval=FALSE, echo=FALSE}\nsquad_url <- \"https://en.wikipedia.org/wiki/2019_Copa_Am%C3%A9rica_squads\"\n\nsession <- bow(squad_url)\n\nxpaths <- 1:12 %>% \n map(., ~glue(\"//*[@id='mw-content-text']/div/table[{.x}]\"))\n\nsquads_df_raw <- scrape(session) %>% \n html_node(xpath = '//*[@id=\"toc\"]') %>% \n html_text() %>% \n str_split(\"\\n\") %>% \n unlist() %>% \n tibble::enframe() %>% \n rename(country = value) %>% \n filter(str_detect(country, \"^[1-8]\\\\.\"), !str_detect(country, \"Group\")) %>% \n separate(country, c(\"group\", \"delete\", \"country\"), sep = c(1, 3)) %>% \n slice(1:12) %>% \n mutate(group = LETTERS[as.numeric(group)], \n country = str_trim(country), \n xpaths = xpaths,\n squads = map(xpaths, ~ scrape(session) %>% \n html_node(xpath = .x) %>% \n html_table())) %>% \n unnest(squads) %>%\n filter(Player != \"\") %>% \n mutate(country_league = scrape(session) %>% \n html_nodes(\".nat-fs-player .thumbborder\") %>% \n html_attr(\"alt\"))\n```\n\n```{r, eval=FALSE, echo=FALSE}\nsaveRDS(squads_df_raw, file = here::here(\"data/copa_america2019_squads_raw.RDS\"))\n```\n\n```{r, echo=FALSE}\nsquads_df_raw <- readRDS(file = here::here(\"data/copa_america2019_squads_raw.RDS\"))\n```\n\nTo get a clean dataset I use some `stringr::str_*()` functions to properly format the character strings such as the player positions, ages, date of births. \n\n```{r}\nsquads_df_clean <- squads_df_raw %>% \n janitor::clean_names() %>% \n select(-delete, squad_num = no, \n position = pos, birth_age = date_of_birth_age) %>% \n mutate(position = position %>% str_replace_all(., \"[1-9]\", \"\"),\n birth_age = birth_age %>% str_extract_all(., pattern = \"\\\\([^()]+\\\\)\")) %>% unnest(birth_age) %>% \n group_by(player) %>% \n mutate(colnum = seq_along(player)) %>% \n spread(key = colnum, value = birth_age) %>% \n ungroup() %>% \n select(everything(), dob = `1`, age = `2`) %>% \n mutate(dob = dob %>% str_replace_all(., \"[()]\", \"\") %>% lubridate::as_date(),\n age = age %>% str_extract(., \"[0-9]+\") %>% as.integer,\n country = forcats::fct_relevel(country, \n \"Brazil\", \"Argentina\", \"Uruguay\", \n \"Peru\", \"Qatar\", \"Chile\", \n \"Venezuela\", \"Paraguay\", \"Japan\", \n \"Bolivia\", \"Colombia\", \"Ecuador\",\n ),\n club = case_when(\n club == \"Barcelona\" & country == \"Ecuador\" ~ \"Barcelona (Ecuador)\",\n TRUE ~ club))\n```\n\n```{r, eval=FALSE, echo=FALSE}\nsaveRDS(squads_df_clean, file = here::here(\"data/copa_america2019_squads_clean.RDS\"))\n```\n\n```{r, echo=FALSE}\nsquads_df_clean <- readRDS(file = here::here(\"data/copa_america2019_squads_clean.RDS\"))\n```\n\n```{r}\nglimpse(squads_df_clean)\n```\n\n### Age-histogram\n\nUsing this data I can plot a bunch of histograms:\n\n```{r, fig.height = 8, fig.width = 8}\nage_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_age = median(age)) %>% \n ungroup() %>% \n ggplot(aes(x = age)) +\n geom_histogram(fill = \"red\", binwidth = 1) +\n geom_vline(aes(xintercept = median_age), size = 1.2) +\n geom_label(aes(x = median_age, y = 8, \n label = glue::glue(\"Median: {median_age}\")),\n nudge_x = 0.5, hjust = 0.1, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Age Distribution of Copa América squads\",\n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Age\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0),\n breaks = scales::pretty_breaks()) +\n theme_copaAmerica(title.size = 22,\n subtitle.size = 14, \n caption.size = 8,\n axis.text.size = 12,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\")) +\n facet_wrap(~country, ncol = 3)\n \nage_country_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = age_country_plot, filename = here::here(\"Copa America 2019/output/age_country_plot.png\"),\n height = 8, width = 8)\n```\n\nIn terms of age, Japan have the youngest team with a median of 21, 4 years younger than the next youngest team, Qatar. The rest have a fairly balanced spread of ages from 20 to early-mid 30s with most of the medians hovering around 27 years of age. The reason for Japan's extremely young squad is due to the fact that the full-strength Japan team has played in both the World Cup and the Asian Cup in the past year. Along with the fact that the Tokyo Olympics are next year, it was decided to use the invitation to the Copa América as a trial-by-fire for the young stars of the future. Much like in a real Olympic squad, the team contains three \"overage\" players in World Cup 2010/2014/2018 goalkeeper Eiji Kawashima, Premier League winner Shinji Okazaki, and Getafe playmaker Gaku Shibasaki.\n\nThe oldest player will be Brazil captain Dani Alves at 36 with Paraguay's Oscar Cardozo only two weeks younger. On the other hand, the youngest player is Japan's 18-year old prodigy Takefusa Kubo, the ex-Barcelona youth player who only just recently moved to Real Madrid! In light of his transfer a lot of eyes will be on him to see if he can produce some Captain Tsubasa-esque performances for a very inexperienced Japan team gearing up for the Tokyo Olympics!\n\n### Caps histogram\n\nWhen considering the experience of a squad it's not enough to look at ages but one needs to look at the caps or appearances for the national team as well.\n\n```{r, fig.height = 8, fig.width = 8}\ncaps_country_plot <- squads_df_clean %>% \n group_by(country) %>% \n mutate(median_cap = median(caps)) %>% \n ungroup() %>% \n ggplot(aes(x = caps)) +\n geom_histogram(fill = \"red\", binwidth = 5) +\n geom_vline(aes(xintercept = median_cap), size = 1.25) +\n geom_label(aes(x = median_cap, y = 15, \n label = glue::glue(\"Median: {median_cap}\")),\n nudge_x = 0.5, hjust = 0.05, size = 3,\n family = \"Roboto Condensed\", color = \"black\") +\n labs(title = \"Caps (Appearances) by Country\", \n subtitle = \"Columns ordered Group A to Group C\",\n x = \"Caps\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0)) +\n theme_copaAmerica(\n title.size = 20,\n subtitle.size = 14, \n caption.size = 10,\n axis.text.size = 10,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.x = element_line(color = \"white\", size = 0.25),\n panel.grid.major.y = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.x = element_line(color = \"white\", size = 0.25),\n panel.grid.minor.y = element_line(color = \"white\", size = 0.25)) +\n facet_wrap(~country, ncol = 3)\n\ncaps_country_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = caps_country_plot, filename = here::here(\"Copa America 2019/output/caps_country_plot.png\"),\n height = 8, width = 8)\n```\n\nThe majority of Japan's squad have 0 (ZERO) caps, with the aforementioned three \"overage\" players taking up most of the proportion of caps on the team. Bolivia are also taking a untested squad with 8 of their players with 2 caps or less! Chile, Uruguay, and Argentina bring their veterans with multiple players over or around 100 caps. From this data I was surprised that Jefferson Farfan and Paolo Guerrero didn't have 100 caps by now...\n\nThe player with the most caps is Lionel Messi (130) followed closely by Diego Godin (126), and Alexis Sanchez (124). On the other hand there are 29 players hopeful of making their first national team appearance at this tournament with the majority (17 players) coming from Japan.\n\n### Goal distribution\n\nNext I looked at the distribution of goals scored by the midfielders and strikers of each team. I found out about using `ggplot2::position_nudge()` for slightly adjusting variables on a discrete scale in similar fashion to the `nudge_y =` and `nudge_x =` arguments most people might be familiar with from other geoms. I also used `ggforce::geom_mark_hull()` to do some labelling.\n\n```{r, fig.height = 6, fig.width = 8}\ngoals_country_plot <- squads_df_clean %>% \n filter(position %in% c(\"MF\", \"FW\")) %>% \n group_by(country) %>% \n mutate(median = median(goals)) %>% \n ungroup() %>% \n ggplot(aes(x = goals, y = reorder(country, median))) +\n ggridges::geom_density_ridges(fill = \"red\", color = \"white\", scale = 1.1) +\n geom_point(aes(x = median, y = country), position = position_nudge(y = 0.25),\n color = \"yellow\", size = 3) +\n ggforce::geom_mark_hull(aes(filter = country == \"Argentina\" & goals == 67, label = \"Lionel Messi: 67 goals\"),\n label.buffer = unit(15, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 55, label = \"Luis Suarez: 55 goals\"),\n label.buffer = unit(5, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Japan\" & goals == 50, label = \"Shinji Okazaki: 50 goals\"),\n label.buffer = unit(2, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Uruguay\" & goals == 46, label = \"Edinson Cavani: 46 goals\"),\n label.buffer = unit(25, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n ggforce::geom_mark_hull(aes(filter = country == \"Chile\" & goals == 41, label = \"Alexis Sanchez: 41 goals\"),\n label.buffer = unit(4, \"mm\"), label.fontsize = 10, label.fill = \"red\",\n label.family = \"Roboto Condensed\", label.colour = \"white\",\n con.cap = unit(1, \"mm\"), con.type = \"straight\") +\n scale_x_continuous(limits = c(0, 73),\n expand = c(0.01, 0.01),\n breaks = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70),\n labels = c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70)) +\n expand_limits(y = 13.5) +\n labs(title = \"Distribution of Goals Scored by Midfielders and Strikers\",\n subtitle = \"Copa América 2019 squads, Yellow dot = Median goals\",\n x = \"Goals\", y = NULL,\n caption = glue::glue(\"\n Source: Wikipedia\n Data from prior to start of tournament\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18) \n\ngoals_country_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = goals_country_plot, filename = here::here(\"Copa America 2019/output/goals_country_plot.png\"),\n height = 6, width = 8)\n```\n\nWith a lot of these players being more defensively minded or new players the distribution is heavily skewed but you can see little mounds showing the top goalscorers for each country and see which countries have their goalscorers spread out among multiple players such as Brazil, Qatar, and Peru.\n\nIf you know your South American players you can take a good guess at who are the top goal scorers for each nation. For Colombia the two outlying mounds are obviously James Rodriguez and Falcao, for example. Venezuela's top scorer with 22 is Salomon Rondon and for Brazil, if not for his injury, a lonesome mound would have appeared for Neymar with 60 goals!\n\n### Player contribution by league\n\nNow let's check the player contribution to the squads at the Copa América by league. I'm just going to use the country that the league is from for simplicity's sake. Originally I wanted to `left_join()` it with a 'country <> domestic league' table but couldn't find one and the league names itself aren't very meaningful or have awful sponsor names that obfuscate the country of origin even further. \n\n```{r, fig.height = 7, fig.width = 8}\nplayer_contrib_league_plot <- squads_df_clean %>% \n group_by(country_league) %>%\n summarize(n = n()) %>%\n ungroup() %>% \n ggplot(aes(y = n, x = reorder(country_league, n))) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 4.5, color = \"yellow\",\n nudge_y = 0.5) +\n coord_flip() +\n scale_y_continuous(labels = c(0, 5, 10, 15, 20, 25),\n breaks = c(0, 5, 10, 15, 20, 25),\n limits = c(0, 30),\n expand = c(0, 0)) +\n labs(title = \"Breakdown of Player Contributions by League\",\n subtitle = glue(\"\n Shown as Country Name \n Mexico (Liga MX) contributed 27 players to South American squads\"),\n x = \"League (Country name)\", y = \"Number of players\",\n caption = glue::glue(\"\n Source: Wikipedia\n By: @R_by_Ryo\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 12,\n caption.size = 10, \n axis.text.size = 14,\n axis.text.y.size = 11,\n axis.title.size = 16,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\"))\n\nplayer_contrib_league_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = player_contrib_league_plot, filename = here::here(\"Copa America 2019/output/player_contrib_league_plot.png\"),\n height = 7, width = 8)\n```\n\nThe best of the best players from South American countries will move on to Europe so the Argentinean league (Superliga Argentina) and the Brazilian league (Brasileirão - Serie A) do not have as many players as you might think and as a consequence, the top leagues of England, Spain, and Italy contribute quite a bit! A lot of the better players but not quite elite South American players might go to Mexico instead of a lower-mid European league. With the growth of the MLS a fair number of players ply their trade there as well.\n\nWe can take a more detailed look by creating a table of the proportion of players from each squad coming from either a domestic league or any other league. I had to do a lot of wrangling to get the proper output for the table. After calculating the percentage of domestic players from a country's domestic league I added the full data back in. Then I had to make sure that for each country, the country - domestic league country was the first row in each of the country groups (so Bolivia - Bolivia, Bolivia, China, Japan - Japan, Japan - England, etc.). By doing this I can automatically `tidyr::fill()`-in the rest of the rows of that country with the 'percentage of players from domestic league stat'. \n\n```{r}\nsquads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n filter(country == country_league) %>% \n mutate(perc_from_domestic_league = percent(player_from_league / 23, accuracy = 0.1)) %>% \n right_join(squads_df_clean %>% \n group_by(country, country_league) %>% \n summarize(player_from_league = n()) %>% \n ungroup()) %>% \n mutate(first = case_when(\n country == country_league ~ 1,\n TRUE ~ 0)) %>% \n arrange(country, desc(first)) %>% \n fill(perc_from_domestic_league) %>% \n group_by(country) %>% \n mutate(perc_from_league = percent(player_from_league / 23, accuracy = 0.1),\n country_league = glue::glue(\"{country_league} - league\")) %>% \n arrange(desc(player_from_league)) %>% \n select(Country = country, `League (country name)` = country_league,\n `Number of players from league` = player_from_league,\n `Percentage of players from league` = perc_from_league,\n `Percentage of players from domestic league` = perc_from_domestic_league) %>% \n head(10) %>% \n knitr::kable(format = \"html\",\n caption = \"Breakdown of Player Contribution by League\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\nThree interesting facts I found:\n\n- 30% of players on the Brazil squad play for an English team, most out of any league - squad combination excluding domestic leagues.\n- 100% of the Qatar squad play in their domestic league!\n- Only one Uruguayan player (4.3%) plays in its domestic league.\n\n### Player contribution by club\n\nIn the final plot for this section, I looked at the top 10 clubs contributing the most players to the tournament. I used `arrange(desc(n)) %>% slice()` instead of `top_n()` as there were too many teams tied at 4 players. To set the team names inside the bars I created a midpoint value `midval` that calculated a value half of the number of players contributed so the labels were placed neatly.\n\n```{r fig.height = 6, fig.width = 8}\nplayer_contrib_club_plot <- squads_df_clean %>% \n group_by(club) %>% \n summarize(n = n()) %>% \n mutate(club = club %>% forcats::as_factor() %>% forcats::fct_reorder(n),\n midval = n / 2) %>% \n arrange(desc(n)) %>% \n slice(1:15) %>% \n ggplot(aes(x = club, y = n)) +\n geom_col(fill = \"red\") +\n geom_text(aes(label = n, family = \"Roboto Condensed\", fontface = \"bold\"), \n size = 7.5, color = \"yellow\",\n nudge_y = 0.5) +\n geom_text(aes(y = midval, label = club, \n family = \"Roboto Condensed\", fontface = \"bold\"),\n size = 5, color = \"white\") +\n coord_flip() +\n scale_y_continuous(breaks = scales::pretty_breaks(),\n expand = c(0, 0),\n limits = c(0, 10.5)) +\n labs(title = \"Top 15 Clubs contributing the most players to the Copa América\",\n x = \"Club\", y = \"Number of players\",\n caption = \"Source: Wikipedia\") +\n theme_copaAmerica(\n title.size = 18,\n subtitle.size = 12, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.major.y = element_blank(),\n panel.grid.minor.x = element_line(color = \"white\")) +\n theme(axis.text.y = element_blank(),\n axis.ticks.y = element_blank())\n\nplayer_contrib_club_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = player_contrib_club_plot, filename = here::here(\"Copa America 2019/output/player_contrib_club_plot.png\"),\n height = 6, width = 8)\n```\n\nWith 100% of its players coming from the domestic league it's not surprise that the Qatari team, Al-Sadd, is contributing the most players to the tournament. Tied with another Qatari team, Mexican club America features 7 players yet none of them are Mexicans (2 Argentineans, 2 Colombians, 1 Ecuadorian, 1 Chilean, and 1 Paraguayan). \n\nAt first I thought Barcelona contributed 8 players until I realized the Ecuadorian players were coming from the Ecuadorian team called Barcelona...I had to go all the way back up to the beginning of this section to fix that small peculiarity. As futbol came to South America via European colonists and immigrants a lot of teams took up the names and colors of the teams these Europeans were fond of. Other examples include Liverpool F.C. (Montevideo, Uruguay), Arsenal de Sarandi (Buenos Aires, Argentina), and Club Atletico Juventus (Sao Paulo, Brazil - although they use the colors of Torino F.C.).\n\nIf you download the data and type in the code below you can see the entire club-country list.\n\n```{r, eval=FALSE}\nsquads_df_clean %>% \n group_by(club, country) %>% \n summarize(n = n()) %>% View()\n```\n\n## Match Records\n\nNow that we got a good look at the composition of the teams, we can take a look at how they've done at every Copa América.\n\nThe next code chunk mainly comes from PH Julien and his excellent Kaggle kernel of [\"A Journey Through The History of Soccer\"](https://www.kaggle.com/phjulien/a-journey-through-the-history-of-soccer/).\n\n```{r, message=FALSE, eval=FALSE}\n## grab football federation affiliations data\nfederation_files <- Sys.glob(\"../data/federation_affiliations/*\")\n\ndf_federations = data.frame(country = NULL, federation = NULL)\nfor (f in federation_files) {\n federation = basename(f)\n content = read.csv(f, header=FALSE)\n content <- cbind(content,federation=rep(federation, dim(content)[1]))\n df_federations <- rbind(df_federations, content)\n}\n\ncolnames(df_federations) <- c(\"country\", \"federation\")\n\ndf_federations <- df_federations %>% \n mutate(country = as.character(country) %>% str_trim(side = \"both\"))\n\nresults_raw <- readr::read_csv(\"../data/results.csv\")\n\nresults_copa <- results_raw %>% \n filter(tournament == \"Copa América\") %>% \n rename(venue_country = country, \n venue_city = city) %>% \n mutate(match_num = row_number())\n\n## combine with federation affiliations\nresults_copa_home <- results_copa %>% \n left_join(df_federations, \n by = c(\"home_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(home_federation = federation) \n\nresults_copa_away <- results_copa %>% \n left_join(df_federations, \n by = c(\"away_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(away_federation = federation)\n\n## combine home-away\nresults_copa_cleaned <- results_copa_home %>% \n full_join(results_copa_away)\n```\n\nUnfortunately, this data does not have __penalty__ results as those games are all counted as a draw (as technically that is the actual result). Considering there a lot of cagey knock-out rounds that finish in a penalty shoot-out (including the last two finals...) it is unfortunate but that's just the data you have sometimes. There is a way to web-scrape all the Copa América results and assign Win-Lose to those games that went to penalties but I'll leave that for another time. Also, there is no info on what stage of the tournament the match recorded is in.\n\n```{r, eval=FALSE}\nresults_copa_cleaned <- results_copa_cleaned %>% \n mutate(\n home_federation = case_when(\n home_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ home_federation),\n away_federation = case_when(\n away_team == \"USA\" ~ \"Concacaf\",\n TRUE ~ away_federation)) %>% \n select(-contains(\"federation\"), -contains(\"venue\"),\n -neutral, date, home_team, home_score, away_team, away_score, \n tournament, venue_city)\n```\n\n```{r, echo=FALSE, eval=FALSE}\nsaveRDS(results_copa_cleaned, file = here::here(\"data/results_copa_cleaned.RDS\"))\n```\n\n```{r, echo=FALSE}\nresults_copa_cleaned <- readRDS(file = here::here(\"data/results_copa_cleaned.RDS\"))\n```\n\n```{r}\nglimpse(results_copa_cleaned)\n```\n\nNow that it's nice and cleaned up I created a function that reshapes the data so that it's set from a certain team's perspective with the \"team\" argument. You can also set the function to look for only results against a certain opponent by filling in the `versus` argument.\n\n```{r}\ncopaAmerica_resultados <- function(data, team, versus = NA) {\n \n ## team of interest: ex. 'Brazil'\n team_var <- enquo(team)\n \n todos_partidos <- data %>% \n ## filter only for results of team of interest\n filter(home_team == !!team_var | away_team == !!team_var) %>% \n ## reshape columns to team vs. opponent\n mutate(\n opponent = case_when(\n away_team != !!team_var ~ away_team,\n home_team != !!team_var ~ home_team),\n home_away = case_when(\n home_team == !!team_var ~ \"home\",\n away_team == !!team_var ~ \"away\"),\n equipo_goals = case_when(\n home_team == !!team_var ~ home_score,\n away_team == !!team_var ~ away_score),\n opp_goals = case_when(\n home_team != !!team_var ~ home_score,\n away_team != !!team_var ~ away_score)) %>% \n ## label results from team's perspective\n mutate(\n result = case_when(\n equipo_goals > opp_goals ~ \"Win\",\n equipo_goals < opp_goals ~ \"Loss\",\n equipo_goals == opp_goals ~ \"Draw\")) %>% \n mutate(result = result %>% forcats::as_factor() %>% forcats::fct_relevel(c(\"Win\", \"Draw\", \"Loss\"))) %>% \n select(-contains(\"score\"), -contains(\"team\"), -match_num) %>% \n rename(Date = date, Tournament = tournament, `Venue` = venue_city, Opponent = opponent, `Home / Away` = home_away,\n `Goals For` = equipo_goals, `Goals Against` = opp_goals, Result = result)\n \n if (is.na(versus) | is.null(versus)) {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n ## sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n ## spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric)\n \n missing_cols <- c(\"Win\", \"Draw\", \"Loss\") %>% \n map_dfr( ~tibble(!!.x := numeric()))\n \n resultados_totalmente <- resultados_totalmente %>% \n bind_rows(missing_cols) %>% \n mutate(Win = if_else(is.na(Win), 0, Win),\n Draw = if_else(is.na(Draw), 0, Draw),\n Loss = if_else(is.na(Loss), 0, Loss)) %>%\n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n } else { \n ## opponent: ex. 'Argentina'\n todos_partidos <- todos_partidos %>% \n filter(Opponent == versus)\n \n if (nrow(todos_partidos) == 0) {\n return(glue(\"{team} has never played {versus} at the Copa América!\")) \n } else {\n \n resultados_totalmente <- todos_partidos %>% \n group_by(Result, Opponent) %>% \n mutate(n = n()) %>% \n ungroup() %>% \n # sum amount of goals by team and opponent\n group_by(Result, Opponent) %>% \n summarize(e_g = sum(`Goals For`),\n o_g = sum(`Goals Against`),\n n = n()) %>% \n ungroup() %>% \n # spread results over multiple columns\n spread(Result, n) %>% \n mutate_if(is.integer, as.numeric) %>% \n group_by(Opponent) %>% \n summarize(Win = sum(Win, na.rm = TRUE),\n Draw = sum(Draw, na.rm = TRUE),\n Loss = sum(Loss, na.rm = TRUE),\n `Goals For` = sum(e_g),\n `Goals Against` = sum(o_g))\n \n return(list(resultados_totalmente, todos_partidos))\n }\n }\n}\n```\n\nThe output is either a dataframe of all the games a team has been involved in as well as the record of the team against other teams in the Copa América or a message saying that the team you picked has never played against the opponent you picked.\n\n### Japan\n\n```{r, warning=FALSE}\ncopaAmerica_resultados(data = results_copa_cleaned, \n team = \"Japan\", versus = \"Brazil\")\n```\n\nOh... that's right Japan has never played against Brazil at the Copa...\n\n```{r}\nresultados_japon <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Japan\")\n\nresultados_japon[[2]] %>% \n knitr::kable(format = \"html\",\n caption = \"Japan's record in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\nJapan's only previous journey to the Copa América was in the 1999 edition where they lost all 3 games. They were invited for the 2011 edition but withdrew due to the Tohoku Earthquake and were replaced by Costa Rica. Japanese football has come a long way since 1999 but with a young squad it will be a uphill battle to get 3 points against any of their Group C opponents, Uruguay, Chile, and Ecuador.\n\n### Colombia\n\n```{r}\nresultados_colombia <- copaAmerica_resultados(data = results_copa_cleaned, team = \"Colombia\") \n\nresultados_colombia[[2]] %>% \n slice(87:92) %>% \n knitr::kable(format = \"html\",\n caption = \"Colombia's record in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\nDespite a recent resurgence of the Colombia national team they have not been able to match the feats of the 2001 side that won the Copa with their best place finish since then coming 3rd in 2004. The 2001 team were not only unbeaten but also did not concede a single goal throughout the tournament!\n\n### Superclasico Sudamericano: Brazil vs. Argentina\n\n```{r}\nresultados_de_brazil <- copaAmerica_resultados(data = results_copa_cleaned, \n team = \"Brazil\", versus = \"Argentina\")\n\nresultados_de_brazil[[1]] %>% \n knitr::kable(format = \"html\",\n caption = \"Brazil vs. Argentina in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\n```{r}\nresultados_de_brazil[[2]] %>% \n tail(5) %>% \n knitr::kable(format = \"html\",\n caption = \"Brazil vs. Argentina in the Copa América\") %>% \n kableExtra::kable_styling(full_width = FALSE)\n```\n\nBrazil does not have a good overall record vs. Argentina but they have not lost against their rivals at the Copa América since the 1993 edition where they lost 5-6 on penalties in the Quarter Finals. The \"draw\" in 1995 was won on penalties while the \"draw\" in 2004 was actually in the final where they won 4-2 on penalties.\n\nWhat I found odd was that the Copa América seems to have a very low priority to certain countries, especially Brazil who have repeatedly sent their B or C teams to the tournament in favor of sending their best team to other tournaments or resting star players. Funnily enough these understrength Brazilian squads have actually won the entire tournament a few times, most notably in 2007 against a full strength Argentina side containing the likes of Zanetti, Riquelme, Cambiasso, Tevez, a young Messi/Mascherano, Cambiasso, et al!\n\n## Player Profiles\n\nAfter looking at the history of the competition and the composition of the squads I examined the players and their form coming into the Copa América. In recent years football analytics has really taken off and there have been many strides made in creating more informative statistics to assess players' abilities, the most prominently being the __xG__ statistics. This is the first time I talk about __xG__ in any length/depth so this introduction is as much to solidify my understanding as well as yours!\n\n### What IS xG?\n\n- __xG__: Quantitative measure (between 0 and 1) that assigns a probability that a shot taken will result in a goal based on a variety of variables and is used for evaluating the quality of chances and predicting players' and teams' future performances.\n\n- __xA__: Quantitative measure (between 0 and 1) that assigns a probability that a given pass will result in an assist for a goal based on a variety of variables.\n\nCommon variables used in the models that output xG statistics are the distance and angle of a shot, the body part used, rebound, among others. Similar to how you might assess your favorite striker's chances of scoring just as he is lining up to take a shot: Is the shot a header? Is he trying to score from a cross in regular play or a corner kick? Are there a crowd of defenders in front of him or is he one-on-one with the goalkeeper? Etc. You might think __who__ takes a shot would be a genuine factor but in actuality it tells you a lot less about the chances of a goal compared to the location of the shot.\n\nNote that there isn't a SINGLE xG model. You can check out a blog post comparing different people's xG models [here](https://mackayanalytics.nl/2017/06/19/how-accurate-are-xg-models-ii-the-big-chance-dilemma/). People and organizations (from Statsbomb to OptaPro) have their own ideas about what __could__ be the important variables in play and as such it's important to report from which source you got your data from as the stats can differ between models. A few things xG does not factor in are things like goalkeeper performance (someone pulling off incredible saves or letting in a poor shot) and one must also consider the fact that team style of play and the quality of a player's teammates. When judging players based on these stats it is important to be aware of contextual factors like the team they play for, their opponent, and the player's position/role in the team.\n\nFrom xG and xA more granular statistics such as xGChain and xGBuildup were created to be able to dig a little deeper into who is contributing to chance creation, I'll introduce the latter two a bit later. As the field has grown new statistics have popped up such as [Karun Singh](https://twitter.com/karun1710/)'s \"expected threat\" or xT. You can check out an introduction to xT from [here](https://karun.in/blog/expected-threat.html).\n\nOf course, these statistics only tell a part of the story and are definitenly not the be-all-and-end-all. In the context of this current blog post, these stats only tell the story about how these players did for their club teams this past season rather than for their national team. Even still it gives us a good idea of what kind of form these players are in coming into this tournament.\n\nYou might also want to watch these Youtube videos by [TifoFootball](https://www.youtube.com/channel/UCGYYNGmyhZ_kwBF_lqqXdAQ) for a quick primer on [xG](https://www.youtube.com/watch?v=zSaeaFcm1SY) and [xA](https://www.youtube.com/watch?v=1MdlkuzLdj4).\n\n### understat data\n\nFor the data I used the website, `understat.com`. Their xG models were created via training a neural network on a dataset consisting of over 100,000 shots using more than 10 different variables. Getting data from `understat` has been made easy by Ewen Henderson's `understatr` package available from [Github](https://github.com/ewenme/understatr) (he's also the guy that made the [ghibli](https://github.com/ewenme/ghibli) color palette!). I tried to pick a wide selection of attacking players but I was also limited by the fact that `understat` only has data for teams/players from six European leagues (Premier League, Bundesliga, Serie A, La Liga, Ligue 1, and Russian Premier League). \n\nFor __Peru__ I would have chosen Paolo Guerrero but as he plays in Brazil now I went with Jefferson Farfan (who hasn't played as many games as the other players used for comparison unfortunately...). For __Chile__ I would pick Eduardo Vargas but he as doesn't play for a team covered by understat I went with Alexis Sanchez, who had a woeful season and only played ~600 minutes despite appearing in ~20 league matches and later added Arturo Vidal. For __Brazil__ I included Neymar initially but since he won't actually be playing I'll keep him for comparison's sake but also include Gabriel Jesus and Roberto Firmino who have been fighting for the starting striker spot. Note that these two aren't the ones replacing Neymar __positionally__. In Neymar's left-wing position I can see David Neres or Phil Coutinho replacing him (Richarlison and Willian mostly play on the right). (Edit: In the first match vs. Bolivia, David Neres started off on the left while Richarlison played on the right, Coutinho played just behind Bobby Firmino)\n\nThe other nation's strikers/attacking midfielders don't play for the six European leagues covered by understat or like in Shinji Okazaki's case just did not play as many minutes/games during the season. To get the data I created a list of the player codes and use `purrr::map()` to iterate each through the `understatr::get_player_seasons_stats()` function. \n\n```{r, eval=FALSE}\nplayer_codes <- c(2097, 2099, 813, ## Messi, Neymar, Rondon\n 498, 4299, 696, ## Alexis, Farfan, Falcao\n 3294, 2098, 5543, ## Cavani, Suarez, G. Jesus\n 482, 1148, 2249, ## Bobby, Duvan, James\n 1089, 3553, 488, ## Cuadrado, Di Maria, Coutinho\n 222) ## Arturo Vidal\n\nunderstat_data <- player_codes %>% \n map(., ~ understatr::get_player_seasons_stats(.x)) %>% \n reduce(bind_rows) %>% \n select(-player_id, -position, -yellow, -red)\n```\n\n```{r, eval=FALSE, echo=FALSE}\nsaveRDS(understat_data, file = here::here(\"data/copa_america_understat.RDS\"))\n```\n\n```{r, echo=FALSE}\nunderstat_data <- readRDS(file = here::here(\"data/copa_america_understat.RDS\"))\n```\n\n```{r}\nglimpse(understat_data)\n```\n\nAs you can see the data consists of a row for each player and each year (from the 2014/2015 season to the 2018/2019 season). I tried to mitigate the fact that some players played a lot more minutes than others by standardize everything to a 'per 90 minutes' value but this does have its own disadvantages. These include the fact that players who play a lot of minutes (as regular starting members) may not have as high 'per 90' stat even though their production with all these minutes might suggest that they are consistently performing and producing at a high level.\n\nIt'll be a bit crowded (kind of like a spilt box of Skittles...) but let's check out the key metrics for all the players at once.\n\nNote: npg = non-penalty goals, npxG = non-penalty goals xG\n\n```{r, fig.height = 6, fig.width = 8}\ncomparison_data <- understat_data %>% \n filter(year == 2018) %>% \n select(-games, -team_name, -year) %>% \n rename(Shots = shots, KP = key_passes) %>% \n gather(key = \"key\", value = \"value\", -player_name, -time) %>% \n mutate(key = forcats::as_factor(key) %>% \n forcats::fct_relevel(., \n \"xG\", \"goals\", \"npxG\", \"npg\", \n \"xA\", \"assists\", \"xGChain\", \"xGBuildup\",\n \"Shots\", \"KP\"))\n\ncomparison_strikers_plot <- comparison_data %>%\n filter(key != \"Shots\", key != \"KP\",\n key != \"xGBuildup\", key != \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n geom_vline(xintercept = 4.5, size = 2) +\n geom_vline(xintercept = 5.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.26)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Comparison: Top attackers at the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_strikers_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = comparison_strikers_plot, filename = here::here(\"Copa America 2019/output/comparison_strikers_plot.png\"),\n height = 5, width = 8)\n```\n\nAs usual in these types of charts, Messi is leading a lot of the metrics here and showing consistency too with having played the third highest amount of minutes out of the selected players. It's helpful to have the xG/xA stats next to the actual goals/assists as it provides an indication of whether the player in question is scoring shots that he probabilistically should be scoring. When a player's actual goal count is higher than their xG stat this suggests that the player is __\"exceeding their xG\"__ or that they are scoring from shots that are historically hard to score from. It can be seen as a marker of an elite finisher as they are putting away chances from difficult situations consistently. In terms of assists and xA Alexis Sanchez, who only played about 600 minutes, looks a lot better than in reality due to the aforementioned disadvantage of standardizing everything to a \"per 90 minutes\" value. Normally you would have a cut-off based on a certain __minimum amount of minutes__ but as I mentioned I was rather limited in my choice of players.\n\nA way to take a closer look at xG - Goals and xA - Assists is to use a simple dot plot with a line going through the 45 degree angle. Those below the line are underperforming relative to their xG or xA stat, those over it are overachieving (\"exceeding\" their xG/xA stat) while those just on the line are scoring or assisting right around what the model expects the player to be. I use non-penalty xG below as penalties have around ~0.75 xG (give or take a few percentage points depending on the model) and can inflate the stats of those players who take a lot of penalties and score them, especially if they weren't the ones who earned the penalty themselves.\n\n```{r, fig.height = 5, fig.width = 8}\nexpected_goal_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, npxG, xG, goals) %>% \n mutate_at(c(\"npxG\", \"xG\", \"goals\"), ~. / time * 90) %>% \n ggplot(aes(x = npxG, y = goals, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n scale_x_continuous(limits = c(0, 1.1),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 1.3),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n labs(title = \"Expected vs. Actual Goals\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"Non-penalty xG per 90 minutes\",\n y = \"Goals per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_goal_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = expected_goal_plot, filename = here::here(\"Copa America 2019/output/expected_goal_plot.png\"),\n height = 5, width = 8)\n```\n\nGabriel Jesus is quite clearly below the 45 degree line meaning that he has been very poor at finishing chances (and/or incredibly unlucky). After a poor World Cup where he scored 0 goals as a starter, he is really going to have to step up to fill Neymar's goalscoring boots for this tournament. However, his build-up play for City has still been good this past season and he has been scoring for Brazil in the friendlies leading up to the tournament so it's going to be a hard decision for Tite to decide on who starts against Bolivia (edit: Firmino started and contributed an assist while Jesus replaced him in the 65th minute).\n\n```{r, fig.height = 5, fig.width = 8}\nexpected_assists_plot <- understat_data %>% \n filter(year == 2018) %>% \n select(player_name, time, xA, assists) %>% \n mutate_at(c(\"xA\", \"assists\"), ~. / time * 90) %>% \n ggplot(aes(x = xA, y = assists, fill = player_name)) +\n geom_abline(intercept = 0, slope = 1, color = \"white\", size = 1.1) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n labs(title = \"Expected vs. Actual Assists\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = \"xA per 90 minutes\",\n y = \"Assists per 90 minutes\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n scale_x_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 0.55),\n expand = c(0, 0)) +\n scale_fill_manual(values = pals::glasbey(16), name = \"Player\") +\n theme_copaAmerica(panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\"),\n subtitle.size = 11)\n\nexpected_assists_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = expected_assists_plot, filename = here::here(\"Copa America 2019/output/expected_assists_plot.png\"),\n height = 5, width = 8)\n```\n\nOne thing to keep in mind is that xA does not take into account the recipient of the assist pass. Even if the pass given had a high expected assist value the receiving player still might not have the quality to put it away through no fault of the passer. This might explain why most of the players with a higher xA among this group don't have the assists to match. It can also be that these players are also the ones playing a lot more minutes and the volume of chances they create just aren't translating to goals all the time.\n\n### Key Passes, Shots, xGChain, and xGBuildup (per 90)\n\nI separated \"key passes\" and \"shots\" as well as \"xGChain\" and \"xGBuildup\" from the rest as these two sets were on a very different scale.\n\n```{r, fig.height=5, fig.width=7}\nkp_shots_plot <- comparison_data %>%\n filter(key == \"Shots\" | key == \"KP\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 6),\n breaks = c(0, 1, 2, 3, 4, 5, 6),\n labels = c(0, 1, 2, 3, 4, 5, 6)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = glue(\"\n KP = Key Passes\n For select group of attacking players with data available from understat.com\"),\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nkp_shots_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = kp_shots_plot, filename = here::here(\"Copa America 2019/output/kp_shots_plot.png\"),\n height = 5, width = 7)\n```\n\n- xGChain: Quantitative measure that is the combined sum of the xG of every possession that ends in a shot that a player is involved in. The same derived value is given to each of the players involved and allows us to credit players for attacking contributions outside of just shots (xG) and assists (xA). \n\n- xGBuildup: Similar to xGChain but excluding shots and assists. This is in response to xGChain values still being dominated by the xG and xA from shots and assists, respectively. \n\n```{r, fig.height=5, fig.width=7}\nxgbuildup_xgchain_plot <- comparison_data %>%\n filter(key == \"xGBuildup\" | key == \"xGChain\") %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.01, 0.01),\n limits = c(0, 1.55),\n breaks = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5),\n labels = c(0, 0.25, 0.5, 0.75, 1, 1.25, 1.5)) +\n scale_fill_manual(values = pals::glasbey(17), name = \"Player\") +\n geom_vline(xintercept = 1.5, size = 2) +\n labs(title = \"Comparison: Stars of the Copa América\",\n subtitle = \"For select group of attacking players with data available from understat.com\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 18,\n subtitle.size = 10,\n panel.grid.minor.x = element_line(color = \"white\"))\n\nxgbuildup_xgchain_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = xgbuildup_xgchain_plot, filename = here::here(\"Copa America 2019/output/xgbuildup_xgchain_plot.png\"),\n height = 5, width = 7)\n```\n\nAlthough Gabriel Jesus has been poor at finishing his chances as seen in previous graphs, his xGChain and xGBuildup stat makes it clear that he is still contributing to City's attack outside of scoring goals himself (not to mention all the defensive work he does as well).\n\nFor example below, the stats are able to clearly differentiate between James, who is more of a playmaker, compared to Falcao and Duvan who are traditional number 9s with his superior xGBuildup, xGChain, and Key Passes values. For a more detailed overview on xGChain and xGBuildup check out Statsbomb's article [here](https://statsbomb.com/2018/08/introducing-xgchain-and-xgbuildup/).\n\n```{r, fig.height=5, fig.width=7}\n## keep colors for Colombians consistent with other plots\ncolombia_pal <- c(\"#000033\", \"#005300\", \"#009FFF\", \"#00FFBE\")\n\ncomparison_colombia_plot <- comparison_data %>%\n filter(!key %in% c(\"xG\", \"goals\", \"npxG\", \"npg\", \"xA\", \"assists\"),\n player_name %in% c(\"James Rodríguez\", \"Falcao\", \"Duván Zapata\", \"Juan Cuadrado\")) %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_point(shape = 21, size = 5, color = \"black\", stroke = 1.1) +\n geom_vline(xintercept = 1.5, size = 2) +\n geom_vline(xintercept = 2.5, size = 2) +\n geom_vline(xintercept = 3.5, size = 2) +\n coord_flip() +\n scale_y_continuous(expand = c(0.05, 0.05),\n breaks = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4),\n labels = c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4)) +\n scale_fill_manual(values = colombia_pal, name = \"Player\") +\n labs(title = \"Comparison: Stars of Colombia\",\n subtitle = \"KP: Key Passes\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"\n data: understat.com\n 2018-2019 Season\")) +\n theme_copaAmerica(title.size = 20,\n subtitle.size = 12,\n panel.grid.minor.x = element_line(color = \"white\"))\n\ncomparison_colombia_plot\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = comparison_colombia_plot, filename = here::here(\"Copa America 2019/output/comparison_colombia_plot.png\"),\n height = 5, width = 7)\n```\n\nThere are lots of different ways to visualize this data, most famously the radar charts created by [Statsbomb](http://statsbomb.com/). Using the data you can also compare and evaluate players in many different ways and using `understatr` package you could add a few more players like Paulo Dybala, Miguel Almiron, and more! I could probably do a whole other article using just this data but I'll leave it here for now.\n\n## Conclusion\n\nThroughout this blog post I talked about some of the historical records, squad compositions, match records, and finally the player profiles of attacking players at this summer's Copa América. Using the power of R it is really easy to webscrape and visualize data in a way that is informative and aesthetically pleasing. I wanted to finish this before the tournament started but other life things got in the way as well as the fact that the amount of content ballooned out of control (especially the xG section) so I had to cut down a lot. \n\nIt's been fun reading the articles on the Copa América website and seeing how far my \"intermediate-but-very-out-of-practice\"-level of Spanish can get me to understand the content, here is one that I particularly liked reading: [14 Estadisticas de la Copa América](https://copaamerica.com/es/noticias/a-14-dias-del-inicio-de-la-copa-14-estadisticas-de-la-copa-america). With so many tournaments going on right now (and with the African Cup of Nations starting in a few days) a lot of the news media is spread thin right now but there are still some quality articles out there to read about the Copa, like [this article](https://www.bbc.com/sport/football/48600098) from BBC's South American football expert, Tim Vickery.\n\nAfter the first round of games, a few points of discussion:\n\n- After an extremely lacklustre performance vs. Colombia, how does Argentina bounce back? What tactical changes need to be made?\n\n- Qatar impressed against Paraguay but can they pull off a major upset vs. Colombia?\n\n- How will Japan line-up against Uruguay after a losing by a scoreline that didn't really do their performance justice? How will manager Moriyasu balance experience vs. youth, will he start with veteran Okazaki after Ueda's numerous misses vs. Chile?\n\n- Can Brazil earn a early ticket to the next round vs. Venezuela after a clinical but not excellent performance vs. Bolivia? Will they be able to keep up their streak of winning the Copa every time they have hosted it?\n\nThanks for reading and...\n\n¡Buena suerte a todos equipos!"
},
{
"path": "Copa America 2019/copa_extras.Rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"6/15/2019\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n## R Markdown\n\n\nhttps://copaamerica.com/es/noticias/a-14-dias-del-inicio-de-la-copa-14-estadisticas-de-la-copa-america\n\nfixture calendar: https://copaamerica.com/static/CA2019-calendar-ESP-1-d78531672f9b0a782f78f96f57acb21c.png\n\nColores:\n\nhttps://i.ytimg.com/vi/ByYw8EyMr1E/maxresdefault.jpg\n\n```{r}\n#142052 darknavy\n#7CAE51 light grassy green\n#3E632F dark green\n#FEDB45 yellow gold\n#31359D purple\n#245D98 lightblue\n#012488 deep blue\n#4B9213 med green\n```\n\n\nhost nation performance\n- first game results\n\nguest nation performance >>> USA 3rd Place in 2016... also hosts though...\n\ntime-difference\n\nhow far does each team have to travel??\n- hypothetical scenarios all the way to the final: Brazil, Argentina, Japan??\n- grab names of stadiums then `geocode()`\n- brazil training in teresopolis near Rio before the tournament...\n\n- which leagues have contributed most players? boring bar chart\n-- which team\n-- percentage of players coming from each own nation's team?\n\n- avg. age per position? per team?\n\n- squad numbers and position?\n\ntop performers >>> understat (only for top 5 leagues...)\n-->> percentile rank of select players in similar position?\n- Sh90, KP90, xG, xG90, xA, xA90, xGChain90, xGBuildup90\n\ngt tables: green/yellow/red ABOVE+BELOW league avg. (at least 30 appearances)\ncreate radar charts?\n\n```{r, fig.height = 5, fig.width = 8}\nage_position_plot <- squads_df_clean %>% \n group_by(position) %>% \n mutate(median = median(age)) %>% \n ungroup() %>% \n ggplot(aes(x = age)) +\n geom_histogram(fill = \"red\", binwidth = 1) +\n geom_vline(aes(xintercept = median), size = 1.2) +\n labs(x = \"Age\", y = NULL) +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0)) +\n theme_copaAmerica(title.size = 24,\n subtitle.size = 14, \n caption.size = 8,\n axis.text.size = 14,\n axis.title.size = 16,\n strip.text.size = 18,\n panel.grid.minor.x = element_line(color = \"white\"),\n panel.grid.minor.y = element_line(color = \"white\")) +\n facet_wrap(~position)\n\nage_position_plot\n```\n\n\n## Team Profiles\n\nsoccerway\n\n### Argentina\n\n```{r}\n\n```\n\nprobable line-up? >>> most common since world cup?\nGoals + assists\n\n### Brazil\n\n```{r}\nurl <- \"https://us.soccerway.com/teams/brazil/brazil/349/matches/\"\n\nsession <- bow(url)\n\nmatches_links <- scrape(session) %>% \n html_nodes(\".score a\") %>% \n html_attr(\"href\") %>% \n tail(9)\n\nmatches_link_df <- matches_links %>% \n tibble::enframe(name = NULL, value = \"link\") %>% \n mutate(link = glue::glue(\"https://us.soccerway.com{link}\"))\n\none_url <- \"https://us.soccerway.com/matches/2018/10/16/world/friendlies/argentina/brazil/2916264/\"\n\n## starting eleven\n\nbow(one_url) %>% \n scrape() %>% \n html_nodes(\".right .large-link\") %>% \n html_text()\n\nbow(one_url) %>% \n scrape() %>% \n html_nodes(\".left .large-link\") %>% \n html_text()\n\n## home team - away team\n## goal scorers\n## result\n```\n\nprobable line-up?\nGoals + assists\n\n- regex shenanigans...\n\n```{r}\n\n```\n\n\n\n\n\n\n\n\n\n### Lionel Messi\n\n```{r}\nmessi_data_raw <- understatr::get_player_seasons_stats(2097)\n\nmessi_data_clean <- messi_data_raw %>% \n filter(year == 2018) %>% \n select(-player_id, -year, -team_name, \n -position, -yellow, -red)\n```\n\n### Luis Suarez \n\n\n```{r}\nsuarez_data_raw <- understatr::get_player_seasons_stats(2098)\n\nglimpse(suarez_data_raw)\n\nsuarez_data_clean <- suarez_data_raw %>% \n filter(year == 2018) %>% \n select(-player_id, -year, -team_name, \n -position, -yellow, -red)\n```\n\n\n```{r}\ncomparison_data <- bind_rows(messi_data_clean, suarez_data_clean) %>% \n select(-games, -time) %>% \n gather(key = \"key\", value = \"value\", -player_name) %>% \n mutate(key = forcats::as_factor(key) %>% \n forcats::fct_relevel(., \n \"xG\", \"goals\", \"xA\", \"assists\"))\n\ncomparison_data %>%\n ggplot(aes(x = key, y = value, color = player_name)) +\n geom_point(size = 2) +\n coord_flip() +\n labs(title = \"Comparison: Messi vs. Suarez\") +\n theme_copaAmerica() +\n theme(legend.position = \"none\")\n```\n\nof course when you have a lot of players or players with similar stats then it becomes harder to see and that's where the radar chart can be more appropriate.\n\n\n```{r}\ndata <- bind_rows(messi_data_clean, suarez_data_clean) %>% \n select(-games, -time) %>% \n #mutate_at(vars(-player_name), rescale) %>% \n select(1:6) \n\nAttributes = colnames(data)\nAttNo = length(Attributes)\n\n\ncircleFun <- function(center = c(0,0),diameter = 1, npoints = 100){\n r = diameter / 2\n tt <- seq(0,2*pi,length.out = npoints)\n xx <- center[1] + r * cos(tt)\n yy <- center[2] + r * sin(tt)\n return(data.frame(x = xx, y = yy))\n}\n\ncircle1 <- circleFun(c(0,0),200,npoints = 100)\ncircle2 <- circleFun(c(0,0),150,npoints = 100)\ncircle3 <- circleFun(c(0,0),100,npoints = 100)\ncircle4 <- circleFun(c(0,0),50,npoints = 100)\n\n\n\n\nangle_spilt <- (2*pi) / (AttNo)\nangle_spilt_seq <- seq(0,(2*pi),angle_spilt)\n\n# empty dataframes to catch results \nLineData <- data.frame(x = numeric, y = numeric, stringsAsFactors = F)\nTitlePositioning <- data.frame(title = character, x = numeric, y = numeric, stringsAsFactors = F)\n\n## create plot background construction data \nfor (i in 1:NCOL(data)) {\n angle_multiplier <- if(i < NCOL(data)){i}else{1}\n radians_for_segment <- angle_spilt_seq[i]\n\n x <- 100 * cos(radians_for_segment)\n y <- 100 * sin(radians_for_segment)\n temp <- data.frame(x = x, y = y, stringsAsFactors = F)\n LineData <- rbind(temp, LineData)\n \n x <- 112 * cos(radians_for_segment)\n y <- 112 * sin(radians_for_segment)\n title <- colnames(data)[i]\n temp <- data.frame(title = title, x = x, y = y, stringsAsFactors = F)\n TitlePositioning <- rbind(temp, TitlePositioning)\n}\n\n## create the value labellings data \nvalues <- c(25,50,75)\nradian_for_values <- angle_spilt / 2\nx <- values * cos(radian_for_values)\ny <- values * sin(radian_for_values)\nValuePositioning <- data.frame(values = values, x = x, y = y, stringsAsFactors = F)\n\n## Add the origin values for the lines \nLineData$x2 <- 0\nLineData$y2 <- 0\n\n# empty dataframe to catch result \npolydata <- data.frame(player = character, value = numeric, \n radians = numeric, \n x = numeric, y = numeric, stringsAsFactors = F)\n\n## create polygon data for the players \nfor (i in 1:NCOL(data)) {\n \n for (p in 1:NROW(data)) {\n \n player2calc <- data[p,]\n angle_multiplier <- if(i < NCOL(data)){i}else{1}\n radians_for_segment <- angle_spilt_seq[i]\n x <- player2calc[i] * cos(radians_for_segment)\n y <- player2calc[i] * sin(radians_for_segment)\n player <- rownames(data)[p]\n temp <- data.frame(player = player, value = player2calc[i], \n radians = radians_for_segment, x = x, y = y, \n stringsAsFactors = F)\n polydata <- rbind(temp, polydata)\n }\n}\n\n\n#e data up into player 1 and 2\nplayersDB <- unique(polydata$player)\nplayer1 <- polydata[which(polydata$player == playersDB[1]),]\nplayer2 <- polydata[which(polydata$player == playersDB[2]),]\n\n## create the title string for player 1\nPlayer1_title <- gsub('([[:upper:]])', ' \\\\1', playersDB[1])\nPlayer1_title <- trimws(Player1_title)\n\n## Create Title Strings for Player 2\nPlayer2_title <- gsub('([[:upper:]])', ' \\\\1', playersDB[2])\nPlayer2_title <- trimws(Player2_title)\n\nrequire(ggplot2)\n\n\n## Add the radar background\nggplot() + xlim(c(-120, 120)) + ylim(c(-120, 150)) + \n## Add circles\ngeom_polygon(data = circle1, aes(x=x,y=y),fill = \"#F0F0F0\", colour = \"#969696\") + geom_polygon(data = circle2, aes(x=x,y=y),fill = \"#FFFFFF\", colour = \"#d9d9d9\") + geom_polygon(data = circle3, aes(x=x,y=y),fill = \"#F0F0F0\", colour = \"#d9d9d9\") + geom_polygon(data = circle4, aes(x=x,y=y),fill = \"#FFFFFF\", colour = \"#d9d9d9\") +\n## Change the theme to void \ntheme_void() +\n## Add the segment lines and attribute/value titles \ngeom_segment(data=LineData, aes(x = LineData$x, y = LineData$y, xend = LineData$x2, yend = LineData$y2),colour = \"#d9d9d9\", linetype = \"dashed\") + \nannotate(\"text\", x = TitlePositioning$x , y = TitlePositioning$y, label = TitlePositioning$title, size= 2.5) + \nannotate(\"text\", x = ValuePositioning$x , y = ValuePositioning$y, label = ValuePositioning$values, size= 2.5, colour = \"#969696\") +\n## Add player 1 data \ngeom_polygon(data = player1, aes(x=x,y=y),fill = \"#A30845\", colour = \"#A30845\", alpha = 0.3) + geom_point(data = player1, aes(x = x, y = y),size=0.3, colour= \"#A30845\") + \n## Add Chart Title\nannotate(\"text\", x = -110 , y = 130, label = Player1_title, size= 5, colour = \"#A30845\", family = \"Helvetica\", fontface = \"bold\", hjust = 0) + \nannotate(\"text\", x = 110 , y = 130, label = \"FIFA 18 Data\", size= 4, colour = \"#969696\", family = \"Helvetica\", fontface = \"bold\", hjust = 1) +\n## Add the player 2 polygon and data points\ngeom_polygon(data = player2, aes(x=x,y=y),fill = \"#00B20B\", colour = \"#00B20B\", alpha = 0.3) +\ngeom_point(data = player2, aes(x = x, y = y),size=0.3, colour= \"#00B20B\") +\n## Add the titles for player 2\nannotate(\"text\", x = -110 , y = 116, label = Player2_title, size= 5, colour = \"#00B20B\", family = \"Helvetica\", fontface = \"bold\", hjust = 0) + \nannotate(\"text\", x = -110 , y = 123 , label = \"vrs\", size= 3, colour = \"#969696\", family = \"Helvetica\", hjust = 0)\n```\n\n\n\n\n\n### Brazil's Number 9\n\n```{r}\ncomparison_data %>% \n filter(player_name %in% c(\"Roberto Firmino\", \"Gabriel Jesus\")) %>% \n mutate(value = value / time * 90)\n \n```\n\n\n\n```{r, fig.height = 5, fig.width = 8, warning=FALSE, message=FALSE}\ncolores <- c(\"Roberto Firmino\" = \"red\",\n \"Gabriel Jesus\" = \"lightblue\")\n\ncomparison_data %>%\n filter(key != \"shots\" | key != \"key_passes\") %>% \n filter(player_name %in% c(\"Roberto Firmino\", \"Gabriel Jesus\")) %>% \n #mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, show.legend = FALSE, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.05, 0.05)) +\n scale_fill_manual(values = colores, name = \"Player\") +\n labs(title = \"Comparison: Brazil's Number 9s\",\n x = NULL, y = \"Metric\") +\n theme_copaAmerica(title.size = 14,\n panel.grid.minor.x = element_line(color = \"white\")) -> comparison_value\n\ncomparison_data %>%\n filter(key != \"shots\" | key != \"key_passes\") %>% \n filter(player_name %in% c(\"Roberto Firmino\", \"Gabriel Jesus\")) %>% \n mutate(value = value / time * 90) %>% \n ggplot(aes(x = key, y = value, fill = player_name)) +\n geom_jitter(shape = 21, size = 5, color = \"black\", width = 0.25, show.legend = FALSE, stroke = 1.1) +\n coord_flip() +\n scale_y_continuous(expand = c(0.05, 0.05)) +\n scale_fill_manual(values = colores, name = \"Player\") +\n labs(title = \"Comparison: Brazil's Number 9s\",\n x = NULL, y = \"Metric per 90\",\n caption = glue::glue(\"data: understat.com\")) +\n theme_copaAmerica(title.size = 14,\n panel.grid.minor.x = element_line(color = \"white\")) -> comparison_per90\n\nplot_grid(comparison_value, comparison_per90, ncol = 2)\n```\n\n```{r, eval=FALSE, echo=FALSE}\nggsave(plot = player_contrib_club_plot, filename = here::here(\"Copa America 2019/output/player_contrib_club_plot.png\"),\n height = 6, width = 8)\n```\n\n\n"
},
{
"path": "Eredivisie 2018-2019/player_goal_contribution_matrix.rmd",
"content": "---\ntitle: \"Untitled\"\nauthor: \"RN7\"\ndate: \"5/25/2019\"\noutput: html_document\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\n\n# pkgs\n\n```{r, message=FALSE, warning=FALSE}\npacman::p_load(tidyverse, polite, scales, ggimage, ggforce,\n rvest, glue, extrafont, ggrepel, magick)\nloadfonts()\n```\n\n## add_logo\n\n```{r}\nadd_logo <- function(plot_path, logo_path, logo_position, logo_scale = 10){\n\n # Requires magick R Package https://github.com/ropensci/magick\n\n # Useful error message for logo position\n if (!logo_position %in% c(\"top right\", \"top left\", \"bottom right\", \"bottom left\")) {\n stop(\"Error Message: Uh oh! Logo Position not recognized\\n Try: logo_positon = 'top left', 'top right', 'bottom left', or 'bottom right'\")\n }\n\n # read in raw images\n plot <- magick::image_read(plot_path)\n logo_raw <- magick::image_read(logo_path)\n\n # get dimensions of plot for scaling\n plot_height <- magick::image_info(plot)$height\n plot_width <- magick::image_info(plot)$width\n\n # default scale to 1/10th width of plot\n # Can change with logo_scale\n logo <- magick::image_scale(logo_raw, as.character(plot_width/logo_scale))\n\n # Get width of logo\n logo_width <- magick::image_info(logo)$width\n logo_height <- magick::image_info(logo)$height\n\n # Set position of logo\n # Position starts at 0,0 at top left\n # Using 0.01 for 1% - aesthetic padding\n\n if (logo_position == \"top right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"top left\") {\n x_pos = 0.01 * plot_width\n y_pos = 0.01 * plot_height\n } else if (logo_position == \"bottom right\") {\n x_pos = plot_width - logo_width - 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n } else if (logo_position == \"bottom left\") {\n x_pos = 0.01 * plot_width\n y_pos = plot_height - logo_height - 0.01 * plot_height\n }\n\n # Compose the actual overlay\n magick::image_composite(plot, logo, offset = paste0(\"+\", x_pos, \"+\", y_pos))\n}\n```\n\n# Eredivisie\n\nhttps://us.soccerway.com/national/france/ligue-1/20182019/regular-season/r48044/\n\n\n## webscrape soccerway\n\n```{r}\nurl <- \"https://us.soccerway.com/national/netherlands/eredivisie/20182019/regular-season/r47971/\"\n\nsession <- bow(url)\n\nteam_links <- scrape(session) %>% \n html_nodes(\"#page_competition_1_block_competition_tables_7_block_competition_league_table_1_table .large-link a\") %>% \n html_attr(\"href\")\n\nteam_links_df <- team_links %>% \n enframe(name = NULL) %>% \n separate(value, c(NA, NA, NA, \"team_name\", \"team_num\"), sep = \"/\") %>% \n mutate(link = glue(\"\n https://us.soccerway.com/teams/netherlands/{team_name}/{team_num}/squad/\"),\n stat_link = glue(\"{link %>% str_replace('squad', 'statistics')}\"))\n\n# for each team link:\n\nplayer_name_info <- function(session) {\n \n player_name_info <- scrape(session) %>% \n html_nodes(\"#page_team_1_block_team_squad_3-table .name.large-link\") %>% \n html_text()\n}\n\nnum_goals_info <- function(session) {\n\n num_goals_info <- scrape(session) %>% \n html_nodes(\".goals\") %>% \n html_text()\n \n num_goals_info_clean <- num_goals_info[-1]\n}\n\nnum_assists_info <- function(session) {\n\n num_assists_info <- scrape(session) %>% \n html_nodes(\".assists\") %>% \n html_text()\n \n num_assists_info_clean <- num_assists_info[-1]\n}\n\nteam_goals_info <- function(session) {\n team_goals_info <- scrape(session) %>% \n html_nodes(\"tr.first:nth-child(6) > td:nth-child(2)\") %>% \n html_text()\n}\n\n# BIG FUNCTION\neredivisie_stats_info <- function(link, statlink) {\n \n session <- bow(link)\n session2 <- bow(statlink)\n \n player_name <- player_name_info(session = session)\n\n num_goals <- num_goals_info(session = session)\n\n num_assists <- num_assists_info(session = session)\n \n team_goals <- team_goals_info(session = session2)\n \n resultados <- list(player_name, num_goals, num_assists, team_goals)\n col_names <- c(\"name\", \"goals\", \"assists\", \"team_goals\") \n \n eredivisie_stats <- resultados %>% \n reduce(cbind) %>% \n as_tibble() %>% \n set_names(col_names) \n}\n```\n\n### all at once\n\n```{r}\n# ALL 18 TEAMS AT ONCE, WILL TAKE A WHILE:\neredivisie_goal_contribution_df_ALL <- map2(.x = team_links_df$link,\n .y = team_links_df$stat_link,\n ~ eredivisie_stats_info(link = .x, statlink = .y))\n\neredivisie_goal_contribution_df <- eredivisie_goal_contribution_df_ALL %>% \n set_names(team_links_df$team_name) %>% \n bind_rows(.id = \"team_name\")\n\n## save\nsaveRDS(eredivisie_goal_contribution_df, file = glue(\"{here::here()}/data/eredivisie_goal_contrib_df_soccerway.RDS\"))\n```\n\n## clean\n\n```{r}\neredivisie_goal_contribution_clean_df <- eredivisie_goal_contribution_df %>% \n mutate_at(.vars = c(\"goals\", \"assists\"), \n ~str_replace(., \"-\", \"0\") %>% as.numeric) %>% \n mutate(team = team_name %>% str_replace_all(., \"-\", \" \") %>% str_to_title,\n total_goals = as.numeric(team_goals)) %>% \n group_by(team) %>% \n mutate(total_assists = sum(assists),\n goal_contrib = goals/total_goals,\n assist_contrib = assists/total_goals) %>% \n ungroup() %>% \n select(-team_name, -team_goals)\n\n## save\nsaveRDS(eredivisie_goal_contribution_clean_df, \n file = glue(\"{here::here()}/data/eredivisie_goal_contrib_clean_df.RDS\"))\neredivisie_goal_contribution_clean_df <- readRDS(file = glue(\"{here::here()}/data/eredivisie_goal_contrib_clean_df.RDS\"))\n```\n\n## plot\n\n- \n-\n-\n\n```{r fig.width = 10, fig.height = 8} \n## Description text\n## Iago Aspas\ndesc_aspas <- \"With 20 Goals from 12.47 xG, Iago Aspas greatly exceeded his xG as he heroically saved Celta Vigo from relegation yet again!\"\n\n## Jony xA90 of 0.29 (tied 3rd highest, minimum 30 games)\ndesc_jony <- \"With 10 assists amounting to 34% of Alavés' xA, Jony had his career-best season as he helped Alavés contend for a European place.\"\n\n## Messi\ndesc_goat <- \"With total contribution nearly double of the next best, 36 Goals from a xG of 26, etc. Messi led almost every metric in La Liga this season!\"\n\n## PLOT!\neredivisie_goal_contribution_clean_df %>% \n ggplot(aes(assist_contrib, goal_contrib)) +\n geom_point(data = eredivisie_goal_contribution_clean_df %>%\n filter(goal_contrib < 0.2 | assist_contrib < 0.125),\n color = \"grey20\", size = 4, alpha = 0.2) +\n geom_point(data = eredivisie_goal_contribution_clean_df %>%\n filter(goal_contrib > 0.2 | assist_contrib > 0.125),\n color = \"red\", size = 4) +\n geom_hline(yintercept = 0.2, color = \"grey20\", alpha = 0.4) +\n geom_vline(xintercept = 0.125, color = \"grey20\", alpha = 0.4) +\n geom_text_repel(data = eredivisie_goal_contribution_clean_df %>%\n filter(goal_contrib > 0.2 | assist_contrib > 0.125,\n !name %in% c(\"Iago Aspas\", \"L. Messi\", \n \"Jony\", \"Pablo Sarabia\")),\n aes(label = name, family = \"Roboto Condensed\", fontface = \"bold\"), \n seed = 15, size = 4, \n min.segment.length = 0, segment.color = \"red\",\n point.padding = 0.5) +\n # geom_mark_circle(aes(filter = name == \"L. Messi\", \n # label = \"Lionel Messi: GOAT\",\n # description = desc_goat),\n # label.family = \"Roboto Condensed\", label.fontsize = c(16, 12)) +\n # geom_mark_circle(aes(filter = name == \"Iago Aspas\", \n # label = \"Iago Aspas: The Hero of Vigo\",\n # description = desc_aspas),\n # label.buffer = unit(10, \"mm\"), label.fontsize = c(16, 12),\n # label.family = \"Roboto Condensed\") +\n # geom_mark_circle(aes(filter = name == \"Jony\", \n # label = \"Jony: El Glorioso\", \n # description = desc_jony),\n # label.buffer = unit(5, \"mm\"), label.fontsize = c(16, 12),\n # label.family = \"Roboto Condensed\") +\n scale_x_continuous(labels = percent_format(accuracy = 1),\n breaks = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3),\n limits = c(0, 0.3)) +\n scale_y_continuous(labels = percent_format(accuracy = 1),\n breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5),\n limits = c(0, 0.5)) +\n labs(title = \"Goal Contribution Matrix: Eredivisie (2018-2019 Season)\",\n subtitle = \"Goal Involvement (Goals and/or Assists) as Percentage of Total Club Goals\",\n caption = glue(\"\n Data: soccerway.com & understat.com\n By: @R_by_Ryo\"),\n x = \"Percentage of Club Goals Assisted\",\n y = \"Percentage of Club Goals Scored\") +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n title = element_text(size = 20),\n plot.subtitle = element_text(size = 16),\n plot.caption = element_text(size = 10),\n axis.title = element_text(size = 14),\n axis.text = element_text(size = 12),\n panel.grid.minor.x = element_blank()) -> eredivisie_goal_contribution_matrix\n\neredivisie_goal_contribution_matrix\n```\n\n## save\n\n```{r}\nggsave(plot = eredivisie_goal_contribution_matrix, \n \"../Eredivisie 2018-2019/output/goal_contribution_matrix_plot_eredivisie.png\",\n height = 9, width = 11)\n```\n\n```{r}\nplot_logo <- add_logo(\n plot_path = \"../Eredivisie 2018-2019/output/goal_contribution_matrix_plot_eredivisie.png\",\n logo_path = \"https://upload.wikimedia.org/wikipedia/commons/0/0f/Eredivisie_nieuw_logo_2017-.svg\",\n logo_position = \"top right\",\n logo_scale = 10)\n\nplot_logo\n```\n\n```{r}\nimage_write(image = plot_logo, \n \"../Eredivisie 2018-2019/output/goal_contribution_matrix_plot_logo_eredivisie.png\")\n```\n"
},
{
"path": "Europe 2021-2022/fbref_sca_waffle_blogpost.Rmd",
"content": "---\ntitle: \"Solution to the 'preserving the sum after rounding' problem in a soccer waffle viz!\"\nalways_allow_html: yes\noutput: \n md_document:\n variant: markdown_github\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n\nI recently came across a cool waffle viz for the top 20 shot-creating action players in the big 5 European soccer leagues done by [Harsh Krishna](https://twitter.com/placehoIder2004) on Twitter, see [original Tweet here](https://twitter.com/placehoIder2004/status/1480136784021393409). He also posted the code [in this Github gist](https://github.com/harshkrishna17/R-Code/blob/main/Waffle.R) with a call for help in solving an issue he was having with the preserving the sum of a group of metrics after rounding the individual metrics to integers. __Below is the code he posted in full.__ The problem in particular is after the second `for` loop where he rounds the metrics, he finds that the sum of the metrics don't add up to 100(%). His way of resolving this was choosing the `Sh_SCA` variable and trying to manipulate the values in that metric until the total summed back up to 100.\n\n```{r eval=FALSE}\n# Harsh Krishna `@placeholder2004`\n# https://github.com/harshkrishna17/R-Code/blob/main/Waffle.R\n# Libraries\n\nlibrary(tidyverse)\nlibrary(worldfootballR)\nlibrary(ggtext)\nlibrary(extrafont)\nlibrary(waffle)\nlibrary(MetBrewer)\n\n# Scraping\n\ndata <- fb_big5_advanced_season_stats(season_end_year = 2022, stat_type = \"gca\", team_or_player = \"player\")\n\n# Data Wrangling \n\ndata1 <- data %>%\n filter(Mins_Per_90 >= 9) %>%\n select(Player, Mins_Per_90, SCA90_SCA, SCA_SCA, PassLive_SCA, PassDead_SCA, Drib_SCA, Sh_SCA, Fld_SCA, Def_SCA)\n\ndata1 <- data1[order(as.numeric(data1$SCA90_SCA),decreasing = TRUE),]\ndata1 <- data1[c(1:20),]\n\ndf <- data1[order(as.numeric(data1$SCA90_SCA),decreasing = TRUE),]\ndf <- df[c(1:20),]\n\nPlayer <- data1$Player\nMins <- data1$Mins_Per_90\ndata1 <- subset(data1, select = -c(Player, Mins_Per_90, SCA90_SCA))\n\nfor(i in 1:ncol(data1)) {\n data1[, i] <- data1[, i] / Mins\n}\n\nSCA <- data1$SCA_SCA \n\nfor(i in 1:ncol(data1)) {\n data1[, i] <- round((data1[, i] / SCA) * 100, 0)\n}\n\ndata1 <- data1 %>%\n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA)\n\n## run this ifelse statement as many times as necessary until the Total comes out to be a 100 for all rows.\ndata1 <- data1 %>% mutate(Sh_SCA = ifelse(Total == 100, Sh_SCA,\n ifelse(Total < 100, Sh_SCA + 1,\n ifelse(Total > 100, Sh_SCA - 1, NA)))) %>% \n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA)\n\ndata1$Player <- Player \n\ndata1 <- data1 %>%\n pivot_longer(!Player, values_to = \"SCAp90\", names_to = \"SCATypes\") %>%\n filter(!SCATypes == \"SCA_SCA\") %>%\n filter(!SCATypes == \"Total\") %>%\n count(Player, SCATypes, wt = SCAp90)\n\ndata1$Player <- factor(data1$Player, levels = print(df$Player))\n\n# Custom theme function\n\ntheme_athletic <- function() {\n theme_minimal() +\n theme(plot.background = element_rect(colour = \"#151515\", fill = \"#151515\"),\n panel.background = element_rect(colour = \"#151515\", fill = \"#151515\")) +\n theme(plot.title = element_text(colour = \"white\", size = 24, family = \"Fried Chicken Bold\", hjust = 0.5),\n plot.subtitle = element_markdown(colour = \"#525252\", size = 18, hjust = 0.5),\n plot.caption = element_text(colour = \"white\", size = 15, hjust = 1),\n axis.title.x = element_text(colour = \"white\", face = \"bold\", size = 14),\n axis.title.y = element_text(colour = \"white\", face = \"bold\", size = 14),\n axis.text.x = element_blank(),\n axis.text.y = element_blank()) +\n theme(panel.grid.major = element_blank(),\n panel.grid.minor = element_blank(),\n panel.background = element_blank()) +\n theme(legend.title = element_text(colour = \"white\"),\n legend.text = element_text(colour = \"white\"))\n}\n\n# Plotting\n\ndata1 %>%\n ggplot(aes(fill = SCATypes, values = n)) +\n geom_waffle(nrows = 10, size = 1.5, colour = \"#151515\", flip = TRUE) +\n scale_fill_manual(values = met.brewer(name = \"Gauguin\", n = 6, type = \"discrete\")) +\n facet_wrap(~Player) +\n labs(title = \"Big 5 Leagues Shot-Creating Actions Share [2021/22]\",\n subtitle = \"Top 20 Players with the most SCA per 90 so far\",\n caption = \"Minimum 9 90's Played\\nData from FBref\\nCreated by @placeholder2004\") +\n theme_athletic() +\n theme(aspect.ratio = 1,\n strip.background = element_blank(),\n strip.text = element_text(colour = \"white\", size = 14),\n legend.position = \"bottom\",\n legend.text = element_text(size = 14))\n\n# Save\n\nsetwd(\"C:/Users/harsh_1mwi2o4/Downloads\")\nggsave(\"wafflebig5.png\", width = 3100, height = 3500, units = \"px\")\n```\n\nThis is a problem I've faced in the past and I'm sure many others have too, whether in the context of soccer analysis or otherwise. So I decided to tackle this problem as a fun coding challenge using the __tidyverse__!\n\nLet's get started!\n\n# Packages \n\nI prefer typing out the specific tidyverse packages rather than loading everything in at once.\n\n```{r message=FALSE}\nlibrary(dplyr)\nlibrary(tidyr)\nlibrary(worldfootballR)\nlibrary(ggtext)\nlibrary(extrafont)\nlibrary(waffle)\nlibrary(MetBrewer)\n```\n\n# Scrape data\n\nGet data from FBref/StatsBomb with the {worldfootballR} package.\n\n```{r eval=FALSE}\n# Scraping\ndata_raw <- fb_big5_advanced_season_stats(season_end_year = 2022, stat_type = \"gca\", team_or_player = \"player\")\n```\n\n```{r echo=FALSE}\n# saveRDS(data_raw, file = here::here(\"data/sca_big5_demo.RDS\"))\n# write.csv(data_raw, file = here::here(\"data/sca_big5_demo.csv\"))\ndata_raw <- read.csv(file = \"https://raw.githubusercontent.com/Ryo-N7/soccer_ggplots/master/data/sca_big5_demo.csv\")\n```\n\n```{r}\nglimpse(data_raw)\n```\n\nInstead of ordering and subsetting with base functions in the original, I used `arrange()` and `slice()` to grab the top 20 players by SCA per 90.\n\n```{r}\n# Data Wrangling \ndf1 <- data_raw %>%\n filter(Mins_Per_90 >= 9) %>%\n ## use contains() so I don't have to type out every `SCA` variable out\n select(Player, Mins_Per_90, contains(\"SCA\")) %>% \n ## arrange by SCA per 90 (descending) then take top 20 rows\n arrange(desc(SCA90_SCA)) %>%\n slice(1:20)\n\nglimpse(df1)\n```\n\nInstead of using a `for` loop to perform the calculations on each column, I used `mutate()` and then `across()` to specify the columns I wanted to run the same operation on, dividing the metrics by the number of minutes that each player played. Also since we are using `mutate()` we don't need to pull out the `Mins` variable anymore as we can just refer to that specific column in the data.frame.\n\n```{r}\ndf2 <- df1 %>% \n ## use across() to specify which vars to perform operations on\n ## ex. all cols EXCEPT `Player`, `Mins_Per_90`, and `SCA90_SCA`\n mutate(across(-c(Player, Mins_Per_90, SCA90_SCA), ~ . / Mins_Per_90)) \n\nglimpse(df2)\n```\n\nAgain, here instead of using a `for` loop I used the same `mutate() + across()` trick again to divide the values by each of the total SCA types and then multiply that by 100.\n\nWhat you get now is that all the per 90 stats are in terms of percentages of the total SCA. \n\n```{r}\ndf3 <- df2 %>% \n ## use across() to specify which vars to perform operations on\n ## ex. all cols EXCEPT `Player`, `Mins_Per_90`, and `SCA90_SCA`\n mutate(across(-c(Player, Mins_Per_90, SCA90_SCA), ~ (. / SCA_SCA) * 100 )) %>% \n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA) %>% \n select(Player, Mins_Per_90, Total, contains(\"SCA\"))\n\nglimpse(df3)\n```\n\nThen I check using `Total` column if the numbers sum to 100. They do, so we know that these per 90 numbers are good and everything adds up to 100% properly.\n\nFor the purpose of making a waffle chart, we have to turn all of these values into integers. However, the problem with this is that due to rounding the individual values, the sum doesn't equal 100 after the calculation! Some sums might equal to 99 or 98, some to 100, and some to 101!\n\n# Preserve sum after rounding function\n\nI looked around and tried out a **lot** of different things, not just different functions but also ways to re-shape the data so that the algorithm would work correctly. The first function I tried was the `largeRem()` function [here](https://github.com/basilesimon/largeRem/) but this only worked for when the sums would add up to -1 (99) or +1 (101) from 100. So I then started manually adding more branches to the if-else statements but since I knew there had to be something better out there I moved on. Eventually I found the function below, hoisted from the [{JLutils}](https://github.com/larmarange/JLutils/blob/master/R/round_preserve_sum.R) package that has a pretty good implementation of the **largest remainder** algorithm:\n\n```{r}\nround_preserve_sum <- function(x, digits = 0) {\n up <- 10^digits\n x <- x * up\n y <- floor(x)\n indices <- tail(order(x - y), round(sum(x)) - sum(y))\n y[indices] <- y[indices] + 1\n y / up\n}\n```\n\nI honestly wanted to show how to do **row-wise** operations using the tidyverse in this section because I got tired of having to pivot back and forth and back and forth. See [here](https://dplyr.tidyverse.org/articles/rowwise.html) for how row-wise operations work in the tidyverse. However, the custom function I used to preserve the sum wasn't created to support the tidyverse's row-wise method, so I ended up having to transpose the data and un-transpose it with the pivot functions anyway. At the end, we can check our work by creating a `Total` variable again to see that everything sums up to 100 even after rounding all the metrics into integers!\n\n```{r}\ndf4 <- df3 %>% \n select(-Mins_Per_90, -SCA90_SCA, -SCA_SCA, -Total) %>% \n ## transpose\n pivot_longer(cols = -Player) %>% \n pivot_wider(names_from = Player, values_from = value) %>% \n ## run function over player column\n mutate(across(-name, ~ round_preserve_sum(.))) %>% \n ## transpose back to original shape\n pivot_longer(names_to = \"Player\", values_to = \"thing\", cols = -name) %>% \n pivot_wider(names_from = name, values_from = thing) %>% \n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA)\n\nglimpse(df4)\n```\n\n![](\"../assets/2022-01-14-preserve-sum-rounding-soccer-viz_files/rex_experience_outranks_everything.gif\")
\n\nNow all that's left is to pivot the data based on the different Shot-Creating Action types so that the data is re-shaped into the format needed for the waffle plot. I also cleaned up the SCA types so that it reads nicer on the final plot using the `case_when()` function, which is like a Super Saiyan version of if-else statements. \n\n```{r}\ndf5 <- df4 %>%\n ## we don't need the `Total` column anymore...\n select(-Total) %>% \n ## Pivot so that we get the all the SCA types collapsed into a single column\n pivot_longer(!Player, values_to = \"SCAp90\", names_to = \"SCATypes\") %>%\n mutate(SCATypes = case_when(\n SCATypes == \"Def_SCA\" ~ \"Defensive Action SCA\",\n SCATypes == \"Drib_SCA\" ~ \"Dribble SCA\",\n SCATypes == \"Fld_SCA\" ~ \"Fouled SCA\",\n SCATypes == \"PassDead_SCA\" ~ \"Dead-ball Pass SCA\",\n SCATypes == \"PassLive_SCA\" ~ \"Pass SCA\",\n SCATypes == \"Sh_SCA\" ~ \"Shot SCA\",\n TRUE ~ SCATypes\n )) %>% \n count(Player, SCATypes, wt = SCAp90)\n\nglimpse(df5)\n```\n\n# 'The Athletic' Theme\n\nI do feel that the subtitle should pop out a bit more, but I want to preserve the original as much as possible so I won't change anything here...!\n\n```{r}\ntheme_athletic <- function() {\n theme_minimal() +\n theme(plot.background = element_rect(colour = \"#151515\", fill = \"#151515\"),\n panel.background = element_rect(colour = \"#151515\", fill = \"#151515\")) +\n theme(plot.title = element_text(colour = \"white\", size = 24, family = \"Fried Chicken Bold\", hjust = 0.5),\n plot.subtitle = element_markdown(colour = \"#525252\", size = 18, hjust = 0.5),\n plot.caption = element_text(colour = \"white\", size = 15, hjust = 1),\n axis.title.x = element_text(colour = \"white\", face = \"bold\", size = 14),\n axis.title.y = element_text(colour = \"white\", face = \"bold\", size = 14),\n axis.text.x = element_blank(),\n axis.text.y = element_blank()) +\n theme(panel.grid.major = element_blank(),\n panel.grid.minor = element_blank(),\n panel.background = element_blank()) +\n theme(legend.title = element_text(colour = \"white\"),\n legend.text = element_text(colour = \"white\"))\n}\n```\n\n# Plot\n\nNot much needs to be changed here again, I just cleaned the legend title a bit.\n\n**NOTE**: The players in the plot changed because, well, there's been plenty of football since the [original viz was posted](https://twitter.com/placehoIder2004/status/1480136784021393409)!\n\n```{r fig.width=31, fig.height=35}\nwafplot <- df5 %>%\n ggplot(aes(fill = SCATypes, values = n)) +\n geom_waffle(nrows = 10, size = 1.5, colour = \"#151515\", flip = TRUE) +\n scale_fill_manual(values = met.brewer(name = \"Gauguin\", n = 6, type = \"discrete\"),\n name = \"Shot-Creating Action Type\") +\n facet_wrap(~Player) +\n labs(title = \"Big 5 Leagues Shot-Creating Actions Share [2021/22]\",\n subtitle = \"Top 20 Players with the most SCA per 90 so far\",\n caption = \"Minimum 9 90's Played\\nData from FBref\\nCreated by @placeholder2004\") +\n theme_athletic() +\n theme(aspect.ratio = 1,\n strip.background = element_blank(),\n strip.text = element_text(colour = \"white\", size = 14),\n legend.position = \"bottom\",\n legend.text = element_text(size = 14))\nwafplot\n```\n\nI've just added the call to `here::here()`, a force of habit to keep file paths relative to the project root directory. Typing out the entire path is an annoyance so you can just do this to avoid it. Also helps when you move projects to a different computer or you're collaborating using somebody else's code, you don't have to re-type `C:/Users/blahblah/blahblah/...` all the time.\n\n```{r eval=FALSE}\nggsave(plot = wafplot, filename = here::here(\"Europe 2021-2022/output/big5_SCA_waffle_plot.png\"), \n width = 3100, height = 3500, units = \"px\")\n```\n\n...and done! \n\nSo this was a very short blog post on finding a solution to the \"preserve sum after rounding\" problem as well as re-writing some of the code to fit my coding style using the tidyverse. Just to be clear, aside from the main problem, none of the code in the original script was wrong! At the end of the day, it worked and a great viz was created, so there obviously was no problem at all. I hope the way I did it shows people there are different ways to approach a problem and that you learned about a couple of new functions and tricks along the way!\n\nI spent about 1~2 hours on this and most of it was googling for different solutions and finding documentation which goes to show how important being able to search for the right things on the internet is for programming in general. You're never going to be able to memorize everything you've ever done, so being good at googling is paramount. Being able to look up stuff efficiently is a skill that needs to be mastered, so things like taking on coding challenges I see in the wild (like the problem presented in this blog post) or taking part in community challenges like #TidyTuesday can help you gain valuable experience. \n\n\n\nOf course, there are also other ways to crystallize knowledge such as ... writing a blog post about an interesting problem!\n\nSpecial thanks to Harsh Krishna for sharing the code to his beautiful data viz. Hope this blog post was useful to everyone!\n\n\n \n"
},
{
"path": "Europe 2021-2022/fbref_sca_waffle_blogpost.md",
"content": "---\nlayout: post\ntitle: \"J.League Soccer 2021 Season Review!\"\ntags: [japan, jleague, soccer, football, ggplot2, tidyverse, r-bloggers]\n---\n\nI recently came across a cool waffle viz for the top 20 shot-creating\naction players in the big 5 European soccer leagues done by [Harsh\nKrishna](https://twitter.com/placehoIder2004) on Twitter, see [original\nTweet\nhere](https://twitter.com/placehoIder2004/status/1480136784021393409).\nHe also posted the code [in this Github\ngist](https://github.com/harshkrishna17/R-Code/blob/main/Waffle.R) with\na call for help in solving an issue he was having with the preserving\nthe sum of a group of metrics after rounding the individual metrics to\nintegers. **Below is the code he posted in full.** The problem in\nparticular is after the second `for` loop where he rounds the metrics,\nhe finds that the sum of the metrics don’t add up to 100(%). His way of\nresolving this was choosing the `Sh_SCA` variable and trying to\nmanipulate the values in that metric until the total summed back up to\n100.\n\n``` r\n# Harsh Krishna `@placeholder2004`\n# https://github.com/harshkrishna17/R-Code/blob/main/Waffle.R\n# Libraries\n\nlibrary(tidyverse)\nlibrary(worldfootballR)\nlibrary(ggtext)\nlibrary(extrafont)\nlibrary(waffle)\nlibrary(MetBrewer)\n\n# Scraping\n\ndata <- fb_big5_advanced_season_stats(season_end_year = 2022, stat_type = \"gca\", team_or_player = \"player\")\n\n# Data Wrangling \n\ndata1 <- data %>%\n filter(Mins_Per_90 >= 9) %>%\n select(Player, Mins_Per_90, SCA90_SCA, SCA_SCA, PassLive_SCA, PassDead_SCA, Drib_SCA, Sh_SCA, Fld_SCA, Def_SCA)\n\ndata1 <- data1[order(as.numeric(data1$SCA90_SCA),decreasing = TRUE),]\ndata1 <- data1[c(1:20),]\n\ndf <- data1[order(as.numeric(data1$SCA90_SCA),decreasing = TRUE),]\ndf <- df[c(1:20),]\n\nPlayer <- data1$Player\nMins <- data1$Mins_Per_90\ndata1 <- subset(data1, select = -c(Player, Mins_Per_90, SCA90_SCA))\n\nfor(i in 1:ncol(data1)) {\n data1[, i] <- data1[, i] / Mins\n}\n\nSCA <- data1$SCA_SCA \n\nfor(i in 1:ncol(data1)) {\n data1[, i] <- round((data1[, i] / SCA) * 100, 0)\n}\n\ndata1 <- data1 %>%\n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA)\n\n## run this ifelse statement as many times as necessary until the Total comes out to be a 100 for all rows.\ndata1 <- data1 %>% mutate(Sh_SCA = ifelse(Total == 100, Sh_SCA,\n ifelse(Total < 100, Sh_SCA + 1,\n ifelse(Total > 100, Sh_SCA - 1, NA)))) %>% \n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA)\n\ndata1$Player <- Player \n\ndata1 <- data1 %>%\n pivot_longer(!Player, values_to = \"SCAp90\", names_to = \"SCATypes\") %>%\n filter(!SCATypes == \"SCA_SCA\") %>%\n filter(!SCATypes == \"Total\") %>%\n count(Player, SCATypes, wt = SCAp90)\n\ndata1$Player <- factor(data1$Player, levels = print(df$Player))\n\n# Custom theme function\n\ntheme_athletic <- function() {\n theme_minimal() +\n theme(plot.background = element_rect(colour = \"#151515\", fill = \"#151515\"),\n panel.background = element_rect(colour = \"#151515\", fill = \"#151515\")) +\n theme(plot.title = element_text(colour = \"white\", size = 24, family = \"Fried Chicken Bold\", hjust = 0.5),\n plot.subtitle = element_markdown(colour = \"#525252\", size = 18, hjust = 0.5),\n plot.caption = element_text(colour = \"white\", size = 15, hjust = 1),\n axis.title.x = element_text(colour = \"white\", face = \"bold\", size = 14),\n axis.title.y = element_text(colour = \"white\", face = \"bold\", size = 14),\n axis.text.x = element_blank(),\n axis.text.y = element_blank()) +\n theme(panel.grid.major = element_blank(),\n panel.grid.minor = element_blank(),\n panel.background = element_blank()) +\n theme(legend.title = element_text(colour = \"white\"),\n legend.text = element_text(colour = \"white\"))\n}\n\n# Plotting\n\ndata1 %>%\n ggplot(aes(fill = SCATypes, values = n)) +\n geom_waffle(nrows = 10, size = 1.5, colour = \"#151515\", flip = TRUE) +\n scale_fill_manual(values = met.brewer(name = \"Gauguin\", n = 6, type = \"discrete\")) +\n facet_wrap(~Player) +\n labs(title = \"Big 5 Leagues Shot-Creating Actions Share [2021/22]\",\n subtitle = \"Top 20 Players with the most SCA per 90 so far\",\n caption = \"Minimum 9 90's Played\\nData from FBref\\nCreated by @placeholder2004\") +\n theme_athletic() +\n theme(aspect.ratio = 1,\n strip.background = element_blank(),\n strip.text = element_text(colour = \"white\", size = 14),\n legend.position = \"bottom\",\n legend.text = element_text(size = 14))\n\n# Save\n\nsetwd(\"C:/Users/harsh_1mwi2o4/Downloads\")\nggsave(\"wafflebig5.png\", width = 3100, height = 3500, units = \"px\")\n```\n\nThis is a problem I’ve faced in the past and I’m sure many others have\ntoo, whether in the context of soccer analysis or otherwise. So I\ndecided to tackle this problem as a fun coding challenge using the\n**tidyverse**!\n\nLet’s get started!\n\nPackages\n========\n\nI prefer typing out the specific tidyverse packages rather than loading\neverything in at once.\n\n``` r\nlibrary(dplyr)\nlibrary(tidyr)\nlibrary(worldfootballR)\nlibrary(ggtext)\nlibrary(extrafont)\nlibrary(waffle)\nlibrary(MetBrewer)\n```\n\nScrape data\n===========\n\nGet data from FBref/StatsBomb with the {worldfootballR} package.\n\n``` r\n# Scraping\ndata_raw <- fb_big5_advanced_season_stats(season_end_year = 2022, stat_type = \"gca\", team_or_player = \"player\")\n```\n\n``` r\nglimpse(data_raw)\n```\n\n ## Rows: 2,540\n ## Columns: 27\n ## $ X 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,~\n ## $ Season_End_Year 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, ~\n ## $ Squad \"Alavés\", \"Alavés\", \"Alavés\", \"Alavés\", \"Alavés\", \"Ala~\n ## $ Comp \"La Liga\", \"La Liga\", \"La Liga\", \"La Liga\", \"La Liga\",~\n ## $ Player \"Martin Agirregabiria\", \"Mircea Alexandru Tirlea\", \"Ru~\n ## $ Nation \"ESP\", \"ROU\", \"ESP\", \"ARG\", \"ESP\", \"ESP\", \"SWE\", \"ESP\"~\n ## $ Pos \"DF\", \"DF\", \"DF\", \"MF\", \"MF\", \"FW\", \"FW,MF\", \"MF\", \"FW~\n ## $ Age \"25-249\", \"21-292\", \"26-088\", \"28-293\", \"24-012\", \"27-~\n ## $ Born 1996, 2000, 1995, 1993, 1998, 1994, 1992, 1994, 1990, ~\n ## $ Mins_Per_90 13.6, 0.2, 16.4, 0.6, 7.6, 0.0, 3.0, 0.4, 18.5, 17.9, ~\n ## $ SCA_SCA 22, 0, 23, 0, 23, 0, 10, 1, 40, 3, 4, 5, 2, 12, 3, 11,~\n ## $ SCA90_SCA 1.62, 0.00, 1.40, 0.00, 3.02, 0.00, 3.28, 2.25, 2.16, ~\n ## $ PassLive_SCA 16, 0, 11, 0, 12, 0, 5, 1, 24, 0, 4, 3, 2, 10, 1, 6, 4~\n ## $ PassDead_SCA 2, 0, 9, 0, 8, 0, 0, 0, 1, 2, 0, 1, 0, 0, 0, 0, 18, 0,~\n ## $ Drib_SCA 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 2, 0, 1, 1, 0, ~\n ## $ Sh_SCA 0, 0, 0, 0, 1, 0, 0, 0, 6, 1, 0, 0, 0, 0, 2, 0, 1, 2, ~\n ## $ Fld_SCA 3, 0, 2, 0, 1, 0, 2, 0, 6, 0, 0, 0, 0, 0, 0, 3, 0, 1, ~\n ## $ Def_SCA 0, 0, 1, 0, 0, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 1, 1, 0, ~\n ## $ GCA_GCA 2, 0, 3, 0, 0, 0, 3, 0, 5, 1, 0, 1, 0, 0, 0, 3, 3, 0, ~\n ## $ GCA90_GCA 0.15, 0.00, 0.18, 0.00, 0.00, 0.00, 0.99, 0.00, 0.27, ~\n ## $ PassLive_GCA 1, 0, 0, 0, 0, 0, 1, 0, 2, 0, 0, 1, 0, 0, 0, 1, 1, 0, ~\n ## $ PassDead_GCA 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, ~\n ## $ Drib_GCA 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ~\n ## $ Sh_GCA 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, ~\n ## $ Fld_GCA 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, ~\n ## $ Def_GCA 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, ~\n ## $ Url \"https://fbref.com/en/players/355c883a/Martin-Agirrega~\n\nInstead of ordering and subsetting with base functions in the original,\nI used `arrange()` and `slice()` to grab the top 20 players by SCA per\n90.\n\n``` r\n# Data Wrangling \ndf1 <- data_raw %>%\n filter(Mins_Per_90 >= 9) %>%\n ## use contains() so I don't have to type out every `SCA` variable out\n select(Player, Mins_Per_90, contains(\"SCA\")) %>% \n ## arrange by SCA per 90 (descending) then take top 20 rows\n arrange(desc(SCA90_SCA)) %>%\n slice(1:20)\n\nglimpse(df1)\n```\n\n ## Rows: 20\n ## Columns: 10\n ## $ Player \"Dimitri Payet\", \"Lorenzo Pellegrini\", \"Hakan Çalhanoglu\"~\n ## $ Mins_Per_90 15.4, 13.8, 12.7, 9.2, 12.2, 9.2, 10.3, 9.6, 11.8, 17.3, ~\n ## $ SCA_SCA 115, 83, 76, 55, 72, 53, 59, 55, 66, 94, 66, 89, 56, 63, ~\n ## $ SCA90_SCA 7.48, 6.02, 5.97, 5.95, 5.88, 5.77, 5.75, 5.72, 5.59, 5.4~\n ## $ PassLive_SCA 71, 34, 41, 35, 40, 34, 44, 37, 52, 50, 45, 43, 43, 36, 3~\n ## $ PassDead_SCA 23, 26, 26, 10, 25, 5, 11, 4, 1, 28, 8, 25, 4, 15, 8, 2, ~\n ## $ Drib_SCA 7, 7, 1, 2, 2, 3, 1, 4, 3, 6, 4, 4, 5, 5, 5, 1, 13, 1, 1,~\n ## $ Sh_SCA 3, 10, 3, 4, 1, 4, 2, 5, 4, 1, 6, 4, 1, 4, 2, 3, 6, 3, 1,~\n ## $ Fld_SCA 11, 5, 3, 3, 2, 6, 1, 4, 6, 8, 2, 9, 2, 3, 8, 0, 7, 1, 1,~\n ## $ Def_SCA 0, 1, 2, 1, 2, 1, 0, 1, 0, 1, 1, 4, 1, 0, 3, 2, 2, 0, 2, 2\n\nInstead of using a `for` loop to perform the calculations on each\ncolumn, I used `mutate()` and then `across()` to specify the columns I\nwanted to run the same operation on, dividing the metrics by the number\nof minutes that each player played. Also since we are using `mutate()`\nwe don’t need to pull out the `Mins` variable anymore as we can just\nrefer to that specific column in the data.frame.\n\n``` r\ndf2 <- df1 %>% \n ## use across() to specify which vars to perform operations on\n ## ex. all cols EXCEPT `Player`, `Mins_Per_90`, and `SCA90_SCA`\n mutate(across(-c(Player, Mins_Per_90, SCA90_SCA), ~ . / Mins_Per_90)) \n\nglimpse(df2)\n```\n\n ## Rows: 20\n ## Columns: 10\n ## $ Player \"Dimitri Payet\", \"Lorenzo Pellegrini\", \"Hakan Çalhanoglu\"~\n ## $ Mins_Per_90 15.4, 13.8, 12.7, 9.2, 12.2, 9.2, 10.3, 9.6, 11.8, 17.3, ~\n ## $ SCA_SCA 7.467532, 6.014493, 5.984252, 5.978261, 5.901639, 5.76087~\n ## $ SCA90_SCA 7.48, 6.02, 5.97, 5.95, 5.88, 5.77, 5.75, 5.72, 5.59, 5.4~\n ## $ PassLive_SCA 4.610390, 2.463768, 3.228346, 3.804348, 3.278689, 3.69565~\n ## $ PassDead_SCA 1.49350649, 1.88405797, 2.04724409, 1.08695652, 2.0491803~\n ## $ Drib_SCA 0.45454545, 0.50724638, 0.07874016, 0.21739130, 0.1639344~\n ## $ Sh_SCA 0.19480519, 0.72463768, 0.23622047, 0.43478261, 0.0819672~\n ## $ Fld_SCA 0.71428571, 0.36231884, 0.23622047, 0.32608696, 0.1639344~\n ## $ Def_SCA 0.00000000, 0.07246377, 0.15748031, 0.10869565, 0.1639344~\n\nAgain, here instead of using a `for` loop I used the same\n`mutate() + across()` trick again to divide the values by each of the\ntotal SCA types and then multiply that by 100.\n\nWhat you get now is that all the per 90 stats are in terms of\npercentages of the total SCA type.\n\n``` r\ndf3 <- df2 %>% \n ## use across() to specify which vars to perform operations on\n ## ex. all cols EXCEPT `Player`, `Mins_Per_90`, and `SCA90_SCA`\n mutate(across(-c(Player, Mins_Per_90, SCA90_SCA), ~ (. / SCA_SCA) * 100 )) %>% \n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA) %>% \n select(Player, Mins_Per_90, Total, contains(\"SCA\"))\n\nglimpse(df3)\n```\n\n ## Rows: 20\n ## Columns: 11\n ## $ Player \"Dimitri Payet\", \"Lorenzo Pellegrini\", \"Hakan Çalhanoglu\"~\n ## $ Mins_Per_90 15.4, 13.8, 12.7, 9.2, 12.2, 9.2, 10.3, 9.6, 11.8, 17.3, ~\n ## $ Total 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 10~\n ## $ SCA_SCA 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 10~\n ## $ SCA90_SCA 7.48, 6.02, 5.97, 5.95, 5.88, 5.77, 5.75, 5.72, 5.59, 5.4~\n ## $ PassLive_SCA 61.73913, 40.96386, 53.94737, 63.63636, 55.55556, 64.1509~\n ## $ PassDead_SCA 20.000000, 31.325301, 34.210526, 18.181818, 34.722222, 9.~\n ## $ Drib_SCA 6.086957, 8.433735, 1.315789, 3.636364, 2.777778, 5.66037~\n ## $ Sh_SCA 2.608696, 12.048193, 3.947368, 7.272727, 1.388889, 7.5471~\n ## $ Fld_SCA 9.565217, 6.024096, 3.947368, 5.454545, 2.777778, 11.3207~\n ## $ Def_SCA 0.000000, 1.204819, 2.631579, 1.818182, 2.777778, 1.88679~\n\nThen I check using `Total` column if the numbers sum to 100. They do, so\nwe know that these per 90 numbers are good and everything adds up to\n100% properly.\n\nFor the purpose of making a waffle chart and the fact that you can’t\nreally “do” 0.43 of a “Shot Creating Action”, we have to turn all of\nthese values into integers. However, the problem with this is that due\nto rounding the individual values, the sum doesn’t equal 100 after the\ncalculation! Some sums might equal to 99 or 98, some to 100, and some to\n101!\n\nPreserve sum after rounding function\n====================================\n\nI looked around and tried out a **lot** of different things, not just\ndifferent functions but also ways to re-shape the data so that the\nalgorithm would work correctly. The first function I tried was the\n`largeRem()` function [here](https://github.com/basilesimon/largeRem/)\nbut this only worked for when the sums would add up to -1 (99) or +1\n(101) from 100. So I then started manually adding more branches to the\nif-else statements but since I knew there had to be something better out\nthere I moved on. Eventually I found the function below, hoisted from\nthe\n[{JLutils}](https://github.com/larmarange/JLutils/blob/master/R/round_preserve_sum.R)\npackage that has a pretty good implementation of the **largest\nremainder** algorithm:\n\n``` r\nround_preserve_sum <- function(x, digits = 0) {\n up <- 10^digits\n x <- x * up\n y <- floor(x)\n indices <- tail(order(x - y), round(sum(x)) - sum(y))\n y[indices] <- y[indices] + 1\n y / up\n}\n```\n\nI honestly wanted to show how to do **row-wise** operations using the\ntidyverse in this section because I got tired of having to pivot back\nand forth and back and forth. See\n[here](https://dplyr.tidyverse.org/articles/rowwise.html) for how\nrow-wise operations work in the tidyverse. However, the custom function\nI used to preserve the sum wasn’t created to support the tidyverse’s\nrow-wise method, so I ended up having to transpose the data and\nun-transpose it with the pivot functions anyway. At the end, we can\ncheck our work by creating a `Total` variable again to see that\neverything sums up to 100 even after rounding all the metrics into\nintegers!\n\n``` r\ndf4 <- df3 %>% \n select(-Mins_Per_90, -SCA90_SCA, -SCA_SCA, -Total) %>% \n ## transpose\n pivot_longer(cols = -Player) %>% \n pivot_wider(names_from = Player, values_from = value) %>% \n ## run function over player column\n mutate(across(-name, ~ round_preserve_sum(.))) %>% \n ## transpose back to original shape\n pivot_longer(names_to = \"Player\", values_to = \"thing\", cols = -name) %>% \n pivot_wider(names_from = name, values_from = thing) %>% \n mutate(Total = PassLive_SCA + PassDead_SCA + Drib_SCA + Sh_SCA + Fld_SCA + Def_SCA)\n\nglimpse(df4)\n```\n\n ## Rows: 20\n ## Columns: 8\n ## $ Player \"Dimitri Payet\", \"Lorenzo Pellegrini\", \"Hakan Çalhanoglu\"~\n ## $ PassLive_SCA 62, 41, 54, 64, 55, 64, 74, 67, 79, 53, 68, 48, 77, 57, 5~\n ## $ PassDead_SCA
![](\"visualize_asian_cup_2019_files/figure-markdown_github/unnamed-chunk-109-1.png\")
\n\n``` r\nggsave(filename = paste0(here::here(\"Asian Cup 2019\"), \"/gpg_plot.png\"), \n width = 8, height = 7, dpi = 300)\nplot <- image_read(paste0(here::here(\"Asian Cup 2019\"), \"/gpg_plot.png\"))\n```\n\nHowever, I’m not finished yet! I wanted to try to make this look a bit\nmore “official” so I attempted to add the Asian Cup logo on the top\nright corner. There are probably alternative ways to how I did it below,\nespecially by using grobs, but I was reminded of\n[this](https://www.danielphadley.com/ggplot-logo/) blog post by [Daniel\nHadley](https://twitter.com/danielphadley) who used the `magick` package\nto add a footer with a logo onto a `ggplot` object. I’ve used `magick`\nbefore for animations and this was a good chance to try it out for image\nediting. Compared to Daniel Hadley’s example I needed to have the logo\non the right corner so I had to find an alternative way of creating a\nblank canvas with `image_blank()` and then placing everything on top of\nthat with `image_composite()` and `image_append()`.\n\n``` r\nlogo_raw <- image_read(\"https://upload.wikimedia.org/wikipedia/en/a/ad/2019_afc_asian_cup_logo.png\")\n\nlogo_proc <- logo_raw %>% image_scale(\"600\")\n\n# create blank canvas\na <- image_blank(width = 1000, height = 100, color = \"white\")\n# combine with logo image and shift logo to the right\nb <- image_composite(image_scale(a, \"x100\"), image_scale(logo_proc, \"x75\"), \n offset = \"+880+25\")\n# add in the title text\nlogo_header <- b %>% \n image_annotate(text = glue(\"Goals per Game throughout the history of the Asian Cup\"),\n color = \"black\", size = 24, font = \"Roboto Condensed\",\n location = \"+63+50\", gravity = \"northwest\")\n\n# combine it all together! \nfinal2_plot <- image_append(image_scale(c(logo_header, plot), \"1000\"), stack = TRUE)\n\n# image_write(final2_plot,\n# glue(\"{here::here('Asian Cup 2019')}/gpg_plot_final.png\"))\n\nfinal2_plot\n```\n\n![](\"visualize_asian_cup_2019_files/figure-markdown_github/unnamed-chunk-110-1.png\")
\n\nAll in all it took a while to tweak the positions of the text and logo\nimage but for my first try it worked well. There is definitely room for\nimprovement in regards to sizing and scaling though.\n\nUltimately, I couldn’t find much information on why those tournaments in\nthe 80s in particular were such low scoring affairs. I wasn’t alive to\nwatch those games on TV nor could I find any illuminating articles or\nblog posts on the style of Asian football back in the 80s…This was also\nbefore Japan really got into soccer so there wasn’t anything I could\nfind in Japanese either.\n\nJapan’s record vs. Group D opponents and rivals\n-----------------------------------------------\n\nJapan is the most successful team in the competition with 4\nchampionships but who are their opponents in the group stages and how\nhave they fared against them? While I’m at it I will also check their\nrecords against long-time continental rivals such as Iran, South Korea,\nSaudi Arabia and more recently, Australia.\n\nThe data I’m going to use comes from\n[Kaggle](https://www.kaggle.com/martj42/international-football-results-from-1872-to-2017)\nwhich has all international football results from 1872 to the World Cup\nfinal last year. To add in the federation affiliation (UEFA, AFC, etc.)\nfor each of the countries I slightly modified some code from one of the\nkernels, [“A Journey Through The History of\nSoccer”](https://www.kaggle.com/phjulien/a-journey-through-the-history-of-soccer/)\nby PH Julien.\n\n``` r\nfederation_files <- Sys.glob(\"../data/federation_affiliations/*\")\n\ndf_federations = data.frame(country = NULL, federation = NULL)\nfor (f in federation_files) {\n federation = basename(f)\n content = read.csv(f, header=FALSE)\n content <- cbind(content,federation=rep(federation, dim(content)[1]))\n df_federations <- rbind(df_federations, content)\n}\n\ncolnames(df_federations) <- c(\"country\", \"federation\")\n\ndf_federations <- df_federations %>% \n mutate(country = as.character(country) %>% str_trim(side = \"both\"))\n```\n\nNow to load the results data and then join it with the affiliations\ndata.\n\n``` r\nresults_raw <- read_csv(\"../data/results.csv\")\n\nresults_japan_raw <- results_raw %>% \n filter(home_team == \"Japan\" | away_team == \"Japan\") %>% \n rename(venue_country = country, \n venue_city = city) %>% \n mutate(match_num = row_number())\n\n# combine with federation affiliations\nresults_japan_home <- results_japan_raw %>% \n left_join(df_federations, \n by = c(\"home_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(home_federation = federation) \n\nresults_japan_away <- results_japan_raw %>% \n left_join(df_federations, \n by = c(\"away_team\" = \"country\")) %>% \n mutate(federation = as.character(federation)) %>% \n rename(away_federation = federation)\n\n# combine home-away\nresults_japan_cleaned <- results_japan_home %>% \n full_join(results_japan_away)\n```\n\nNext I need to edit some of the continents for teams that didn’t have a\nmatch in the federation affiliation data set, for example, “South Korea”\nis “Korea Republic” in the Kaggle data set.\n\n``` r\nresults_japan_cleaned <- results_japan_cleaned %>% \n mutate(\n home_federation = case_when(\n home_team %in% c(\n \"China\", \"Manchukuo\", \"Burma\", \"Korea Republic\", \"Vietnam Republic\",\n \"Korea DPR\", \"Brunei\") ~ \"AFC\",\n home_team == \"USA\" ~ \"Concacaf\",\n home_team == \"Bosnia-Herzegovina\" ~ \"UEFA\",\n TRUE ~ home_federation),\n away_federation = case_when(\n away_team %in% c(\n \"China\", \"Manchukuo\", \"Burma\", \"Korea Republic\", \"Vietnam Republic\",\n \"Korea DPR\", \"Brunei\", \"Taiwan\") ~ \"AFC\",\n away_team == \"USA\" ~ \"Concacaf\",\n away_team == \"Bosnia-Herzegovina\" ~ \"UEFA\",\n TRUE ~ away_federation\n ))\n```\n\nNow that it’s nice and cleaned up I can reshape it so that the data is\nset from Japan’s perspective.\n\n``` r\nresults_jp_asia <- results_japan_cleaned %>% \n # filter only for Japan games and AFC opponents\n filter(home_team == \"Japan\" | away_team == \"Japan\",\n home_federation == \"AFC\" & away_federation == \"AFC\") %>% \n select(-contains(\"federation\"), -contains(\"venue\"),\n -neutral, -match_num,\n date, home_team, home_score, away_team, away_score, tournament) %>% \n # reshape columns to Japan vs. opponent\n mutate(\n opponent = case_when(\n away_team != \"Japan\" ~ away_team,\n home_team != \"Japan\" ~ home_team),\n home_away = case_when(\n home_team == \"Japan\" ~ \"home\",\n away_team == \"Japan\" ~ \"away\"),\n japan_goals = case_when(\n home_team == \"Japan\" ~ home_score,\n away_team == \"Japan\" ~ away_score),\n opp_goals = case_when(\n home_team != \"Japan\" ~ home_score,\n away_team != \"Japan\" ~ away_score)) %>% \n # label results from Japan's perspective\n mutate(\n result = case_when(\n japan_goals > opp_goals ~ \"Win\",\n japan_goals < opp_goals ~ \"Loss\",\n japan_goals == opp_goals ~ \"Draw\"),\n result = result %>% as_factor() %>% fct_relevel(c(\"Win\", \"Draw\", \"Loss\"))) %>% \n select(-contains(\"score\"), -contains(\"team\"))\n```\n\nWith all that done we can take a look at how Japan have done against\ncertain opponents by using `filter()`.\n\n``` r\nresults_jp_asia %>% \n filter(opponent == \"Jordan\",\n tournament == \"AFC Asian Cup\")\n```\n\n ## # A tibble: 3 x 7\n ## date tournament opponent home_away japan_goals opp_goals result\n ## ![](\"visualize_asian_cup_2019_files/figure-markdown_github/draw_image-1.png\")
\n\nIdeally I wanted the soccer balls to be the official balls from the\ntournament that the player scored in. However, I couldn’t find a nice\nemoji-fied/icon-ized version and there was also the “small” problem in\nthat there was no “official” Asian Cup ball until the 2004 tournament in\nChina! You can take a look at the official Asian Cup balls\n[here](http://football-balls.com/balls/asian-cup).\n\nWinners of the Asian Cup\n------------------------\n\nWe saw that the top goal scorers came from Iran, South Korea, Japan,\nIraq, and Kuwait but did their goal scoring exploits lead their nations\nto glory? Let’s find out!\n\nWhen web-scraping I really like using `flatten_df()` after\n`html_table()` as I don’t have to use the awkward looking `.[[1]]`\nwithin my piped workflow.\n\n``` r\nacup_url <- \"https://en.wikipedia.org/wiki/AFC_Asian_Cup\"\n\nsession <- bow(acup_url)\n\nacup_winners_raw <- scrape(session) %>% \n html_nodes(\"table:nth-child(31)\") %>% \n html_table() %>% \n flatten_df()\n```\n\nNow I can use the `clean_names()` function to quickly clean up my names\n(mainly when I can’t be bothered to `set_names()` them myself…).\n\nThe next steps are splitting up the number of times a team placed\nbetween 1st and 3rd and the year that occurred with `separate()`.\n\nThe variants of `mutate()` are then used to tidy the string columns of\nthe data into numeric type.\n\nI use `gather()` so each team will have a row for each of the rank\npositions (1st-3rd).\n\nFinally, I arrange the data in a way that the facets will be ordered in\nthe way that I want.\n\n``` r\nacup_winners_clean <- acup_winners_raw %>% \n janitor::clean_names() %>% \n slice(1:8) %>% \n select(-fourth_place, -semi_finalists, -total_top_four) %>% \n separate(winners, into = c(\"Champions\", \"first_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(runners_up, into = c(\"Runners-up\", \"second_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n separate(third_place, into = c(\"Third Place\", \"third_place_year\"), \n sep = \" \", extra = \"merge\") %>% \n mutate_all(funs(str_replace_all(., \"–\", \"0\"))) %>% \n mutate_at(vars(contains(\"num\")), funs(as.numeric)) %>% \n mutate(team = if_else(team == \"Israel1\", \"Israel\", team)) %>% \n gather(key = \"key\", value = \"value\", -team, \n -first_place_year, -second_place_year, -third_place_year) %>% \n mutate(key = key %>% \n fct_relevel(c(\"Champions\", \"Runners-up\", \"Third Place\"))) %>% \n arrange(key, value) %>% \n mutate(team = as_factor(team),\n order = row_number())\n```\n\nI plot using facets on the “key” variable (containing the rank data) so\nthat we can see how many times each team placed as Champions to Third\nPlace. I also use the `glue()` function here to format the multi-line\ncaptions and titles in a neat way.\n\n``` r\nacup_winners_clean %>% \n ggplot(aes(value, team, color = key)) +\n geom_point(size = 5) +\n scale_color_manual(values = c(\"Champions\" = \"#FFCC33\",\n \"Runners-up\" = \"#999999\",\n \"Third Place\" = \"#CC6600\"),\n guide = FALSE) +\n labs(x = \"Number of Occurrence\",\n title = \"Winners & Losers of the Asian Cup!\",\n subtitle = glue(\"\n Ordered by number of Asian Cup(s) won.\n Four-time Champions, Japan, only won their first in 1992!\"),\n caption = glue(\"\n Note: Israel was expelled by the AFC in 1974 while Australia joined the AFC in 2006.\n Source: Wikipedia\n By @R_by_Ryo\")) +\n facet_wrap(~key) +\n theme_minimal() +\n theme(text = element_text(family = \"Roboto Condensed\"),\n title = element_text(size = 18),\n plot.subtitle = element_text(size = 12),\n axis.title.y = element_blank(),\n axis.title.x = element_text(size = 12),\n axis.text.y = element_text(size = 14),\n axis.text.x = element_text(size = 12),\n plot.caption = element_text(hjust = 0, size = 10),\n panel.border = element_rect(fill = NA, colour = \"grey20\"),\n panel.grid.minor.x = element_blank(),\n strip.text = element_text(size = 16)) \n```\n\n![](\"visualize_asian_cup_2019_files/figure-markdown_github/unnamed-chunk-108-1.png\")
\n\nGoals per Game\n--------------\n\nOne new thing I learned very recently, while working on this viz in\nfact, was using magrittr aliases!\n\n\n\nUsually for web scraping I always wind up having to use `.[x]` or\n`.[[x]]` but now I can just use `extract()` or `extract2()` respectively\nto do the same thing!\n\n``` r\nwiki_url <- \"https://en.wikipedia.org\"\nsession <- bow(wiki_url)\nacup_url <- \"https://en.wikipedia.org/wiki/AFC_Asian_Cup\"\nsession_cup <- bow(acup_url)\n\ncup_links <- scrape(session_cup) %>% \n html_nodes(\"br+ i a\") %>% \n html_attr(\"href\") %>% \n magrittr::extract(-17:-18)\n\nacup_df <- cup_links %>% \n as_data_frame() %>% \n mutate(cup = str_remove(value, \"\\\\/wiki\\\\/\") %>% str_replace_all(\"_\", \" \")) %>% \n rename(link = value)\n```\n\nAnother cool thing I found while scraping this data was the `jump_to()`\nfunction that allows you to navigate to a new URL. This makes\n`map()`-ing over multiple URL links from a base URL very easy! Here, the\nbase URL is the AFC Asian Cup Wikipedia page and the function iterates\nover each of the links to the URL of the respective tournament pages.\nAnother way that I could’ve done this was to `map()` over the different\ndates of the tournaments as the Wikipedia page of each edition of the\nAsian Cup only differed in the “year” appended at the beginning of the\nURL.\n\n``` r\ngoals_info <- function(x) {\n goal_info <- session %>% \n jump_to(x) %>% \n html_nodes(\".vcalendar\") %>% \n html_table(header = FALSE) %>% \n flatten_df() %>% \n spread(key = X1, value = X2) %>% \n select(`Goals scored`) %>% \n mutate(`Goals scored` = str_remove_all(`Goals scored`, pattern = \".*\\\\(\") %>% \n str_extract_all(\"\\\\d+\\\\.*\\\\d*\") %>% as.numeric)\n}\n\nteam_num_info <- function(x) {\n team_num_info <- session %>% \n jump_to(x) %>% \n html_nodes(\".vcalendar\") %>% \n html_table(header = FALSE) %>% \n flatten_df() %>% \n spread(key = X1, value = X2) %>% \n select(`Teams`) %>% \n mutate(`Teams` = as.numeric(`Teams`))\n}\n\nmatch_num_info <- function(x) {\n match_num_info <- session %>% \n jump_to(x) %>% \n html_nodes(\".vcalendar\") %>% \n html_table(header = FALSE) %>% \n flatten_df() %>% \n spread(key = X1, value = X2) %>% \n janitor::clean_names() %>% \n select(matches_played) %>% \n mutate(matches_played = as.numeric(matches_played))\n}\n\n# all together:\ngoals_data <- acup_df %>% \n mutate(goals_per_game = map(acup_df$link, goals_info) %>% unlist,\n team_num = map(acup_df$link, team_num_info) %>% unlist,\n match_num = map(acup_df$link, match_num_info) %>% unlist)\n```\n\nNext, clean it up a bit and add in the number of teams that participated\nin each tournament.\n\n``` r\nac_goals_df <- goals_data %>% \n mutate(label = cup %>% str_extract(\"[0-9]+\") %>% str_replace(\"..\", \"'\"),\n team_num = case_when(\n is.na(team_num) ~ 16,\n TRUE ~ team_num\n )) %>% \n arrange(cup) %>% \n mutate(label = factor(label, label),\n team_num = c(4, 4, 4, 5, 6, 6, 10, 10, 10, 8, 12, 12, 16, 16, 16, 16))\n\nglimpse(ac_goals_df)\n```\n\n ## Observations: 16\n ## Variables: 6\n ## $ link