# Get data
# library(tidytuesdayR)
# dat <- tt_load("2025-10-14")
# dat <- dat$food_security
# install.packages("ripc")
# library(ripc)
# ipc_get_areas()
# needs a key
library(readr)
library(janitor)
library(dplyr)
library(tidyr)
library(sf)
library(rnaturalearth)
library(scales)
library(ggbump)
library(ggbranding)
library(ggplot2)
library(ggtext)
library(BBmisc)
library(showtext)
library(sysfonts)
library(viridis)
# get data manually downloaded
dat <- read_csv("IPC_CH_numbers_by_country_14-10-2025.csv") |>
clean_names() |>
rowwise() |>
mutate(
phase_4plus = sum(c_across(all_of(c("phase_4", "phase_5"))), na.rm = TRUE)
) |>
ungroup() |>
arrange(desc(phase_4plus)) |>
slice_head(n = 15)World Food Day
TidyTuesday 2025-10-14
r
ggplot2
ggbump
map
Overview
This week’s TidyTuesday focused on the FAO dataset on food security. I chose to use IPC data instead and reproduce this graph from David Sjoberg.
Dataset
Data Preparation
# Clean and prepare the data
# Libraries
# world sf
world <- rnaturalearthdata::sovereignty110 |>
st_transform(crs = 4326)
# gaza sf
gaza <- st_read("ipc_pse.geojson") |>
st_union() |>
st_as_sf() |>
mutate(country = "Gaza Strip", geometry = x) |>
left_join(dat |> filter(country == "Gaza Strip"))Reading layer `ipc_pse' from data source
`/home/runner/work/TidyTuesday/TidyTuesday/posts/2025/week_41/ipc_pse.geojson'
using driver `GeoJSON'
Simple feature collection with 5 features and 35 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 34.21877 ymin: 31.21997 xmax: 34.56802 ymax: 31.59492
Geodetic CRS: WGS 84# wold_ipc
world_ipc <- dat |>
filter(country != "Gaza Strip") |>
left_join(world, by = c("country" = "sovereignt")) |>
bind_rows(gaza) |>
mutate(
country = ifelse(country == "Central African Republic", "CAR", country)
) |>
st_as_sf()
# centroids (point on surface is safer for multipolygons)
# add parameters for sigmoids
ranking <- world_ipc |>
st_point_on_surface() |>
st_coordinates() |>
as_tibble() |>
bind_cols(
tibble(country = world_ipc$country, ipc_num = world_ipc$phase_4plus)
) |>
mutate(
rank_val = rank(ipc_num, ties.method = "first"),
fine_cap = normalize(
rank_val,
range = c(-15, 75),
method = "range"
),
xend = 95,
x_axis_start = xend + 2,
fine_cap_x = normalize(
ipc_num,
range = c(first(x_axis_start), 120),
method = "range"
),
# x_axis_end = fine_cap_x + 10,
label = scales::label_number(accuracy = 0.1, scale_cut = cut_short_scale())(
ipc_num
)
)Plot
showtext_auto()
showtext_opts(dpi = 600)
font_add_google("Fira Sans", "fira_sans")
base_font <- "fira_sans"
title <- "The 15 Countries with the Largest Number of People Experiencing Severe Food Insecurity"
caption_text <- "The chart combines the latest Integrated Food Security Phase Classification (IPC) and Cadre Harmonisé (CH) analyses of acute food insecurity, covering both current and projected conditions across 31 countries (15 IPC, 16 CH). The ranking is based on the number of people found in IPC/CH Phase 4 (Emergency) and Phase 5 (Catastrophe/Famine)."
brand <- branding(
github = "gnoblet",
bluesky = "gnoblet.bsky.social",
website = "guillaume-noblet.com",
text_size = "13pt",
icon_size = "13pt",
text_color = "white",
icon_color = viridis::plasma(1),
line_spacing = 2L,
text_position = "after",
additional_text = "Source: ipcinfo.org. Data downloaded on October 13, 2025.\nAnalyses older than 3 months are not included.",
additional_text_size = "10pt",
additional_text_color = "white",
text_family = base_font
)
# ggplot
g <- ggplot() +
geom_sf(
data = world,
size = .3,
fill = "transparent",
color = "gray17"
) +
# Limit coordinates
coord_sf(
xlim = c(-95, 130),
ylim = c(-20, 85),
expand = FALSE
) +
# Sigmoid from country to start of barchart
geom_sigmoid(
data = ranking,
aes(
x = X,
y = Y,
xend = 95,
yend = fine_cap,
group = country,
color = fine_cap
),
alpha = .6,
smooth = 12,
size = 0.8
) +
# Line from xstart to value
geom_segment(
data = ranking,
aes(
x = x_axis_start,
y = fine_cap,
xend = fine_cap_x + 2,
yend = fine_cap,
color = fine_cap
),
alpha = .6,
size = 1,
lineend = "round"
) +
# dot on centroid of country in map
geom_point(data = ranking, aes(x = X, y = Y, color = fine_cap), size = 2) +
# Country text
geom_text(
data = ranking,
aes(
x = x_axis_start - 2,
y = fine_cap + 0.8,
label = country,
color = fine_cap
),
hjust = 1,
size = 4,
nudge_y = .5
) +
# Value text
geom_text(
data = ranking,
aes(x = fine_cap_x + 2.1, y = fine_cap, label = label, color = fine_cap),
hjust = 0,
size = 4,
nudge_x = 0.6
) +
# color scales
scale_fill_viridis(option = "C") +
scale_color_viridis(option = "C") +
# title
geom_textbox(
aes(
x = -90,
y = 75,
label = title,
),
hjust = 0,
size = 8,
color = "white",
box.color = NA,
width = unit(0.6, "npc"),
fill = NA
) +
# caption
geom_textbox(
aes(
x = -90,
y = 60,
label = caption_text
),
family = base_font,
fill = "gray10",
size = 4,
alpha = 0.6,
color = "white",
width = unit(0.40, "npc"),
hjust = 0,
vjust = 1
) +
# branding
annotate(
"richtext",
x = -90,
y = -15,
label = brand,
fill = NA,
hjust = 0
) +
theme_void(base_family = base_font) +
theme(
text = element_text(family = base_font),
plot.margin = margin(.5, 1, .5, .5, "cm"),
legend.position = "none",
plot.background = element_rect(fill = "black"),
plot.caption = element_text(color = "gray40")
)
# return the plot object
ggsave("week_41.png", plot = g, width = 12, height = 8, dpi = 600) x y xend yend group colour PANEL
1 47.473138 15.815314 95 75.000000 1 75.000000 1
2 28.970075 8.027146 95 68.571429 2 68.571429 1
3 -72.147407 18.943521 95 62.142857 3 62.142857 1
4 65.314666 33.832651 95 49.285714 4 49.285714 1
5 7.831878 8.927685 95 42.857143 5 42.857143 1
6 46.794180 5.170365 95 36.428571 6 36.428571 1
7 70.092628 30.357656 95 30.000000 7 30.000000 1
8 13.491598 7.226200 95 23.571429 8 23.571429 1
9 18.306714 15.277565 95 17.142857 9 17.142857 1
10 20.478740 6.762960 95 10.714286 10 10.714286 1
11 -90.334220 15.791556 95 4.285714 11 4.285714 1
12 -1.087375 7.815686 95 -2.142857 12 -2.142857 1
13 9.774101 17.390089 95 -8.571429 13 -8.571429 1
14 -11.844425 8.560873 95 -15.000000 14 -15.000000 1
15 34.357918 31.407499 95 55.714286 15 55.714286 1Viz
