Anteil geimpfte Bevölkerung in Europa (https://twitter.com/matschnetzer/status/1439857686728912898?s=20)

vaccination.R

library(tidyverse)
library(ggbump)
library(msthemes)
library(rnaturalearth)
library(rnaturalearthdata)
library(lubridate)
library(sf)

covid <- read_csv("owid-covid-data.csv") %>% filter(continent == "Europe") %>%
  group_by(iso_code) %>% drop_na(people_vaccinated_per_hundred) %>% 
  arrange(desc(date)) %>% slice(1) %>%
  filter(!iso_code %in% c("RUS","AND","FRO","GGY","GIB","IMN","JEY","LIE","MCO","OWID_KOS","SMR"))

europe <- ne_countries(scale = "medium", returnclass = "sf") %>%
  filter(continent == "Europe", !name %in% c("Russia")) %>%
  st_crop(xmin = -24, xmax = 41, ymin = 32, ymax = 70) 

sdf <- europe %>%
  left_join(covid %>% select(date, share=people_vaccinated_per_hundred, iso_code), by = c("iso_a3" = "iso_code")) %>%
  drop_na(share)

ranking <- st_geometry(sdf) %>%
  st_point_on_surface() %>% 
  st_coordinates() %>% 
  as_tibble() %>%
  bind_cols(tibble(country = sdf$name,
                   vaccrank = scales::rescale(rank(sdf$share, ties.method = "first"), 
                                              to = c(38,70)),
                   rankgroup = ifelse(rank(sdf$share) > nrow(sdf)/2, 1, 2),
                   rankpos = ifelse(rankgroup == 1, vaccrank-10, vaccrank+5),
                   sigend = ifelse(rankgroup == 1, -40, 65),
                   barstart = ifelse(rankgroup == 1, sigend - 2, sigend + 2),
                   lengthbar = scales::rescale(sdf$share, to = c(0,18)),
                   vaccrate = ifelse(rankgroup == 1, barstart -2 -lengthbar, 
                                     barstart +2 + lengthbar),
                   label = paste0(round(sdf$share,0),"%"),
                   labpos = ifelse(rankgroup == 1, vaccrate - .4, vaccrate + .4),
                   ctypos = ifelse(rankgroup == 1, barstart + .4, barstart - .4)
            ))

sdf <- sdf %>% 
  bind_cols(ranking %>% select(vaccrank))


ggplot() + 
  geom_sf(data = sdf, aes(fill = vaccrank, alpha = .3), size = .1, color = "gray17") +
  geom_sigmoid(data = ranking, 
               aes(x = X, y = Y, xend = sigend, yend = rankpos, group = country, color = vaccrank), 
               alpha = .7, smooth = 10, size = 0.3) +
  geom_point(data = ranking, 
             aes(x = X, y = Y, color = vaccrank), size = 0.5) +
  geom_segment(data = ranking, 
               aes(x = barstart, y = rankpos, xend = vaccrate, yend = rankpos, color = vaccrank), alpha = .7, size = 1) +
  geom_label(data = ranking, aes(x = ctypos, y = rankpos, label = country, color = vaccrank, hjust = ifelse(rankgroup == 1, 0, 1)), 
             size = 1.9, fill = "white", label.size = NA, label.padding = unit(0.03, "lines"), 
             label.r = unit(0,"lines"), family = "Raleway") +
  geom_text(data = ranking, aes(x = labpos, y = rankpos, label = label, color = vaccrank, hjust = ifelse(rankgroup == 1, 1, 0)), 
            size = 1.6) +
  scale_y_continuous() +
  scale_fill_gradientn(colours = c("darkred", "forestgreen")) +
  scale_color_gradientn(colours = c("darkred", "forestgreen")) +
  labs(x = NULL, y = NULL,
       title = "Ost-West-Gefälle der Covid-Impfungen",
       subtitle = "Anteil der Bevölkerung mit zumindest einer Impfdosis",
       caption = "Daten: Our World in Data. Grafik: @matschnetzer") +
  theme_ms(grid = F, alttf = T) +
  theme(axis.text = element_blank(),
        legend.position = "none",
        plot.title = element_text(size = 12),
        plot.subtitle = element_text(size = 10),
        plot.caption = element_text(size = 6))
ggsave("vaccinations.png", dpi = 320, width = 8, height = 4)