if(!require(pacman))install.packages("pacman")
## Loading required package: pacman
pacman::p_load('tidyverse',  'gapminder',
               'forcats', 'scales','plotly')
olympics <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-07-27/olympics.csv')

History of Olympic Games

https://www.scholastic.com/teachers/articles/teaching-content/history-olympic-games/

Badminton

Recently, I enjoy watching the Olympic Games Tokyo 2020, and I am most addicted to badminton games. Therefore, I am interested in how this sport has evolved over time and which country has won the most medals.

Q) Which country won the most badminton medals?

badminton <- olympics %>%
  filter(sport=="Badminton", medal != "NA") %>%
  group_by(noc,medal) %>%
  summarise(
    number = length(medal)
  ) 
view(badminton)

# order Team by total medal count
# https://www.kaggle.com/heesoo37/olympic-history-data-a-thorough-analysis/report
levs_badminton <- badminton %>%
  group_by(noc) %>%
  summarize(Total=sum(number)) %>%
  arrange(Total) %>%
  select(noc)
badminton$noc <- factor(badminton$noc, levels=levs_badminton$noc)
# https://www.stat.berkeley.edu/~s133/factors.html
badminton$medal <- factor(badminton$medal, labels=c("Gold","Silver","Bronze"))
ggplot(badminton, aes(x=noc,y=number,fill=medal)) +
  geom_col() +
  theme_bw() +
  coord_flip() + 
  scale_fill_manual(values=c("#D6AF36","#D7D7D7","#A77044")) +
  xlab("") +
  ylab("") +
  ggtitle("China won most Badminton medals in the Olympic history") +
  labs(caption="source:www.sports-reference.com")

  theme(plot.title = element_text(hjust = 0.5),
        panel.background = element_rect(fill = "white"),
        panel.grid.major = element_line(colour = "#D3D3D3"),
        panel.grid.minor = element_line(colour = NULL),
        text=element_text(size=14,  family="Gill Sans"))
## List of 5
##  $ text            :List of 11
##   ..$ family       : chr "Gill Sans"
##   ..$ face         : NULL
##   ..$ colour       : NULL
##   ..$ size         : num 14
##   ..$ hjust        : NULL
##   ..$ vjust        : NULL
##   ..$ angle        : NULL
##   ..$ lineheight   : NULL
##   ..$ margin       : NULL
##   ..$ debug        : NULL
##   ..$ inherit.blank: logi FALSE
##   ..- attr(*, "class")= chr [1:2] "element_text" "element"
##  $ panel.background:List of 5
##   ..$ fill         : chr "white"
##   ..$ colour       : NULL
##   ..$ size         : NULL
##   ..$ linetype     : NULL
##   ..$ inherit.blank: logi FALSE
##   ..- attr(*, "class")= chr [1:2] "element_rect" "element"
##  $ panel.grid.major:List of 6
##   ..$ colour       : chr "#D3D3D3"
##   ..$ size         : NULL
##   ..$ linetype     : NULL
##   ..$ lineend      : NULL
##   ..$ arrow        : logi FALSE
##   ..$ inherit.blank: logi FALSE
##   ..- attr(*, "class")= chr [1:2] "element_line" "element"
##  $ panel.grid.minor:List of 6
##   ..$ colour       : NULL
##   ..$ size         : NULL
##   ..$ linetype     : NULL
##   ..$ lineend      : NULL
##   ..$ arrow        : logi FALSE
##   ..$ inherit.blank: logi FALSE
##   ..- attr(*, "class")= chr [1:2] "element_line" "element"
##  $ plot.title      :List of 11
##   ..$ family       : NULL
##   ..$ face         : NULL
##   ..$ colour       : NULL
##   ..$ size         : NULL
##   ..$ hjust        : num 0.5
##   ..$ vjust        : NULL
##   ..$ angle        : NULL
##   ..$ lineheight   : NULL
##   ..$ margin       : NULL
##   ..$ debug        : NULL
##   ..$ inherit.blank: logi FALSE
##   ..- attr(*, "class")= chr [1:2] "element_text" "element"
##  - attr(*, "class")= chr [1:2] "theme" "gg"
##  - attr(*, "complete")= logi FALSE
##  - attr(*, "validate")= logi TRUE
ggsave("Badminton.png")

Creating a map for countries with most badminton champions

https://www.kaggle.com/heesoo37/olympic-history-data-a-thorough-analysis/report

# Load data file matching NOCs with mao regions (countries)
# https://raw.githubusercontent.com/rgriff23/Olympic_history/master/data/noc_regions.csv
noc <- read_csv("https://raw.githubusercontent.com/rgriff23/Olympic_history/master/data/noc_regions.csv")
# raname column from NOC to noc
# http://www.cookbook-r.com/Manipulating_data/Renaming_columns_in_a_data_frame/
names(noc)[1] <- "noc"
# Add regions to data and remove missing points
data_regions <- badminton %>% 
  left_join(noc,by="noc") %>%
  filter(!is.na(region))
total_badminton <- data_regions %>%
  group_by(region) %>%
  summarize(total = sum(number)) %>%
  arrange(desc(total))

Data for mapping

world <- map_data("world")
mapdat <- tibble(region=unique(world$region))
mapdat <- mapdat %>% 
  left_join(total_badminton, by="region")
mapdat$total[is.na(mapdat$total)] <- 0
world <- left_join(world, mapdat, by="region")

Plotting

badminton_map <- ggplot(world, aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill = total)) +
  labs(title = "Most badminton medalists come from Asia",
       caption="source:www.sports-reference.com",
       x = NULL, y=NULL) +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "white"),
        plot.title = element_text(hjust = 0.5),
        text=element_text(family="Gill Sans"),
        legend.position="top") +
  guides(fill=guide_colourbar(title="total medals")) +
  scale_fill_gradient(low="grey",high="red")

Most countries seem to be located on the East.

#install and load in ggforce for facet zoom
library(ggforce)

Zoom in…

badminton_map +
  facet_zoom(xlim = c(70, 140)) 

ggsave("badminton_zoom.png")
## Saving 7 x 5 in image

Q) Gold medal distribution across time (1992-2016)

summer <- olympics %>%
  select(noc,games:medal) %>%
  filter(sport=="Badminton", medal == "Gold") %>%
  arrange(year) %>%
  group_by(year,event,medal,noc) %>%
  count()
ggplot(summer, aes(x=year,fill=noc)) +
  geom_bar() +
  theme_classic() +
  labs(title="Only these six countries could take badminton gold medals home",subtitle="gold medal distribution across 5 events from 1992 to 2016", caption="source:www.sports-reference.com",y=NULL) +
  scale_x_continuous(name ="year",breaks=unique(summer$year)) +
  theme(plot.title = element_text(hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5),
        plot.caption = element_text(hjust = 1),
        text=element_text(family="Gill Sans"),
        legend.position="top",
        legend.title = element_blank()) +
  guides(colour = guide_legend(nrow = 1))

ggsave("gold.png")
## Saving 7 x 5 in image