India at Mathematics Olympiad over the years

Exploring dataset from the International Mathematical Olympiad (IMO), to see the rankings of countries (particularly India) on the medal tally.

Figure 1: A bump Chart on Ranking of India at the International Mathematics Olympiad (by number of medals won) in last 3 decades. India’s ranking is improving, while China and USA continue to dominate the olympiad.

How I made this graphic?

Loading libraries & data

# Data Import and Wrangling Tools
library(tidyverse)            # All things tidy

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours
library(patchwork)            # Combining plots

# Getting the data
country_results_df <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-09-24/country_results_df.csv')

# individual_results_df <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-09-24/individual_results_df.csv')
# 
# timeline_df <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-09-24/timeline_df.csv')

# Using ChatGPT, a tibble for ISO 2 Codes for the countries
# needed for the flags
# Load the necessary package

country_labels <- tibble(
  country = c("People's Republic of China", "Union of Soviet Socialist Republics", "France", "United States of America",
              "Romania", "United Kingdom", "Bulgaria", "Hungary", "Italy", "India", "Brazil", "Luxembourg",
              "Czechoslovakia", "German Democratic Republic", "Islamic Republic of Iran", "Canada", "Norway",
              "Germany", "Australia", "Japan", "Poland", "Austria", "Democratic People's Republic of Korea", "Vietnam",
              "Israel", "Yugoslavia", "Sweden", "Netherlands", "Colombia", "Republic of Korea", "Tunisia", "Morocco",
              "Hong Kong", "Singapore", "New Zealand", "Thailand", "Türkiye", "Mexico", "Argentina", "Cuba", "Ireland",
              "Greece", "Finland", "Kuwait", "Cyprus", "Philippines", "Iceland", "Spain", "Bahrain", "Mongolia", 
              "Belgium", "Switzerland", "Denmark", "Trinidad and Tobago", "Portugal", "Commonwealth of Independent States", 
              "Russian Federation", "Taiwan", "Ukraine", "Latvia", "Kazakhstan", "Armenia", "Belarus", "Slovakia", 
              "Czech Republic", "Georgia", "North Macedonia", "Slovenia", "Macau", "Chile", "South Africa", "Croatia", 
              "Estonia", "Republic of Moldova", "Lithuania", "Peru", "Bosnia and Herzegovina", "Uzbekistan", "Venezuela", 
              "Indonesia", "Serbia and Montenegro", "Azerbaijan", "Kyrgyzstan", "Puerto Rico", "Albania", "Turkmenistan", 
              "Paraguay", "Serbia", "Malaysia", "Tajikistan", "Saudi Arabia", "Bangladesh", "Syria", "Algeria", 
              "Montenegro", "El Salvador"),
  
  iso_a2 = c("CN", "SU", "FR", "US", "RO", "GB", "BG", "HU", "IT", "IN", "BR", "LU", "CS", "DD", "IR", "CA", "NO", "DE", 
             "AU", "JP", "PL", "AT", "KP", "VN", "IL", "YU", "SE", "NL", "CO", "KR", "TN", "MA", "HK", "SG", "NZ", "TH", 
             "TR", "MX", "AR", "CU", "IE", "GR", "FI", "KW", "CY", "PH", "IS", "ES", "BH", "MN", "BE", "CH", "DK", "TT", 
             "PT", "CIS", "RU", "TW", "UA", "LV", "KZ", "AM", "BY", "SK", "CZ", "GE", "MK", "SI", "MO", "CL", "ZA", "HR", 
             "EE", "MD", "LT", "PE", "BA", "UZ", "VE", "ID", "CS", "AZ", "KG", "PR", "AL", "TM", "PY", "RS", "MY", "TJ", 
             "SA", "BD", "SY", "DZ", "ME", "SV")
) |> 
  mutate(iso_a2 = str_to_lower(iso_a2))

Data Wrangling and EDA

df <- country_results_df |>
  select(year, country, starts_with("awards")) |>
  filter(!(country %in% c("Yugoslavia", "Serbia and Montenegro"))) |> 
  group_by(year) |>
  arrange(desc(awards_gold),
    desc(awards_silver),
    desc(awards_bronze),
    .by_group = TRUE
  ) |> 
  mutate(rank = row_number()) |> 
  select(-awards_honorable_mentions) |> 
  ungroup() |> 
  filter(year >= 2000) |> 
  filter(rank <= 50)
  
sel_cons <- c("India")

plotdf <- df |> 
   left_join(country_labels)

# Check missingness
# df |> 
#   left_join(country_labels) |> 
#   naniar::vis_miss()

# finding the missing flags
# avl_flags <- ggflags::lflags |> 
#   names()
# 
# plotdf |> 
#   distinct(iso_a2) |> 
#   filter(!(iso_a2 %in% avl_flags))
# 
# plotdf |> 
#   filter(iso_a2 %in% c("yu", "cs"))

Visualization Parameters

# Font for titles
font_add_google("Fondamento",
  family = "title_font"
) 

# Font for the caption
font_add_google("Barlow Condensed",
  family = "caption_font"
) 

# Font for plot text
font_add_google("Fondamento",
  family = "body_font"
) 

showtext_auto()

bg_col <- "white"

text_col <- "grey25"
text_hil <- "grey25"

bts <- 90

# Caption stuff for the plot
sysfonts::font_add(
  family = "Font Awesome 6 Brands",
  regular = here::here("docs", "Font Awesome 6 Brands-Regular-400.otf")
)
github <- "&#xf09b"
github_username <- "aditya-dahiya"
xtwitter <- "&#xe61b"
xtwitter_username <- "@adityadahiyaias"
social_caption_1 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{github};</span> <span style='color: {text_hil}'>{github_username}  </span>")
social_caption_2 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{xtwitter};</span> <span style='color: {text_hil}'>{xtwitter_username}</span>")

plot_title <- "India at International Mathematics Olympiad" 

plot_subtitle <- "China and USA have dominated the rankings in last three decades,\nbut India seems to be catching up, and reached 3rd rank in 2024."

plot_caption <- paste0(
  "**Data:** International Mathematical Olympiad", 
  " |  **Code:** ", 
  social_caption_1, 
  " |  **Graphics:** ", 
  social_caption_2
  )

rm(github, github_username, xtwitter, 
   xtwitter_username, social_caption_1, 
   social_caption_2)

The static plot

g <- plotdf |> 
  ggplot(
    mapping = aes(
      x = year,
      y = rank
    )
  ) +
  geom_point(
    data = plotdf |> filter(country %in% sel_cons),
    alpha = 0.9,
    size = 14,
    colour = text_col
  ) +
  ggbump::geom_bump(
    data = plotdf |> filter(country %in% sel_cons),
    mapping = aes(group = country),
    alpha = 0.9,
    linewidth = 3,
    colour = text_col
  ) +
  ggflags::geom_flag(
    mapping = aes(country = iso_a2),
    size = 7.5
  ) +
  scale_y_reverse(
    breaks = c(1, 5, 10, 20, 30, 40, 50),
    expand = expansion(c(0.02, 0))
  ) +
  scale_x_continuous(
    breaks = c(seq(1990, 2024, 5), 2024),
    expand = expansion(c(0.01, 0.06))
  ) +
  coord_cartesian(
    clip = "off"
  ) +
  
  labs(
    title = plot_title,
    subtitle = plot_subtitle,
    caption = plot_caption,
    x = "Year", y = "Rank of Country in the Olympiad (by medals)"
  ) +
  theme_minimal(
    base_family = "title_font",
    base_size = bts
  ) +
  theme(
    # Overall Plot
    plot.margin = margin(10,5,10,5, "mm"),
    plot.title.position = "plot",
    
    # Axes
    axis.ticks.length = unit(2, "mm"),
    axis.ticks = element_blank(),
    axis.line.x = element_line(
      arrow = arrow(length = unit(5, "mm")),
      colour = text_hil,
      linewidth = 0.4
    ),
    axis.text = element_text(
      margin = margin(0,0,0,0, "mm")
    ),
    axis.title = element_text(
      margin = margin(-2,0,-2,0, "mm")
    ),
    
    # Panel
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank(),
    panel.grid.major.y = element_line(
      linetype = 3,
      linewidth = 0.25
    ),
    panel.grid.minor.y = element_blank(),
    
    # Text
    text = element_text(
      colour = text_col,
      lineheight = 0.3
    ),
    
    # Labels
    plot.title = element_text(
      size = 2 * bts,
      margin = margin(0,0,0,0, "mm"),
      hjust = 0.5,
      family = "caption_font"
    ),
    plot.subtitle = element_text(
      margin = margin(5,0,10,0, "mm"),
      hjust = 0.5
    ),
    plot.caption = element_textbox(
      margin = margin(5,0,0,0, "mm"),
      family = "caption_font",
      hjust = 0.5
    )
  )

ggsave(
  filename = here::here("data_vizs", "tidy_math_olymp.png"),
  plot = g,
  width = 400,    # Best Twitter Aspect Ratio = 5:4
  height = 500,   
  units = "mm",
  bg = "white"
)

Savings the graphics

ggsave(
  filename = here::here("data_vizs", "tidy_math_olymp.png"),
  plot = g,
  width = 400,    # Best Twitter Aspect Ratio = 5:4
  height = 500,   
  units = "mm",
  bg = "white"
)

library(magick)
# Saving a thumbnail for the webpage
image_read(here::here("data_vizs", "tidy_math_olymp.png")) |> 
  image_resize(geometry = "400") |> 
  image_write(
    here::here(
      "data_vizs", 
      "thumbnails", 
      "tidy_math_olymp.png"
    )
  )