Skip to content

Instantly share code, notes, and snippets.

@mschnetzer
Last active July 25, 2023 21:08
Show Gist options
  • Save mschnetzer/818545b1e9da7a5b6deb05570ff6c529 to your computer and use it in GitHub Desktop.
Save mschnetzer/818545b1e9da7a5b6deb05570ff6c529 to your computer and use it in GitHub Desktop.
Ausdehnung des arktischen Eises im Jahresverlauf
library(tidyverse)
library(gghighlight)
library(ggtext)
# Data download: https://ads.nipr.ac.jp/vishop/#/extent
raw <- read.csv("VISHOP_EXTENT_GRAPH.csv")
dat <- raw |>
select(month, day = date, X1989:X2023) |>
pivot_longer(cols = X1989:X2023, names_to = "year", values_to = "ice",
names_prefix = "X", names_transform = list(year = as.numeric)) |>
mutate(date = make_date(year, month, day),
yday = yday(date)) |>
drop_na()
means <- dat |> filter(year %in% 1990:2020) |>
summarise(ice = mean(ice), .by = yday)
dat |>
ggplot(aes(x = yday, y = ice, group = year)) +
geom_line(color = "cadetblue", linewidth = 0.8) +
gghighlight(year == 2023, use_direct_label = F,
unhighlighted_params = list(color = "gray85", linewidth = 0.15)) +
geom_line(data = means, aes(x = yday, y = ice), color = "gray40", inherit.aes = F, linewidth = 0.2, linetype = "longdash") +
geom_point(data = dat |> slice_min(ice), color = "gray50", size = 0.8) +
geom_point(data = dat |> slice_max(ice), color = "gray50", size = 0.8) +
geom_point(data = dat |> slice_max(date), color = "cadetblue") +
scale_x_continuous(breaks = yday(paste0("2000-",seq(1,12,3),"-01")),
labels = month(paste0("2000-",seq(1,12,3),"-01"), label = T, abbr = F, locale = "de_AT"),
expand = c(0,0)) +
scale_y_continuous(limits = c(0, 19e6),
breaks = c(4e6, 10e6, 17e6),
labels = c("Fläche EU-27<br><span style='font-size:8pt;color:gray40;'>[4 Mio. km2]</span>",
"Fläche Kanada<br><span style='font-size:8pt;color:gray40;'>[10 Mio. km2]</span>",
"Fläche Russland<br><span style='font-size:8pt;color:gray40;'>[17 Mio. km2]</span>")) +
annotate("label", x = 260, y = 1.4e6, hjust = 0.5, size = 2.5, label.size = 0,
family = "Roboto Condensed", color = "gray40", lineheight = 1,
label = str_wrap("Die geringste Ausdehnung des Meereises wurde im September 2012 verzeichnet. Die Eisfläche war nur noch etwa halb so groß wie in den 1980er-Jahren.", 50)) +
annotate("label", x = 75, y = 17.4e6, hjust = 0.5, size = 2.5, label.size = 0,
family = "Roboto Condensed", color = "gray40", lineheight = 1,
label = str_wrap("Die Eisausdehnung erreicht im März ihr Jahresmaximum. 1990 lag der Höchstwert bei 15,7 Mio. km2, 2023 noch bei 14,1 Mio. km2.", 45)) +
annotate("label", x = 190, y = 7.5e6, hjust = 1, vjust = 1, size = 2.5, label.size = 0,
family = "Roboto Condensed", color = "cadetblue", lineheight = 1,
label = str_wrap("Im bisherigen Jahr 2023 ist die Eisfläche deutlich kleiner als im langjährigen Schnitt. Das Eis in der Arktis schmilzt schneller, als bisherige Prognosen nahelegen.", 60)) +
annotate("label", x = 300, y = 12.5e6, hjust = 0.5, size = 2.5, label.size = 0, lineheight = 1,
family = "Roboto Condensed", color = "gray40", label = "Durchschnitt\n1990-2020") +
geom_segment(aes(x = 300, y = 11.6e6, xend = 300, yend = 8.377e6), linewidth = 0.15, color = "gray40") +
labs(x = NULL, y = NULL,
title = toupper("Eisschmelze"),
subtitle = "Arktisches Eis im Jahresverlauf, 1989-2023<br><span style='font-size:7pt;'>Daten: VISHOP ⋅ Grafik: @matschnetzer</span>") +
theme_minimal(base_family = "Roboto Condensed", base_size = 11) +
theme(panel.grid.minor = element_blank(),
plot.title = element_text(color = "cadetblue", size = 22, family = "Raleway", hjust = 0.5),
plot.subtitle = element_markdown(hjust = 0.5, color = "gray40", family = "Roboto Condensed",
margin = margin(b = 1, unit = "lines"), lineheight = 1.2),
plot.title.position = "plot",
panel.grid.major = element_line(linewidth = 0.2),
axis.text.y = element_markdown(hjust = 0.5, vjust = 0.5, lineheight = 1.2),
axis.text.x = element_text(hjust = 0))
ggsave("arctic_ice.png", width = 8, height = 4.3, dpi = 320, bg = "white")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment