---
title: "The UK's Climate Is Warming — and Extremes Are Increasing"
subtitle: "Summers are getting hotter and hard-freeze years are increasingly rare, while extreme-heat years cluster after ~1990 signaling rising heat risk."
description: "Analyzing 125 years of UK Met Office data reveals rising temperatures, declining frost days, and a surge in extreme heat events after 1990—clear evidence of accelerating climate change."
date: "2025-10-19"
categories: ["TidyTuesday", "2025"]
tags: [
"climate change",
"UK meteorology",
"time series analysis",
"ggplot2",
"patchwork",
"extreme weather",
"temperature trends",
"LOESS smoothing",
"historical data",
"environmental data",
"Met Office",
"data storytelling"
]
image: "thumbnails/tt_2025_42.png"
format:
html:
toc: true
toc-depth: 5
code-link: true
code-fold: true
code-tools: true
code-summary: "Show code"
editor_options:
chunk_output_type: inline
execute:
freeze: true
cache: true
error: false
message: false
warning: false
eval: true
---
{#fig-1}
### <mark> **Steps to Create this Graphic** </mark>
#### 1. Load Packages & Setup
```{r}
#| label: load
#| warning: false
#| message: false
#| results: "hide"
## 1. LOAD PACKAGES & SETUP ----
suppressPackageStartupMessages({
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse, # Easily Install and Load the 'Tidyverse'
ggtext, # Improved Text Rendering Support for 'ggplot2'
showtext, # Using Fonts More Easily in R Graphs
janitor, # Simple Tools for Examining and Cleaning Dirty Data
scales, # Scale Functions for Visualization
glue, # Interpreted String Literals
patchwork # The Composer of Plots
)})
### |- figure size ----
camcorder::gg_record(
dir = here::here("temp_plots"),
device = "png",
width = 10,
height = 12,
units = "in",
dpi = 320
)
# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
```
#### 2. Read in the Data
```{r}
#| label: read
#| include: true
#| eval: true
#| warning: false
tt <- tidytuesdayR::tt_load(2025, week = 42)
historic_station_met <- tt$historic_station_met |> clean_names()
station_meta <- tt$station_meta |> clean_names()
tidytuesdayR::readme(tt)
rm(tt)
```
#### 3. Examine the Data
```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false
glimpse(historic_station_met)
glimpse(station_meta)
```
#### 4. Tidy Data
```{r}
#| label: tidy-fixed
#| warning: false
# data prep
met_data <- historic_station_met |>
left_join(station_meta, by = "station") |>
mutate(
date = make_date(year, month, 1),
decade = floor(year / 10) * 10,
season = case_when(
month %in% c(12, 1, 2) ~ "Winter",
month %in% c(3, 4, 5) ~ "Spring",
month %in% c(6, 7, 8) ~ "Summer",
TRUE ~ "Autumn"
),
era = case_when(
year < 1950 ~ "1900–1949",
year < 2000 ~ "1950–1999",
TRUE ~ "2000–present"
)
)
# P1: Long-term trends across stations
trends <- met_data |>
filter(year >= 1900) |>
summarise(
avg_tmax = mean(tmax, na.rm = TRUE),
avg_rain = mean(rain, na.rm = TRUE),
avg_sun = mean(sun, na.rm = TRUE),
avg_frost = mean(af, na.rm = TRUE),
.by = year
) |>
pivot_longer(
starts_with("avg_"),
names_to = "variable",
values_to = "value"
) |>
mutate(
variable = recode(variable,
avg_tmax = "Maximum Temperature",
avg_rain = "Monthly Rainfall",
avg_sun = "Monthly Sunshine",
avg_frost = "Air Frost Days"
),
variable = factor(variable,
levels = c("Maximum Temperature", "Monthly Rainfall", "Monthly Sunshine", "Air Frost Days")
),
variable_label = case_match(
variable,
"Maximum Temperature" ~ "Maximum Temperature (°C)",
"Monthly Rainfall" ~ "Monthly Rainfall (mm)",
"Monthly Sunshine" ~ "Monthly Sunshine (hours)",
"Air Frost Days" ~ "Air Frost Days (days)"
)
)
last_points <- trends |>
group_by(variable_label) |>
slice_max(year, n = 1, with_ties = FALSE)
# P2: Extreme weather events timeline
annual_summary <- met_data |>
summarise(
total_rain = sum(rain, na.rm = TRUE),
max_temp = max(tmax, na.rm = TRUE),
min_temp = min(tmin, na.rm = TRUE),
n_stations = dplyr::n(),
.by = year
) |>
filter(year >= 1900, n_stations >= 12)
# thresholds
thr <- list(
rain_hi = quantile(annual_summary$total_rain, 0.95, na.rm = TRUE),
heat_hi = quantile(annual_summary$max_temp, 0.95, na.rm = TRUE),
cold_lo = quantile(annual_summary$min_temp, 0.05, na.rm = TRUE)
)
extreme_events <- annual_summary |>
mutate(
rain_extreme = total_rain > thr$rain_hi,
heat_extreme = max_temp > thr$heat_hi,
cold_extreme = min_temp < thr$cold_lo
) |>
pivot_longer(
ends_with("_extreme"),
names_to = "event_type",
values_to = "is_extreme"
) |>
filter(is_extreme) |>
mutate(
event_label = factor(
case_match(
event_type,
"rain_extreme" ~ "Extreme Rainfall",
"heat_extreme" ~ "Extreme Heat",
"cold_extreme" ~ "Extreme Cold"
),
levels = c("Extreme Heat", "Extreme Rainfall", "Extreme Cold")
)
) |>
select(year, event_label)
```
#### 5. Visualization Parameters
```{r}
#| label: params
#| include: true
#| warning: false
### |- plot aesthetics ----
# Get basic theme colors
colors <- get_theme_colors(
palette = list(
heat = "#D55E00",
cold = "#1D3557",
temp_warm = "#E69F00",
rain = "#0072B2",
sun = "#F0E442",
frost = "#56B4E9",
neutral_dark = "#2B2D42",
neutral_mid = "#8D99AE",
neutral_light = "#EDF2F4"
)
)
### |- titles and caption ----
title_text <- str_glue(
"The UK's Climate Is Warming — and Extremes Are Increasing"
)
subtitle_text <- str_glue(
"Summers are getting hotter and hard-freeze years are increasingly rare, while extreme-heat years cluster after ~1990 \n",
"signaling rising heat risk.\n"
)
caption_text <- create_social_caption(
tt_year = 2025,
tt_week = 42,
source_text = str_glue(
"Historical monthly data for meteorological stations, via data.gov.uk",
"<br>Metric = station means by year | Trends = LOESS (span 0.25) | Extremes = annual 95th percentile"
)
)
### |- fonts ----
setup_fonts()
fonts <- get_font_families()
### |- plot theme ----
# Start with base theme
base_theme <- create_base_theme(colors)
# Add weekly-specific theme elements
weekly_theme <- extend_weekly_theme(
base_theme,
theme(
# Text styling
plot.title = element_text(face = "bold", family = fonts$title, size = rel(1.4), color = colors$title, margin = margin(b = 10)),
plot.subtitle = element_text(face = "italic", family = fonts$subtitle, lineheight = 1.2, color = colors$subtitle, size = rel(0.9), margin = margin(b = 20)),
## Grid
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_line(color = "gray90", linewidth = 0.3),
# Axes
axis.title = element_text(size = rel(0.9), color = "gray30"),
axis.text = element_text(color = "gray30"),
axis.text.y = element_text(size = rel(0.95)),
axis.ticks = element_blank(),
# Facets
strip.background = element_rect(fill = "gray95", color = NA),
strip.text = element_text(
face = "bold",
color = "gray20",
size = rel(1),
margin = margin(t = 8, b = 8)
),
panel.spacing = unit(2, "lines"),
# Legend elements
legend.position = "plot",
legend.title = element_text(family = fonts$tsubtitle,
color = colors$text, size = rel(0.8), face = "bold"),
legend.text = element_text(family = fonts$tsubtitle,
color = colors$text, size = rel(0.7)),
legend.margin = margin(t = 15),
# Plot margin
plot.margin = margin(20, 20, 20, 20)
)
)
# Set theme
theme_set(weekly_theme)
```
#### 6. Plot
```{r}
#| label: plot
#| warning: false
### |- P1: trends plot ----
p1 <- ggplot(trends, aes(year, value)) +
geom_line(color = colors$palette$neutral_mid, linewidth = 0.4, alpha = 0.6) +
# Geoms
geom_smooth(aes(color = variable), method = "loess", linewidth = 1.8, se = TRUE, alpha = 0.15, span = 0.25) +
geom_point(
data = last_points, aes(year, value),
inherit.aes = FALSE, size = 2.2, color = "grey20"
) +
# Scales
scale_color_manual(
values = c(
"Maximum Temperature" = colors$palette$temp_warm,
"Monthly Rainfall" = colors$palette$rain,
"Monthly Sunshine" = colors$palette$sun,
"Air Frost Days" = colors$palette$frost
),
guide = "none"
) +
scale_x_continuous(
breaks = seq(1900, 2020, 40),
limits = c(1900, 2024)
) +
# Labs
labs(
title = "Long-term Trends",
subtitle = "Smoothed station means with underlying annual variability (1900–present)",
x = NULL, y = NULL
) +
# Facets
facet_wrap(~variable_label, scales = "free_y", ncol = 2) +
# Theme
theme(
strip.text = element_text(face = "bold", size = 12, color = colors$palette$neutral_dark, margin = margin(b = 8, t = 4)),
strip.background = element_rect(fill = colors$palette$neutral_light, color = NA),
panel.grid.major = element_line(color = colors$palette$neutral_light, linewidth = 0.4),
panel.grid.minor = element_blank(),
panel.spacing = unit(1.2, "lines")
)
### |- P2: timeline plot ----
p2 <- ggplot(extreme_events, aes(x = year, y = event_label, color = event_label)) +
# Annotate
annotate("rect",
xmin = 1990, xmax = 2022, ymin = -Inf, ymax = Inf,
fill = alpha(colors$palette$neutral_light, 0.35), color = NA
) +
# Geom
geom_vline(
xintercept = c(1990, 2003), linetype = c("dashed", "dotted"),
linewidth = c(0.5, 0.6), color = alpha(colors$palette$neutral_mid, 0.8)
) +
geom_point(
size = 4.2, alpha = 0.95, stroke = 0.4,
position = position_jitter(width = 0.2, height = 0.04, seed = 123)
) +
# Annotate
annotate("text",
x = 2006, y = "Extreme Heat", label = "Post-1990 clustering",
size = 3.2, color = colors$palette$neutral_mid, vjust = -3
) +
annotate("text",
x = 2003, y = "Extreme Heat", label = "2003 heatwave",
size = 3.0, color = colors$palette$neutral_mid, vjust = 3.6
) +
# Scales
scale_color_manual(
values = c(
"Extreme Heat" = colors$palette$heat,
"Extreme Rainfall" = alpha(colors$palette$rain, 0.5),
"Extreme Cold" = alpha(colors$palette$cold, 0.5)
),
guide = "none"
) +
scale_x_continuous(
breaks = seq(1900, 2020, 20),
expand = expansion(mult = c(0.02, 0.02)),
limits = c(1900, 2024)
) +
# Labs
labs(
title = "Extreme Weather Events",
subtitle = "Extreme-heat events surge after ~1990 — clear evidence of a warming climate",
x = NULL, y = NULL
) +
# Theme
theme(
panel.grid.major.y = element_line(color = alpha(colors$palette$neutral_light, 0.9), linewidth = 0.7),
panel.grid.major.x = element_line(color = alpha(colors$palette$neutral_light, 0.5), linewidth = 0.25),
panel.grid.minor = element_blank()
)
### |- Combined plot ----
combined_plots <- p1 / p2 +
plot_annotation(
title = title_text,
subtitle = subtitle_text,
caption = caption_text,
theme = theme(
plot.title = element_text(
size = rel(1.55),
family = fonts$title,
face = "bold",
color = colors$title,
lineheight = 1.1,
margin = margin(t = 5, b = 5)
),
plot.subtitle = element_text(
size = rel(0.85),
family = fonts$subtitle,
color = alpha(colors$subtitle, 0.9),
lineheight = 1.2,
margin = margin(t = 0, b = 0)
),
plot.caption = element_markdown(
size = rel(0.55),
family = fonts$caption,
color = colors$caption,
hjust = 0.5,
margin = margin(t = 10)
)
)
)
```
#### 7. Save
```{r}
#| label: save
#| warning: false
### |- plot image ----
save_plot_patchwork(
plot = combined_plots,
type = "tidytuesday",
year = 2025,
week = 42,
width = 10,
height = 12,
)
```
#### 8. Session Info
::: {.callout-tip collapse="true"}
##### Expand for Session Info
```{r, echo = FALSE}
#| eval: true
#| warning: false
sessionInfo()
```
:::
#### 9. GitHub Repository
::: {.callout-tip collapse="true"}
##### Expand for GitHub Repo
The complete code for this analysis is available in [`tt_2025_42.qmd`](https://github.com/poncest/personal-website/blob/master/data_visualizations/TidyTuesday/2025/tt_2025_42.qmd).
For the full repository, [click here](https://github.com/poncest/personal-website/).
:::
#### 10. References
::: {.callout-tip collapse="true"}
##### Expand for References
1. Data Sources:
- TidyTuesday 2025 Week 42: \[Historic UK Meteorological & Climate Data\](https://github.com/rfordatascience/tidytuesday/blob/main/data/2025/2025-10-21
:::
#### 11. Custom Functions Documentation
::: {.callout-note collapse="true"}
##### 📦 Custom Helper Functions
This analysis uses custom functions from my personal module library for efficiency and consistency across projects.
**Functions Used:**
- **`fonts.R`**: `setup_fonts()`, `get_font_families()` - Font management with showtext
- **`social_icons.R`**: `create_social_caption()` - Generates formatted social media captions
- **`image_utils.R`**: `save_plot()` - Consistent plot saving with naming conventions
- **`base_theme.R`**: `create_base_theme()`, `extend_weekly_theme()`, `get_theme_colors()` - Custom ggplot2 themes
**Why custom functions?**\
These utilities standardize theming, fonts, and output across all my data visualizations. The core analysis (data tidying and visualization logic) uses only standard tidyverse packages.
**Source Code:**\
View all custom functions → [GitHub: R/utils](https://github.com/poncest/personal-website/tree/master/R)
:::