Extre Weather Attribution Studies

bar plot
climate
Published

August 12, 2025

Code
# TIDYTUESDAY WEEK 32
# EXTREME WEATHER ATTRIBUTION STUDIES 

# 1. SETUP

library(pacman)

pacman :: p_load(tidyverse, dplyr, ggtext, showtext, scales, patchwork)

attribution_studies <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-08-12/attribution_studies.csv')

# 2. DATA ANALYSIS AND TIDYING 

glimpse(attribution_studies$classification)

df <- attribution_studies %>%
  # Clean up classification categories 
  mutate(
    classification_clean = case_when(
      str_detect(tolower(classification), "more severe|more likely") ~ "More severe/likely",
      str_detect(tolower(classification), "no discernible|no influence") ~ "No discernible human influence",
      str_detect(tolower(classification), "insufficient|inconclusive") ~ "Insufficient data",
      str_detect(tolower(classification), "decrease|less severe|less likely") ~ "Less severe/likely",
      TRUE ~ classification  # Keep original if no match
    ),
    event_type = case_when(
      event_type %in% c("Heat", "Drought", "Sunshine", "Wildfire") ~ "Heat & drought events",
      event_type %in% c("Storm", "Rain & flooding", "River flow") ~ "Storms & flooding",
      event_type %in% c("Impact", "Compound", "Atmosphere") ~ "Other events",
      event_type == "Cold, snow & ice" ~ "Cold & snow events",
      event_type == "Oceans" ~ "Ocean events",
      TRUE ~ event_type
    ),
    event_type = factor(event_type, levels = rev(c(
      "Heat & drought events",
      "Storms & flooding events", 
      "Cold & snow events",
      "Ocean events",
      "Other events"
    )))
  ) %>%
  # Filter out any rows with missing data
  filter(!is.na(classification_clean), !is.na(event_type)) %>%
  # Count studies by event type and classification
  count(event_type, classification_clean, name = "n_studies")


# calculate totals for ordering event types frequency 
events <- df %>% 
  group_by(event_type) %>%
  summarise(total_studies = sum(n_studies)) %>%
  arrange(desc(total_studies))

# 3. AESTHETICS 

# load font 
font_add_google("Source Sans Pro", "source")
showtext_auto()
showtext_opts(dpi = 300)

# define colors 
classification_colors <- c(
  "More severe/likely" = "#d73027",                 # Red for increased risk
  "No discernible human influence" = "gray50",      # Gray for no influence
  "Insufficient data" = "#fee08b",                  # Yellow for uncertain
  "Less severe/likely" = "#74add1"                  # Light blue for decreased risk
)

# 4. PLOT 

# create final df with percentages 

plot <- df %>% 
  group_by(event_type) %>%
  mutate(
    pct_studies = n_studies / sum(n_studies) * 100,
    total_for_event = sum(n_studies)
  ) %>%
  ungroup()

ggplot(plot, aes(x = event_type, y = pct_studies, 
                 fill = classification_clean)) +
  geom_col(position = "stack", width = 0.7, color = "white", size = 0.2) +
  scale_fill_manual(
    name = NULL,
    values = classification_colors,
    guide = guide_legend(
      reverse = TRUE,
      nrow = 2,
      byrow = TRUE
    )
  ) +
  coord_flip() +
  scale_y_continuous(
    labels = function(x) paste0(x, "%"),
    expand = c(0, 0),
    breaks = seq(0, 100, 25)
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "source"),
    axis.text.x = element_text(size = 10, color = "grey30"),
    axis.text.y = element_text(size = 10, color = "grey20"),
    axis.title.x = element_text(size = 11, face = "bold", margin = margin(t = 10)),
    axis.title.y = element_text(size = 11, face = "bold", margin = margin(r = 10)),
    legend.text = element_text(size = 9),
    plot.title = element_text(size = 15, face = "bold", margin = margin(b = 5)),
    plot.subtitle = element_text(size = 11, color = "grey40", margin = margin(b = 15)),
    plot.caption = element_text(size = 8, color = "grey50", hjust = 0),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_line(color = "grey90", linewidth  = 0.3),
    legend.position = "bottom",
    legend.margin = margin(t = 15),
    plot.margin = margin(15, 15, 10, 15)
  ) +
  labs(
    title = "Climate Change Attribution by Event Type",
    subtitle = "Proportion of attribution findings within each event category",
    x = NULL,  
    y = "Percentage of Studies",
    caption = "Data: Carbon Brief | anabodevan.github.io"
  )

ggsave(
  filename = file.path("tidytuesday", "2025", "2025-08-12", paste0("20250812", ".png")),
  height = 7,
  width = 8,
  bg = "white",
  units = "in",
  dpi = 300
)