Top Golfers Per Capita (by Gender)

owgr_pop.R

library(tidyverse)
library(janitor)
library(httr)
library(k5)

# mens owgr ---------------------------------------------------------------

a <- GET(
  url = "https://apiweb.owgr.com/api/owgr/rankings/getRankings",
  query = list(
    regionId = 0,
    pageSize = 500,
    pageNumber = 1,
    countryId = 0,
    sortString = "Rank ASC"
  )
)

b <- content(a, simplifyDataFrame = TRUE, flatten = TRUE)

b <- as_tibble(b$rankingsList)

men_count <- b %>% 
  count(
    country_code = player.country.code3,
    name = "men_top_500",
    sort = TRUE
  )

# womens owgr -------------------------------------------------------------

c <- read_csv("https://www.rolexrankings.com/rolexrankings_2023-07-10.csv")

wom_count <- c %>% 
  head(500) %>% 
  count(
    country_code, 
    name = "wom_top_500",
    sort = TRUE
  )

# countries ---------------------------------------------------------------

pop_zip <- tempfile(fileext = ".zip")
GET(
  url = "https://api.worldbank.org/v2/en/indicator/SP.POP.TOTL",
  query = list(downloadformat = "csv"),
  write_disk(pop_zip)
)

file.size(pop_zip)
pop_csv <- unzip(pop_zip, exdir = tempdir())
pop_csv <- pop_csv[grep("Metadata", pop_csv, invert = TRUE)]

pop <- read_csv(file = pop_csv, skip = 3)

pop <- pop %>% 
  clean_names() %>% 
  select(
    country_code,
    pop = x2022
  )

gbr_pop <- tibble(
  country_code = c("ENG", "SCO", "WAL", "NIR"),
  pop = c(56489800, 5454000, 3136000, 1885000)
)

pop <- pop %>% 
  filter(country_code != "GBR") %>% 
  bind_rows(gbr_pop)

# compare -----------------------------------------------------------------

pop_per <- pop %>% 
  left_join(men_count) %>% 
  left_join(wom_count) %>% 
  filter(!(is.na(men_top_500) & is.na(wom_top_500))) %>% 
  arrange(desc(men_top_500)) %>% 
  mutate(
    across(where(is.numeric), ~coalesce(., 0)),
    pop = pop / 1e7,
    per_men = men_top_500 / pop,
    per_women = wom_top_500 / pop
  ) %>% 
  arrange(desc(per_men)) %>%
  select(country_code, starts_with("per_")) %>% 
  pivot_longer(
    cols = starts_with("per_"),
    names_to = "gender",
    names_prefix = "per_"
  )

pop_per %>% 
  mutate(across(gender, ~fct_rev(as_factor(.)))) %>% 
  ggplot(
    mapping = aes(
      x = reorder(country_code, value),
      y = value,
      fill = gender
    )
  ) +
  geom_col(
    position = "stack",
    color = "black"
  ) +
  coord_flip() +
  labs(
    x = "Country",
    y = "Top 500 Golfers Per 10 Million"
  ) +
  theme_classic() +
  theme(
    legend.position = c(0.8, 0.2),
    text = element_text(family = "mono")
  )