Global Fertility Decline: The Past Seven Decades

The graphic highlights the dramatic global decline in fertility rates from the 1950s to the 2010s, with significant reductions driven by middle-income countries like India and China. It also shows that the poorest and war-torn nations, primarily in Africa, continue to have high fertility rates.

Source of the Data: The fertility rate data is sourced from the United Nations’ World Population Prospects (2022) and has been processed and presented by Our World in Data. The dataset provides the average number of live births a hypothetical cohort of women would have at the end of their reproductive period, assuming they experienced the fertility rates of a specific period throughout their lives without mortality impact. The data covers the period from 1950 to 2021 and is measured in live births per woman. For more information, visit the UN’s World Population Prospects page here and here.

Total Fertility Rate (TFR) The Total Fertility Rate (TFR) is the average number of children a woman is expected to have in her lifetime based on current birth rates. It’s a measure used to understand how many children are born in a population.

Figure 1: This scatter plot illustrates the average fertility rate for each country across seven decades, from the 1950s to the 2010s. The X-axis represents the decades, while the Y-axis shows the fertility rate. Each dot, sized by population, represents a country and is coloured by continent. Translucent bands indicate the global average fertility rate for each decade.

How I made these graphics?

Getting the data

# Data Import and Wrangling Tools
library(tidyverse)            # All things tidy
library(owidR)                # Get data from Our World in R

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

search1 <- owidR::owid_search("fertility")

df1 <- owid("children-per-woman")

popdf <- owid("population-with-un-projections")

Visualization Parameters

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

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

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

showtext_auto()

# Colour Palette
mypal <- rev(paletteer::paletteer_d("LaCroixColoR::Lime")[c(1,2,4:6)])

# Background Colour
bg_col <- "grey98"
text_col <- "grey10"
text_hil <- "grey25"

# Base Text Size
bts <- 80

plot_title <- "Global Fertility Drop (1950-2021)"

plot_subtitle <- "The global Total Fertility Rate (TFR) has dropped from 5 (1950s) to 2.1 (2021), driven primarily by declines in middle-income countries, like China and India. Poor and war-torn nations, particularly in Africa, maintain high fertility rates. Wealthy European countries have seen minimal declines but have gone below replacement levels."

data_annotation <- "About the Data: This data on fertility rates, sourced from the United Nations' World Population Prospects (2022) and processed by Our World in Data, spans from 1950 to 2021. It reflects the average number of live births per woman, with age-specific rates, providing insights into global fertility trends across decades."

# 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_caption <- paste0(
  "**Data:** United Nations & Our World in Data  |  ",
  "**Code:** ", 
  social_caption_1, 
  " |  **Graphics:** ", 
  social_caption_2
  )
rm(github, github_username, xtwitter, 
   xtwitter_username, social_caption_1, social_caption_2)

Data Wrangling

# A tibble for the fertility levels in each decade
df2 <- df1 |> 
  as_tibble() |> 
  janitor::clean_names() |> 
  rename(fertility = fertility_rate_sex_all_age_all_variant_estimates) |> 
  filter(!is.na(code)) |> 
  filter(entity != "World") |> 
  select(-countries_continents) |> 
  filter(!str_detect(code, "OWID"))

# A tibble of populations for each coutnry in each decade
popdf1 <- popdf |> 
  as_tibble() |> 
  janitor::clean_names() |> 
  filter(!is.na(code)) |> 
  filter(entity != "World") |> 
  mutate(
    population = ifelse(
      is.na(population_sex_all_age_all_variant_estimates),
      population_sex_all_age_all_variant_medium,
      population_sex_all_age_all_variant_estimates
    )
  ) |> 
  select(-c(population_sex_all_age_all_variant_estimates,
            population_sex_all_age_all_variant_medium))


df_continents <- rnaturalearth::ne_countries() |> 
  as_tibble() |> 
  janitor::clean_names() |> 
  select(iso_a3, continent) |> 
  rename(code = iso_a3)

levels_x <- c("1950s", "1960s", "1970s", "1980s", "1990s", "2000s", "2010s", "2021")

# A tibble to use for final plotting
df3 <- df2 |> 
  left_join(popdf1) |>
  left_join(df_continents) |> 
  drop_na() |> 
  filter(year >= 1951 & year <= 2020) |> 
  mutate(
    year = cut(
      year, 
      breaks = seq(1950, 2020, 10), 
      labels = paste0(seq(1950, 2010, 10), "s")
      )
  ) |> 
  group_by(continent, entity, code, year) |> 
  summarise(
    fertility = weighted.mean(fertility, w = population, na.rm = T),
    population = mean(population, na.rm = T)
  ) |> 
  bind_rows(
    df2 |> 
      left_join(popdf1) |>
      left_join(df_continents) |> 
      drop_na() |> 
      filter(year == 2021) |> 
      mutate(year = as.character(year))
  ) |> 
  mutate(year = fct(year, levels = levels_x))

# A tibble to use for global averages
df4 <- df2 |> 
  left_join(popdf1) |>
  drop_na() |> 
  filter(year >= 1951 & year <= 2020) |> 
  mutate(
    year = cut(
      year, 
      breaks = seq(1950, 2020, 10), 
      labels = paste0(seq(1950, 2010, 10), "s")
      )
  ) |> 
  group_by(year) |> 
  summarise(
    fertility = weighted.mean(fertility, w = population, na.rm = T)
  ) |> 
  bind_rows(
    df2 |> 
      left_join(popdf1) |>
      drop_na() |> 
      filter(year == 2021) |> 
      group_by(year) |> 
      summarise(
        fertility = weighted.mean(fertility, w = population, na.rm = T)
      ) |> 
      mutate(year = as.character(year))
  ) |> 
  mutate(year = fct(year, levels = levels_x))

Visualization

g <- df3 |> 
  ggplot(
    aes(
      x = year, 
      y = fertility
    )
  ) +
  geom_hline(
    yintercept = 2.1,
    linetype = "longdash",
    linewidth = 0.5,
    colour = "grey10"
  ) +
  geom_point(
    mapping = aes(
      size = population,
      colour = continent
    ),
    pch = 20,
    alpha = 0.5,
    position = position_jitter(
      width = 0.2,
      height = 0
    )
  ) +
  geom_segment(
    data = df4,
    mapping = aes(
      x = as.numeric(year) - 0.4,
      xend = as.numeric(year) + 0.4,
      y = fertility,
      yend = fertility
    ),
    colour = "black",
    linewidth = 12,
    alpha = 0.2
  ) +
  geom_text(
    data = df4,
    mapping = aes(
      x = year,
      y = fertility,
      label = paste0("TFR: ", round(fertility, 1))
    ),
    colour = "grey10",
    family = "body_font",
    size = bts / 3,
    fontface = "bold"
  ) +
  annotate(
    geom = "text",
    label = str_wrap("Replacement TFR: 2.10 births per woman. At this level, population remains constant in the long-run.", 25),
    family = "caption_font",
    colour = text_hil,
    x = 0.52, y = 2.05,
    hjust = 0,
    vjust = 1,
    lineheight = 0.35,
    size = bts / 4
  ) +
  annotate(
    geom = "label",
    x = 0.52, y = 4.7,
    hjust = 0,
    vjust = 1,
    fill = "grey95",
    label = str_wrap("The value in grey stripes depicts the global average Fertility Rate", 30),
    colour = text_hil,
    family = "caption_font",
    lineheight = 0.35,
    label.size = NA,
    size = bts / 3.8,
    alpha = 0.3,
    label.padding = unit(0.1, "lines"),
    label.r = unit(0.1, "lines")
  ) +
  scale_y_continuous(
    expand = expansion(0),
    limits = c(0.8, 8.5),
    breaks = 1:8
  ) +
  paletteer::scale_color_paletteer_d("awtools::spalette") +
  scale_size_continuous(
    range = c(1, 50)
  ) +
  guides(
    size = "none",
    colour = guide_legend(
      nrow = 1,
      override.aes = list(
        size = 15
      )
    )
  ) +
  labs(
    title = plot_title,
    subtitle = str_wrap(plot_subtitle, 95),
    caption = plot_caption,
    x = NULL,
    y = "Fertility rate (average children per woman)",
    colour = NULL
  ) +
  theme_minimal(
    base_family = "body_font",
    base_size = bts
  ) +
  theme(
    panel.grid = element_blank(),
    axis.line.y = element_line(
      arrow = arrow(ends = "both", length = unit(2, "mm")),
      colour = text_hil,
      linewidth = 0.3
    ),
    axis.ticks.length = unit(0, "mm"),
    axis.title = element_text(
      colour = text_hil,
      margin = margin(0,0,0,0, "mm")
    ),
    axis.text = element_text(
      colour = text_hil,
      margin = margin(0,0,0,0, "mm"),
      size = bts * 1.2,
      face = "bold"
    ),
    
    legend.position = "top",
    legend.margin = margin(0,0,-10,0, "mm"),
    legend.box.margin = margin(5,0,-10,0, "mm"),
    legend.text = element_text(
      family = "caption_font",
      size = bts,
      margin = margin(0,0,0,0, "mm")
      ),
    legend.key.spacing.y = unit(1, "mm"),
    legend.direction = "horizontal",
    
    plot.title.position = "plot",
    plot.margin = margin(10,5,10,5, "mm"),
    plot.caption = element_textbox(
      hjust = 0.5,
      family = "caption_font",
      colour = text_hil,
      margin = margin(10,0,5,0, "mm")
    ),
    plot.subtitle = element_text(
      lineheight = 0.25,
      colour = text_hil,
      hjust = 0.5,
      margin = margin(5,0,0,0, "mm")
    ),
    plot.title = element_text(
      family = "title_font",
      colour = text_hil,
      size = 2.5 * bts,
      face = "bold",
      hjust = 0.5,
      margin = margin(15,0,0,0, "mm")
    )
  )

An A4-size Visualization on same pattern

This scatter plot illustrates the average fertility rate for each country across seven decades, from the 1950s to the 2010s. The X-axis represents the decades, while the Y-axis shows the fertility rate. Each dot, sized by population, represents a country and is colored by continent. Translucent bands indicate the global average fertility rate for each decade.

g <- df3 |> 
  ggplot(
    aes(
      x = year, 
      y = fertility
    )
  ) +
  geom_hline(
    yintercept = 2.1,
    linetype = "longdash",
    linewidth = 0.5,
    colour = "grey10"
  ) +
  geom_point(
    mapping = aes(
      size = population,
      colour = continent
    ),
    pch = 20,
    alpha = 0.5,
    position = position_jitter(
      width = 0.2,
      height = 0
    )
  ) +
  geom_segment(
    data = df4,
    mapping = aes(
      x = as.numeric(year) - 0.4,
      xend = as.numeric(year) + 0.4,
      y = fertility,
      yend = fertility
    ),
    colour = "black",
    linewidth = 12,
    alpha = 0.2
  ) +
  geom_text(
    data = df4,
    mapping = aes(
      x = year,
      y = fertility,
      label = paste0("TFR: ", round(fertility, 1))
    ),
    colour = "grey10",
    family = "body_font",
    size = bts / 3,
    fontface = "bold"
  ) +
  annotate(
    geom = "text",
    label = str_wrap("Replacement TFR: 2.10 births per woman. At this level, population remains constant in the long-run.", 25),
    family = "caption_font",
    colour = text_hil,
    x = 0.52, y = 2.05,
    hjust = 0,
    vjust = 1,
    lineheight = 0.35,
    size = bts / 4
  ) +
  annotate(
    geom = "label",
    x = 0.52, y = 4.8,
    hjust = 0,
    vjust = 1,
    fill = "grey95",
    label = str_wrap("The value in grey stripes depicts the global average Fertility Rate", 30),
    colour = text_hil,
    family = "caption_font",
    lineheight = 0.35,
    label.size = NA,
    size = bts / 3.8,
    alpha = 0.3,
    label.padding = unit(0.1, "lines"),
    label.r = unit(0.1, "lines")
  ) +
  scale_y_continuous(
    expand = expansion(0),
    limits = c(0.8, 8.5),
    breaks = 1:8
  ) +
  paletteer::scale_color_paletteer_d("awtools::spalette") +
  scale_size_continuous(
    range = c(1, 50)
  ) +
  guides(
    size = "none",
    colour = guide_legend(
      nrow = 1,
      override.aes = list(
        size = 15
      )
    )
  ) +
  labs(
    title = plot_title,
    subtitle = str_wrap(plot_subtitle, 95),
    caption = plot_caption,
    x = NULL,
    y = "Fertility rate (average children per woman)",
    colour = NULL
  ) +
  theme_minimal(
    base_family = "body_font",
    base_size = bts
  ) +
  theme(
    panel.grid = element_blank(),
    axis.line.y = element_line(
      arrow = arrow(ends = "both", length = unit(2, "mm")),
      colour = text_hil,
      linewidth = 0.3
    ),
    axis.ticks.length = unit(0, "mm"),
    axis.title = element_text(
      colour = text_hil,
      margin = margin(0,0,0,0, "mm")
    ),
    axis.text = element_text(
      colour = text_hil,
      margin = margin(0,0,0,0, "mm"),
      size = bts * 1.2,
      face = "bold"
    ),
    
    legend.position = "top",
    legend.margin = margin(0,0,-10,-18, "mm"),
    legend.box.margin = margin(5,0,-10,0, "mm"),
    legend.text = element_text(
      size = bts,
      margin = margin(0,0,0,0, "mm"),
      colour = text_hil,
      family = "title_font"
      ),
    legend.key.spacing.y = unit(1, "mm"),
    legend.direction = "horizontal",
    
    plot.title.position = "plot",
    plot.margin = margin(10,10,10,10, "mm"),
    plot.caption = element_textbox(
      hjust = 0.5,
      family = "caption_font",
      colour = text_hil,
      margin = margin(10,0,5,0, "mm")
    ),
    plot.subtitle = element_text(
      lineheight = 0.25,
      colour = text_hil,
      hjust = 0.5,
      margin = margin(5,0,0,0, "mm")
    ),
    plot.title = element_text(
      family = "title_font",
      colour = text_hil,
      size = 2.5 * bts,
      face = "bold",
      hjust = 0.5,
      margin = margin(15,0,0,0, "mm")
    )
  )

# QR Code for the plot
url_graphics <- paste0(
  "https://aditya-dahiya.github.io/projects_presentations/projects/",
  # The file name of the current .qmd file
  "owid_fertility_scatter",
  ".qmd"
)
# remotes::install_github('coolbutuseless/ggqr')
# library(ggqr)
plot_qr <- ggplot(
  data = NULL, 
  aes(x = 0, y = 0, label = url_graphics)
  ) + 
  ggqr::geom_qr(
    colour = text_hil, 
    fill = bg_col,
    size = 1.5
    ) +
  # labs(caption = "Scan for the Interactive Version") +
  coord_fixed() +
  theme_void() +
  theme(plot.background = element_rect(
    fill = "transparent", 
    colour = "transparent"
    )
  )

plot_data <- ggplot() +
  annotate(
    geom = "text",
    x = 0, y = 0,
    label = str_wrap(data_annotation, 50),
    family = "caption_font",
    colour = text_hil,
    lineheight = 0.3, 
    size = bts / 7,
    hjust = 1,
    vjust = 1
  ) +
  theme_void()

plot_ann1 <- ggplot() +
  annotate(
    geom = "text",
    x = 0, y = 0,
    label = "Each dot represents a Country.\nSize of dot represents the population size.",
    family = "caption_font",
    colour = text_hil,
    lineheight = 0.3, 
    size = bts / 3,
    hjust = 0.5,
    vjust = 1
  ) +
  theme_void()

g_full <- g +
  inset_element(
    p = plot_qr,
    left = 0.88, right = 1,
    top = 1.02, bottom = 0.9,
    align_to = "panel",
    clip = FALSE
  ) +
  inset_element(
    p = plot_data,
    left = 0.75, right = 1.23,
    top = 0.95, bottom = 0.82,
    align_to = "panel",
    clip = FALSE
  ) +
  inset_element(
    p = plot_ann1,
    left = 0.35, right = 0.8,
    top = 1.01, bottom = 0.92,
    align_to = "panel",
    clip = FALSE
  ) +
  plot_annotation(
    theme = theme(
      plot.background = element_rect(
        fill = "transparent", colour = "transparent"
      ),
      panel.background = element_rect(
        fill = "transparent", colour = "transparent"
      )
    )
  )


ggsave(
  filename = here::here("data_vizs", "a4_owid_fertility_scatter.png"),
  plot = g_full,
  width = 210 * 2,
  height = 297 * 2,
  units = "mm",
  bg = bg_col
)

Save the graphic and a thumbnail

ggsave(
  filename = here::here("data_vizs", "owid_fertility_scatter.png"),
  plot = g,
  width = 400,
  height = 500,
  units = "mm",
  bg = bg_col
)

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