---
title: "A Portrait of Extinction: profiling the world's lost species with redlist"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{A Portrait of Extinction}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  message = FALSE,
  warning = FALSE,
  fig.align = "center"
)

library(dplyr)
library(ggplot2)
library(scales)
library(kableExtra)

# A sober palette for a sober subject
ember <- "#B23A2E"   # loss, highlight
charcoal <- "#2B2B2B"  # text, structure
ash <- "#9A9A9A"   # secondary
sand <- "#D9C7B8"   # neutral fill
slate <- "#4C6472"   # cool accent

theme_extinct <- function(base_size = 14) {
  theme_minimal(base_size = base_size) +
    theme(
      plot.title = element_text(face = "bold", colour = charcoal, size = rel(1.15)),
      plot.subtitle = element_text(colour = ash, size = rel(0.95), margin = margin(b = 10)),
      plot.caption  = element_text(colour = ash, size = rel(0.75), hjust = 0),
      axis.title = element_text(colour = charcoal),
      axis.text = element_text(colour = charcoal),
      panel.grid.minor = element_blank(),
      panel.grid.major = element_line(colour = "grey90"),
      legend.position = "top",
      plot.margin = margin(12, 16, 12, 12)
    )
}
theme_set(theme_extinct())

# Data
ex <- readRDS("data/extinct_data_sis.rds")
```

## Why look back?

The IUCN Red List is best known for warning us about species that *might* disappear.
This article turns the lens the other way, toward the species that already have.
The category **Extinct (EX)** is reserved for taxa for which, in the words of the
IUCN, there is no reasonable doubt that the last individual has died. It is the one
label on the Red List that can never improve.

Reading the Extinct list is not a morbid exercise. Each name is a data point in the
larger story of how, when, and where biodiversity has been lost, and the patterns
that emerge point straight at the places and the kinds of life that remain most
fragile today. Everything below is built with two functions from the `redlist`
package. You need an IUCN API key (the [Get Data article](https://stangandaho.github.io/redlist/articles/get_data.html#set-up-an-api-key)
sets one up in a minute)

## Getting the data

The Extinct catalogue is one function call away. The `code = "EX"` argument selects
the Extinct category, and `page = NA` tells `redlist` to walk through every page of
results automatically.

```{r query, eval = FALSE}
library(redlist)
library(dplyr)

# 1. Retrieve every assessment currently classified as Extinct
extinct <- rl_red_list_categories(code = "EX", page = NA)

# Save 
saveRDS(extinct, "data/extinct_data.rds")
```

This returns one row per *assessment*. A species can carry several over the years
(older versions and regional evaluations alongside its current global listing), so
I keep the most recent listing of each taxon, identified by its **SIS id** (the
IUCN's stable species identifier).

```{r ids, eval = FALSE}
# 2. The species I want: the latest listing of each taxon
ids <- unique(extinct$sis_taxon_id[extinct$latest == TRUE])
```

The category endpoint does not carry taxonomy, so on its own it cannot tell a bird
from a snail. To profile extinction across the tree of life I enrich each species
with `rl_sis()`, which looks a taxon up by its SIS id and returns its full
classification (kingdom, class, family and more). Because `rl_sis()` also returns
every assessment of a taxon, I keep the most recent one.

```{r enrich, eval = FALSE}
# 3. Enrich each species with its taxonomy
sis_data <- tibble()
for (i in seq_along(ids)) {

  # System sleep set to 1s to avoid the API call overload
  Sys.sleep(1)

  # Show simple progress status
  cat(paste0("\f", i, "/", length(ids), " (", round(i * 100 / length(ids), 2), "%)", "\r"))

  # Red List taxa by SIS ID
  one <- rl_sis(ids[i]) %>%
    slice_max(as.numeric(year_published), n = 1, with_ties = FALSE)

  # Bind every single request to one data set in sis_data
  sis_data <- bind_rows(sis_data, one)
}

# Save 
saveRDS(sis_data, "data/extinct_data_sis.rds")
```

That loop makes one request per species, so it takes approximately `r round(nrow(ex)/60, 2)` minutes.

```{r load-data-real, include = FALSE}
extinct_raw <- readRDS("data/extinct_data.rds")
ex <- readRDS("data/extinct_data_sis.rds")
```

```{r tidy}
ex <- ex %>%
  mutate(
    year_published = as.integer(year_published),
    genus  = taxon_genus_name,
    # Fold taxonomic class into reader-friendly major groups
    group = case_when(
      taxon_class_name == "MAMMALIA" ~ "Mammals",
      taxon_class_name == "AVES" ~ "Birds",
      taxon_class_name == "AMPHIBIA" ~ "Amphibians",
      taxon_class_name == "REPTILIA" ~ "Reptiles",
      taxon_class_name %in% c("ACTINOPTERYGII", "CHONDRICHTHYES") ~ "Fishes",
      taxon_class_name == "GASTROPODA" ~ "Snails & slugs",
      taxon_class_name == "BIVALVIA" ~ "Mussels & clams",
      taxon_class_name == "INSECTA" ~ "Insects",
      taxon_class_name %in% c("ARACHNIDA", "MALACOSTRACA", "DIPLOPODA",
                              "MAXILLOPODA", "HEXANAUPLIA", "OSTRACODA") ~ "Other arthropods",
      taxon_class_name %in% c("MAGNOLIOPSIDA", "LILIOPSIDA") ~ "Flowering plants",
      taxon_class_name %in% c("BRYOPSIDA", "POLYPODIOPSIDA") ~ "Ferns & mosses",
      taxon_kingdom_name == "PLANTAE" ~ "Other plants",
      TRUE ~ "Other invertebrates"
    ),
    kingdom = tools::toTitleCase(tolower(taxon_kingdom_name)),
    branch = case_when(
      group %in% c("Mammals", "Birds", "Amphibians", "Reptiles", "Fishes") ~ "Vertebrates",
      taxon_kingdom_name == "PLANTAE" ~ "Plants",
      TRUE ~ "Invertebrates"
    )
  )

glimpse(ex[, c("taxon_scientific_name", "kingdom", "taxon_class_name",
               "group", "year_published")])
```

```{r headline-numbers}
n_records <- nrow(extinct_raw)
n_species <- nrow(ex)
n_genera <- n_distinct(ex$genus)
n_family <- n_distinct(ex$taxon_family_name)
n_animals <- sum(ex$kingdom == "Animalia")
n_plants <- sum(ex$kingdom == "Plantae")
n_mollusc <- sum(ex$group %in% c("Snails & slugs", "Mussels & clams"))
yr_min <- min(ex$year_published)
yr_max <- max(ex$year_published)
since_2020 <- sum(ex$year_published >= 2020)
```

Starting from **`r comma(n_records)` assessment records**, keeping the latest listing
of each taxon and enriching it leaves **`r n_species` species** confirmed Extinct,
spanning **`r n_genera` genera** in **`r n_family` families**. Their current listings
were published between **`r yr_min`** and **`r yr_max`**.

## The scale of loss at a glance

```{r overview-table}
dplyr::tibble(
  Measure = c(
    "Assessment records returned",
    "Distinct Extinct species (latest listing)",
    "Genera represented",
    "Families represented",
    "Animals / Plants",
    "Species listed since 2020",
    "Publication span of current listings"
  ),
  Value = c(
    comma(n_records),
    comma(n_species),
    comma(n_genera),
    comma(n_family),
    paste0(comma(n_animals), " / ", comma(n_plants)),
    comma(since_2020),
    paste0(yr_min, " to ", yr_max)
  )
) %>%
  kable(align = c("l", "r"), caption = "The Extinct record in numbers") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
```

Every one of these `r n_species` species is a **confirmed** extinction, gone
everywhere: all but two carry a global-scope listing. Confirmed loss is a high bar,
so this catalogue is best read as a conservative floor, not a full accounting of
what has vanished.

## Extinction across the tree of life

Extinction does not fall evenly across life. Split by kingdom, animals outnumber
plants by more than five to one (`r comma(n_animals)` against `r comma(n_plants)`),
but the broad animal-versus-plant contrast hides the real structure. The chart below
sorts the catalogue into major groups.

```{r groups, fig.width = 8, fig.height = 5.5, fig.alt = "Number of Extinct species by major taxonomic group"}
group_tbl <- ex %>%
  count(group, branch, name = "species") %>%
  mutate(group = reorder(group, species))

ggplot(group_tbl, aes(species, group, colour = branch)) +
  geom_segment(aes(x = 0, xend = species, y = group, yend = group),
               colour = ash, linewidth = 0.6) +
  geom_point(size = 4) +
  geom_text(aes(label = species), colour = charcoal, size = 2.9, hjust = -0.6) +
  scale_colour_manual(values = c(Vertebrates = slate, Invertebrates = ember,
                                 Plants = "#4E7A51"), name = NULL) +
  scale_x_continuous(expand = expansion(mult = c(0, 0.10))) +
  labs(
    title = "Which groups have lost the most species",
    x = "Extinct species", y = NULL
  ) +
  theme_extinct() +
  theme(panel.grid.major.y = element_blank())
```

The single largest share is not the charismatic vertebrates but the
**molluscs**: snails, slugs, mussels and clams together account for
**`r comma(n_mollusc)` species**, about `r round(100 * n_mollusc / n_species)`% of
the entire catalogue. Land snails alone (`r sum(ex$group == "Snails & slugs")`) exceed
every other group. Birds (`r sum(ex$group == "Birds")`) and flowering plants
(`r sum(ex$group == "Flowering plants")`) come next, with mammals and fishes tied
close behind. The pattern is a familiar one to conservation biologists: small,
overlooked, narrow-range invertebrates dominate the toll, even though mammals and
birds dominate public attention.

```{r group-table}
ex %>%
  group_by(Group = group) %>%
  summarise(
    Species = n(),
    `Since 2020` = sum(year_published >= 2020),
    Example = first(sort(taxon_scientific_name)),
    .groups = "drop"
  ) %>%
  arrange(desc(Species)) %>%
  mutate(Share = percent(Species / sum(Species), accuracy = 0.1)) %>%
  select(Group, Species, Share, `Since 2020`, `Example species` = Example) %>%
  kable(align = c("l", "r", "r", "r", "l"),
        caption = "Confirmed extinctions by major group") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
```

The `Since 2020` column reveals how uneven the *documentation* of loss is. Almost
every extinct **bird** on the list (`r sum(ex$group == "Birds" & ex$year_published >= 2020)`
of `r sum(ex$group == "Birds")`) was formalised in the 2020s, the fruit of a recent
systematic review, while the **mussels and clams** were catalogued in an earlier
wave and none appear since 2020. These are pulses of assessment effort, not sudden
changes in the rate of extinction itself.

## The tempo of documented loss

The chart below counts species by the year their current Extinct listing was
published. It is worth stressing that this is the year of assessment, not the year
the animal or plant actually died. Many species here were lost decades or centuries
ago and formalised on the Red List much later.

```{r timeline, fig.alt = "Number of species newly listed as Extinct per publication year", fig.width=8, fig.height=4}
per_year <- ex %>% count(year_published, name = "species")

ggplot(per_year, aes(year_published, species)) +
  geom_area(fill = ember, alpha = 0.12) +
  geom_line(colour = ember, linewidth = 0.9) +
  geom_point(colour = ember, size = 1.6) +
  scale_x_continuous(breaks = pretty_breaks(8)) +
  labs(
    title = "When the world's Extinct species entered the Red List",
    subtitle = "Species counted by the publication year of their current Extinct assessment",
    x = "Publication year", y = "Species listed"
  ) +
  theme_extinct()
```

The record is uneven, with clear pulses of activity that track waves of systematic
reassessment rather than sudden bursts of extinction. The signal is unmistakably
recent all the same: **`r since_2020` species**, roughly
`r round(100 * since_2020 / n_species)`% of the whole catalogue, received their
current Extinct listing in `r 2020` or later. The accumulation is easier to feel as a
running total.

```{r cumulative, fig.alt = "Cumulative number of species listed as Extinct over time", fig.width=8, fig.height=4}
cumulative <- per_year %>%
  arrange(year_published) %>%
  mutate(cumulative = cumsum(species))

ggplot(cumulative, aes(year_published, cumulative)) +
  geom_area(fill = charcoal, alpha = 0.08) +
  geom_line(colour = charcoal, linewidth = 1) +
  scale_x_continuous(breaks = pretty_breaks(8)) +
  scale_y_continuous(labels = comma) +
  labs(
    title = "The rising tally of confirmed extinctions on the Red List",
    subtitle = "Cumulative species carrying a current Extinct listing",
    x = "Publication year", y = "Cumulative species"
  ) +
  theme_extinct()
```

Splitting each decade between animals and plants shows the same rhythm playing out in
both kingdoms.

```{r decade-table}
ex %>%
  mutate(decade = paste0(floor(year_published / 10) * 10, "s")) %>%
  group_by(Decade = decade) %>%
  summarise(
    Animals = sum(kingdom == "Animalia"),
    Plants  = sum(kingdom == "Plantae"),
    Total   = n(),
    .groups = "drop"
  ) %>%
  kable(align = c("l", "r", "r", "r"),
        caption = "Extinct listings by publication decade and kingdom") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
```

## The hardest-hit genera

Zooming from groups down to genera sharpens the picture. A handful of genera recur
again and again, and each is a well known tragedy of modern conservation.

```{r genera, fig.width = 8, fig.height = 5.5, fig.alt = "Genera with the most Extinct species"}
top_genera <- ex %>%
  count(genus, group, name = "species") %>%
  slice_max(species, n = 12) %>%
  mutate(genus = reorder(genus, species))

ggplot(top_genera, aes(species, genus, fill = group)) +
  geom_col(width = 0.7) +
  geom_text(aes(label = species), hjust = -0.3, size = 3, colour = charcoal) +
  scale_x_continuous(expand = expansion(mult = c(0, 0.10))) +
  scale_fill_manual(values = c(
    "Snails & slugs" = ember, "Fishes" = slate, "Amphibians" = "#7A5C99",
    "Flowering plants" = "#4E7A51", "Mussels & clams" = "#C9862B"
  ), name = NULL) +
  labs(
    title = "The genera that lost the most species",
    x = "Extinct species", y = NULL
  ) +
  theme_extinct() +
  theme(panel.grid.major.y = element_blank())
```

The leading genera map the modern extinction crisis onto real places. *Partula*,
*Achatinella*, *Amastra* and *Carelia* are Pacific and Hawaiian land snails,
decimated by habitat clearance and by introduced predatory snails. *Barbodes* is a
flock of small cyprinid fishes once endemic to a single Philippine lake, lost after
invasive species arrived. *Pseudophilautus* gathers the shrub frogs of Sri Lanka,
many known only from old museum specimens. *Cyanea* are Hawaiian lobelioid plants,
*Coregonus* the whitefishes of European lakes, and *Epioblasma* and *Pleurobema* are
freshwater mussels of North American rivers dammed and dredged across the twentieth
century.

Two themes bind them: **islands and fresh water**. Isolated island biotas and
confined river systems concentrate narrow-range endemics that vanish the moment their
single home is disturbed.

```{r genera-table}
ex %>%
  count(genus, Group = group, name = "Species") %>%
  slice_max(Species, n = 10, with_ties = FALSE) %>%
  left_join(
    ex %>% group_by(genus) %>%
      summarise(Example = first(sort(taxon_scientific_name)), .groups = "drop"),
    by = "genus"
  ) %>%
  rename(Genus = genus) %>%
  select(Genus, Group, Species, `Example species` = Example) %>%
  kable(align = c("l", "l", "r", "l"),
        caption = "The ten hardest-hit genera in the Extinct catalogue") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
```

The long tail matters as much as the peaks. Of the `r n_genera` genera in the
catalogue, `r sum(table(ex$genus) == 1)` contain a single Extinct species. Loss is
overwhelmingly a story of scattered, one-off disappearances rather than a few
collapsing dynasties, which makes it that much harder to see and to prevent.

## The most recent names

Extinction is not a closed chapter of history. The species below received their
current Extinct listing most recently, a reminder that the catalogue is still growing
in our own time.

```{r recent-table}
ex %>%
  filter(year_published >= 2024) %>%
  arrange(desc(year_published), taxon_scientific_name) %>%
  transmute(
    Species = paste0("*", taxon_scientific_name, "*"),
    `Common name` = ifelse(is.na(taxon_common_names_name), " _ ", taxon_common_names_name),
    Group = group,
    Listed = year_published
  ) %>%
  head(15) %>%
  kable(align = c("l", "l", "l", "r"),
        caption = "A selection of the most recently published Extinct listings") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
```