library(ggpop)
library(ggplot2)
library(dplyr)
library(patchwork)
library(gifski)
# Search the icons you want to use with fa_icons() and note their names:
fa_icons(query = "person")
set.seed(42)
v_years <- as.character(seq(1990, 2030, by = 1))
interp <- function(years_key, vals_key, years_out) {
round(approx(years_key, vals_key, xout = years_out)$y)
}
make_country_df <- function(years_key, youth_key, adult_key, senior_key) {
yrs <- seq(1990, 2030)
youth <- interp(years_key, youth_key, yrs)
senior <- interp(years_key, senior_key, yrs)
adult <- 100 - youth - senior
data.frame(
year = rep(as.character(yrs), each = 3),
age_group = rep(c("Youth (0-24)", "Adults (25-64)", "Seniors (65+)"), length(yrs)),
n = as.vector(rbind(youth, adult, senior))
)
}
ky <- c(1990, 1995, 2000, 2005, 2010, 2015, 2020, 2025, 2030)
df_japan <- make_country_df(ky,
youth_key = c(27, 24, 20, 19, 18, 18, 17, 17, 16),
adult_key = c(61, 63, 64, 63, 62, 59, 56, 54, 52),
senior_key = c(12, 13, 16, 18, 20, 23, 27, 29, 32)
)
df_usa <- make_country_df(ky,
youth_key = c(36, 36, 35, 34, 33, 32, 30, 29, 28),
adult_key = c(52, 52, 52, 53, 53, 53, 54, 53, 52),
senior_key = c(12, 12, 13, 13, 14, 15, 16, 18, 20)
)
df_nigeria <- make_country_df(ky,
youth_key = c(65, 63, 61, 60, 58, 57, 56, 55, 53),
adult_key = c(32, 33, 35, 36, 38, 39, 40, 41, 42),
senior_key = c( 3, 4, 4, 4, 4, 4, 4, 4, 5)
)
v_age_groups <- c("Youth (0-24)", "Adults (25-64)", "Seniors (65+)")
v_colors <- c(
"Youth (0-24)" = "#42A5F5",
"Adults (25-64)" = "#26A69A",
"Seniors (65+)" = "#FFA726"
)
v_bg <- "#1B1B2F"
proc_country <- function(df) {
set.seed(42)
process_data(
data = df,
group_var = age_group,
sum_var = n,
sample_size = 100,
high_group_var = "year"
) %>%
rename(year_label = group) %>%
mutate(
icon = case_when(
type == "Youth (0-24)" ~ "child",
type == "Adults (25-64)" ~ "person",
type == "Seniors (65+)" ~ "person-cane"
),
type = factor(type, levels = v_age_groups)
)
}
df_japan_proc <- proc_country(df_japan)
df_usa_proc <- proc_country(df_usa)
df_nigeria_proc <- proc_country(df_nigeria)
make_pop_plot <- function(df_proc, yr, country_label) {
df_proc %>%
filter(year_label == yr) %>%
ggplot(aes(icon = icon, color = type)) +
geom_pop(size = 2, dpi = 100, arrange = TRUE) +
scale_color_manual(values = v_colors) +
theme_pop() +
theme(
plot.background = element_blank(),
panel.background = element_blank(),
legend.background = element_blank(),
legend.key = element_blank(),
legend.position = "none",
plot.title = element_text(size = 17, face = "bold", hjust = 0.5,
color = "white", margin = margin(b = 6))
) +
labs(title = country_label)
}
# ── Shared legend panel (built once, reused every frame) ─────────────────
p_legend <- ggplot() +
geom_pop(
data = data.frame(
icon = c("child", "person", "person-cane"),
type = factor(v_age_groups, levels = v_age_groups),
x = 1:3, y = rep(1, 3)
),
aes(icon = icon, color = type),
size = 2, dpi = 100, legend_icons = TRUE
) +
scale_color_manual(values = v_colors,
labels = c(
"Youth (0-24)" = "Youth (0\u201324)",
"Adults (25-64)" = "Adults (25\u201364)",
"Seniors (65+)" = "Seniors (65+)"
)
) +
scale_legend_icon(size = 7) +
guides(color = guide_legend(nrow = 1, title = NULL)) +
theme_void() +
theme(
plot.background = element_blank(),
panel.background = element_blank(),
legend.background = element_blank(),
legend.key = element_blank(),
legend.position = "bottom",
legend.text = element_text(color = "#B0BEC5", size = 13, face = "bold"),
legend.spacing.x = unit(12, "pt"),
legend.margin = margin(t = 4, b = 4)
)
# ── Render one frame per year ────────────────────────────────────────────
v_png_paths <- vapply(v_years, function(yr) {
is_proj <- as.integer(yr) > 2024
proj_tag <- if (is_proj) " \u00b7 \u26a0 projected" else ""
title_col <- if (is_proj) "#FFA726" else "white"
p1 <- make_pop_plot(df_japan_proc, yr, "\U0001F1EF\U0001F1F5 Japan")
p2 <- make_pop_plot(df_usa_proc, yr, "\U0001F1FA\U0001F1F8 United States")
p3 <- make_pop_plot(df_nigeria_proc, yr, "\U0001F1F3\U0001F1EC Nigeria")
# Row 1: Japan | USA — Row 2: empty | Nigeria | empty (centred)
row1 <- p1 | p2
blank <- ggplot() + theme_void() + theme(plot.background = element_blank())
row2 <- (blank | p3 | blank) + plot_layout(widths = c(0.25, 0.5, 0.25))
combined <- (row1 / row2 / p_legend) +
plot_layout(heights = c(5, 5, 1)) +
plot_annotation(
title = paste0("A World Grown Older \u2014 ", yr, proj_tag),
subtitle = "Each icon = 1% of the population \u00b7 Post-2024 figures are UN projections",
caption = "Source: UN World Population Prospects 2024 \u00b7 Visualization: ggpop",
theme = theme(
plot.background = element_rect(fill = v_bg, color = NA),
plot.title = element_text(size = 22, face = "bold", hjust = 0.5,
color = title_col, margin = margin(b = 4)),
plot.subtitle = element_text(size = 12, hjust = 0.5, color = "#B0BEC5",
lineheight = 1.5, margin = margin(b = 14)),
plot.caption = element_text(size = 9, hjust = 0.5, color = "#78909C",
margin = margin(t = 10)),
plot.margin = margin(18, 18, 18, 18)
)
)
f <- tempfile(fileext = ".png")
ggsave(f, combined, width = 12, height = 14, dpi = 100, bg = v_bg)
f
}, character(1))
# ── Stitch into GIF ──────────────────────────────────────────────────────
v_delays <- ifelse(as.integer(v_years) >= 2024, 1.5, 0.6)
#gifski(v_png_paths, gif_file = "age_structure_nations.gif",
# width = 1200, height = 1400, delay = v_delays)
