Year of highest temperatures ever recorded by a country (https://twitter.com/matschnetzer/status/1602260127536799745)

heat_record.R

library(tidyverse)
library(rvest)
library(stringi)
library(janitor)
library(countrycode)
library(MetBrewer)
library(msthemes)
library(patchwork)

url <- "https://en.wikipedia.org/wiki/List_of_weather_records#Highest_temperatures_ever_recorded"

raw <- data.frame()
cont <- c("Afrika","Antarktis","Asien","Europa","Nordamerika","Ozeanien","Südamerika")

for (i in c(1,3:7)) {
tmp <-  url |> 
    read_html() |> 
    html_node(xpath = paste0('//*[@id="mw-content-text"]/div[1]/table[',i,']')) |> 
    html_table(header = TRUE) |> 
  mutate(continent = cont[i])
raw <- rbind(raw, tmp)
}

df <- raw |> clean_names() |> 
  mutate(country = stri_extract_first_regex(country_region, "^[^\\(]+"),
         year = as.numeric(stri_extract_last_regex(date, "\\d{4}")),
         temp = as.numeric(stri_extract_first_regex(temperature, "[:graph:]+(?= ?)"))) |> 
  select(country,year,temp,continent) |> 
  drop_na()
  
timeline <- df |> 
  ggplot(aes(y = continent, x = year, color = continent)) +
  geom_count(alpha = 0.5) +
  annotate("text", x = 1910, y = 5.5, label = "1905: Argentinien", 
           size = 2.5, family = "IBM Plex Sans", hjust = 0, color=met.brewer("Lakota")[[6]]) +
  geom_curve(x=1909, xend=1905, y=5.5, yend=5.8, curvature = -0.3, linewidth = 0.1,  color=met.brewer("Lakota")[[6]],
             arrow = arrow(ends = "last", type = "open", length = unit(0.05, "cm"))) +
  annotate("text", x = 2014, y = 3.5, label = "2019: Andorra, Belgien, Frankreich, Deutschland, Luxemburg, Niederlande", 
           size = 2.5, family = "IBM Plex Sans", hjust = 1, color=met.brewer("Lakota")[[3]]) +
  geom_curve(x=2015, xend=2019, y=3.5, yend=3.3, curvature = -0.2, linewidth = 0.1,  color=met.brewer("Lakota")[[3]],
             arrow = arrow(ends = "last", type = "open", length = unit(0.05, "cm"))) +
  annotate("text", x = 2011, y = 2.5, label = "2016: Kambodscha, Indien, Irak, Kuwait, Laos, Malediven, Thailand", 
           size = 2.5, family = "IBM Plex Sans", hjust = 1, color=met.brewer("Lakota")[[2]]) +
  geom_curve(x=2012, xend=2015.5, y=2.5, yend=2.3, curvature = -0.2, linewidth = 0.1,  color=met.brewer("Lakota")[[2]],
             arrow = arrow(ends = "last", type = "open", length = unit(0.05, "cm"))) +
  annotate("text", x = 2005, y = 1.5, label = "2010: Tschad, Nigeria, Sudan, Sambia", 
           size = 2.5, family = "IBM Plex Sans", hjust = 1, color=met.brewer("Lakota")[[1]]) +
  geom_curve(x=2006, xend=2010, y=1.5, yend=1.2, curvature = -0.3, linewidth = 0.1,  color=met.brewer("Lakota")[[1]],
             arrow = arrow(ends = "last", type = "open", length = unit(0.05, "cm"))) +
  geom_hline(aes(yintercept = continent, color = continent), linewidth = 0.4) +
  scale_x_continuous(breaks = seq(1900,2020,20)) +
  scale_color_manual(values = met.brewer("Lakota")) +
  scale_size_area(max_size = 6) +
  labs(x="", y="")

time <- df |> 
  ggplot(aes(x = year, fill=continent)) +
  geom_vline(xintercept = 2000, linewidth = 0.2, color = "grey30") +
  geom_bar(stat = "count", position = "stack") +
  annotate("text", x = 1942, y = 12, hjust = 0, size = 3, family = "IBM Plex Sans",
           label = "2/3 aller Hitzerekorde\n erfolgten nach 2000", color = "grey30") +
  geom_curve(x=2000, xend=1970, y=13, yend=13, curvature = 0.1, color = "grey30",
             linewidth = 0.2, arrow = arrow(ends = "last", type = "closed",
                                       length = unit(0.1, "cm"))) +
  scale_x_continuous(breaks = seq(1900,2020,20)) +
  scale_fill_manual(values = met.brewer("Lakota")) +
  labs(y = "Anzahl", x = "")

finplot <- timeline / time +
  plot_layout(heights = c(0.7, 0.3)) &
  plot_annotation(title = "Hitzerekorde häufen sich",
                  subtitle = "Jahr des jüngsten Temperaturrekordes in einzelnen Ländern",
                  caption = "Daten: Wikipedia. Grafik: @matschnetzer") &
  theme_ms(alttf = T) +
  theme(legend.position = "none",
        axis.text.x = element_text(angle = 30, hjust = 1))
        
ggsave(finplot, file = "temprecord.png", width = 8, height = 6, dpi =320)