United Kingdom prime ministers by @ellis2013nz

library(rvest)
library(tidyverse)
library(janitor)
library(slider) # for rolling sum
library(scales)
library(ggrepel)
library(kableExtra)

#-----------------Import and process data------------------------

url <- "https://en.wikipedia.org/wiki/List_of_prime_ministers_of_the_United_Kingdom"

page <- read_html(url)

# The main PM table is the first wikitable on the page
pm_table <- page |>
  html_element("table.wikitable") |>
  html_table(fill = TRUE) |> 
  clean_names() |> 
  select(
    pm = prime_minister_office_lifespan,
    start = term_of_office,
    end = term_of_office_2
  ) |> 
  # drop second line of column titles:
  slice(-1) |> 
  # find the PMs' names - everything up to the first [
  mutate(pm = str_extract(pm , ".*?\\["),
         pm = str_replace(pm, "\\[", ""),
        ) |> 
  # strip all the footnotes and stuff from the dates:
  mutate(across(everything(), ~ str_remove_all(.x, "\\[.*?\\]"))) |>  # remove [1] refs
  mutate(across(everything(), str_squish)) |> 
  mutate(start = as.Date(start, format = "%d %B %Y"),
         end = as.Date(end, format = "%d %B %Y"),
         end = if_else(is.na(end) & pm == "Keir Starmer",
                       as.Date("2026-07-10"),
                       end),
        duration = as.numeric(end - start),) |> 
  distinct() |> 
  mutate(pm = fct_reorder(pm, start, .desc = TRUE)) |> 
  group_by(pm) |> 
  mutate(last_end = max(end)) |> 
  ungroup()

#------------summary highlights----------

# prime ministers number of terms and total duration:
pm_summary <- pm_table |> 
  rename(`Prime minister` = pm) |> 
  group_by(`Prime minister`) |> 
  summarise(Terms = length(`Prime minister`),
            `Earliest start` = min(start),
            `Latest finish` = max(end),
            `Total duration` = sum(duration)) |> 
  arrange(desc(Terms), `Earliest start`) 

# Prime ministers with more than one term:
pm_summary |> 
  filter(Terms > 1) |> 
  kable() |> 
  kable_styling() 

# Longest serving prime ministers:
pm_summary |> 
  arrange(desc(`Total duration`)) |> 
  slice(1:10) |> 
  kable() |> 
  kable_styling() 

--------------Draw plots-------------
the_title <- "Prime ministers of the United Kingdom and its predecessors, 1721 to 2026"

pm_table |> 
  ggplot(aes(y = pm, yend = pm)) +
  geom_segment(aes(x = start, xend = end),
               linewidth = 2, colour = "steelblue") +
  geom_text(data = distinct(pm_table, pm, last_end),
            aes(label = pm, x = last_end + 500),
            size = 2, hjust = 0, colour = "grey50") +
  scale_x_date(
    breaks = seq(as.Date("1720-01-01"), as.Date("2035-01-01"), by = "20 years"),
    date_labels = "%Y",
    sec.axis = sec_axis(~.),
  ) + 
  labs(x = "Year",
       y = "",
       title = the_title) +
  theme(axis.text.y = element_blank(),
        panel.grid.major.y  = element_blank(),
        panel.border = element_blank(), 
        axis.ticks.y = element_blank())

pm_table |> 
  ggplot(aes(x = duration)) +
  geom_density(colour = "steelblue") +
  geom_rug(colour = "steelblue") +
  scale_x_continuous(label = comma) +
  labs(x = "Duration in days",
       title = the_title)

pm_table |> 
  ggplot(aes(x = start, y = duration)) +
  geom_smooth(method = "gam", colour = "white") +
  geom_point(colour = "steelblue") +
  geom_text_repel(data = filter(pm_table, duration < 120 | duration > 3000), 
                   aes(label = pm), size = 2.8, seed = 123) +
  scale_y_sqrt(breaks = c(0.5, 1, 1:4 * 2) * 1000, label = comma) +
  labs(x = "Starting date of premiership",
       y = "Duration in days",
       title = the_title,
      subtitle = "Durations shown are of individual periods in office, not lifetime totals.")

cumulative_pms <- pm_table |> 
  full_join(tibble(start = seq(from = min(pm_table$start), 
                               to = max(pm_table$end), 
                               by = "1 day"))) |> 
  arrange(start) |> 
  mutate(starting_pms = if_else(is.na(pm), 0 , 1),
         rolling_pms = slide_sum(starting_pms, before = 3653),
         # I'm not sure I've got this right yet, but the idea is that in any given day,
         # the number of PMs in thepast 10 years is however many started in those 10 years,
         # plus 1 PM that you came into the period with. The exception being the time
         # of the very first prime minister, for which time you only have the rolling sum
         # of PMs that started:
         rolling_pms = if_else(start < (pm_table[1, ]$start + 3654), 
                               rolling_pms, 
                               rolling_pms + 1))

# When was the peak number of PMs in the last decade:
arrange(cumulative_pms, desc(rolling_pms))


cumulative_pms |> 
  ggplot(aes(x = start, y = rolling_pms)) +
  geom_line(colour = "steelblue") +
  scale_y_continuous(breaks = 0:max(cumulative_pms$rolling_pms)) +
  labs(x = "",
       y = "Number of prime ministers in past 10 years",
       title = the_title,
       subtitle = "Peak prime ministers per decade was in the 1830s")