Skip to content

Instantly share code, notes, and snippets.

@mschnetzer
Last active May 4, 2023 21:51
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mschnetzer/1e36a599abb7e91a7ac82769d675645a to your computer and use it in GitHub Desktop.
Save mschnetzer/1e36a599abb7e91a7ac82769d675645a to your computer and use it in GitHub Desktop.
library(tidyverse)
library(rvest)
library(cropcircles)
library(magick)
library(gt)
library(gtExtras)
data <- read_html("https://sport.orf.at/stories/3111293/") |>
html_elements("section") |>
html_table() |>
first()
cleandat <- data |>
drop_na() |>
rename(Rang = X1, Name = X2, Sportart = X3, Einkommen = X4) |>
separate_wider_regex(cols = Name, patterns = c(Name = ".*", " \\(", Land = ".*", "\\)")) |>
separate_wider_regex(cols = Einkommen, patterns = c(Einkommen = ".*", " \\(", Sport = ".*", "/", Sponsoring = ".*", "\\).*")) |>
mutate(across(c(Einkommen, Sport, Sponsoring), ~as.numeric(str_replace_all(., ",", "."))))
images <- c("https://www.laola1.at/images/redaktion/images/Fussball/International/WM-2022/Ronaldo-Portugal-Jubel_c4b2d_f_800x450.jpg.webp",
"https://fcb-abj-pre.s3.amazonaws.com/img/jugadors/MESSI.jpg",
"https://images.teamtalk.com/content/uploads/2022/12/08084556/Kylian-Mbappe-FRA.jpg",
"https://cdn.nba.com/manage/2023/04/lebron-driving.jpg",
"https://img.asmedia.epimg.net/resizer/5Vid2eUkHM19ZXFGDaBweHGwU1s=/1288x725/filters:focal(2202x467:2212x477)/cloudfront-eu-central-1.images.arcpublishing.com/diarioas/HGHELA2HT5APNGLJ7L5AM3SG6U.jpg",
"https://www.si.com/.image/c_limit%2Ccs_srgb%2Cq_auto:good%2Cw_1100/MTkwOTE3ODgyMTAyNjg3MzE3/dj.webp",
"https://i2-prod.dailystar.co.uk/incoming/article29481684.ece/ALTERNATES/s1200d/0_LIV-Golf-Tucson-United-States-16-Mar-2023.jpg",
"https://media0.faz.net/ppmedia/aktuell/sport/2286658512/1.7136980/format_top1_breit/stephen-curry-er-hat-es.jpg",
"https://d2me2qg8dfiw8u.cloudfront.net/content/uploads/2021/06/07083621/Roger-Federer-takes-the-applause.jpg",
"https://i0.wp.com/burncitysports.com/wp-content/uploads/2023/03/USATSI_20154437.jpg?w=3000&ssl=1")
img.df <- tibble(Rang = 1:10, images = images) |>
mutate(img = circle_crop(images, border_size = 1))
findat <- cleandat |> left_join(img.df) |>
left_join(countrycode::codelist |> select(ioc, iso2c), by = c("Land" = "ioc"))
findat |> select(img, Name, Sportart, iso2c, Sport, Sponsoring, Einkommen) |>
gt() |>
gt_img_rows(columns = img, height = 50, img_source = "local") |>
fmt_flag(columns = iso2c, height = 30) |>
tab_spanner(label = "Einkommen (in Mio. USD)", columns = c(Sport, Sponsoring, Einkommen), id = "inc") |>
cols_label(img = "", iso2c = "Land", Einkommen = "Gesamt", Sport = "Sportlich", Sponsoring = "Sponsoring") |>
cols_width(Name ~ px(170), Sportart ~ px(100), Einkommen ~ px(80), Sport ~ px(100), Sponsoring ~ px(100)) |>
cols_align(columns = c(Sport, Sponsoring), align = "center") |>
data_color(columns = Einkommen, method = "numeric", palette = "Greens", alpha = 0.9) |>
tab_header(title = html("<p style='font-family:Alfa Slab One !important;text-align:center;'>Top 10 der bestbezahlten Sportler 2022/23</p>")) |>
tab_footnote(locations = cells_column_spanners(spanners = "inc"),
footnote = html("Einkommen zwischen Mai 2022 und Mai 2023.<span style='float:right;'>Quelle: ORF/Forbes. Grafik: @matschnetzer</span>")) |>
gt_theme_538() |>
tab_options(heading.title.font.size = 26,
footnotes.font.size = 10,
source_notes.font.size = 10) |>
gtsave(filename = "bestpaid_athletes.html")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment