Motivations

The original plot created by The Economist and you can see here. R can be used for recreating this plot as follow:

R codes

R codes for the plot:

# Clear workspace: 
rm(list = ls())

# Import data: 

library(tidyverse)
aviation <- read_csv("https://raw.githubusercontent.com/onlyphantom/safeskies/master/aviation.csv")

# Rename for columns: 

old_names <- names(aviation)
names(aviation) <- str_replace_all(old_names, " ", "_")

# Prepare data for ploting: 

my_levels <- c("bombing", "hijacking", "accident")

avi_long <- aviation %>% 
  select(Year, contains("Casualties")) %>% 
  gather(variable, value, -Year) %>% 
  filter(Year <= 2012) %>% 
  mutate(variable = case_when(str_detect(variable, "Airliner") ~ "accident", 
                              str_detect(variable, "Bombing") ~ "bombing", 
                              TRUE ~ "hijacking")) %>% 
  mutate(variable = factor(variable, levels = my_levels))


aviation %>% 
  filter(Year <= 2012) %>% 
  select(Year, n_pass = Worldwide_passengers_carried) %>% 
  mutate(value = n_pass / 1000000, variable = "line") %>% 
  mutate(label_x = as.character(Year)) %>% 
  mutate(label_x = case_when(!label_x %in% c("1970", "2000") & Year %% 2 == 0 ~ str_sub(label_x, 3, 4), 
                             !label_x %in% c("1970", "2000") & Year %% 2 != 0 ~ "", 
                             TRUE ~ label_x)) -> df_pass

label_x <- df_pass %>% 
  arrange(Year) %>% 
  pull(label_x)


# Make a draft plot: 

bar_colors <- c("#ef4623", "#772210", "#eea083")
line_color <- "#00a1ce"
my_font <- "Ubuntu Condensed"

theme_set(theme_minimal())

ggplot() + 
  annotate("curve", curvature = 0, x = 1970 - 1, xend = 2012 + 1, y = seq(0, 3000, 500), yend = seq(0, 3000, 500), 
           color = "grey80", size = 0.5) + 
  geom_col(data = avi_long, aes(Year, value, fill = variable), width = 0.6) + 
  guides(fill = guide_legend(reverse = TRUE)) + 
  scale_fill_manual(values = bar_colors, name = "Casualties* due to:") + 
  theme(legend.position = c(0.24, 0.99), legend.direction = "horizontal") + 
  theme(legend.text = element_text(size = 11, face = "italic", color = bar_colors[2], family = my_font)) + 
  theme(legend.title = element_text(size = 11, face = "bold.italic", color = bar_colors[2], family = my_font)) + 
  theme(legend.key.width = unit(0.9, "cm")) + 
  theme(legend.key.height = unit(0.0, "cm")) + 
  geom_line(data = df_pass, aes(Year, value), color = line_color, size = 1.5) + 
  annotate("curve", curvature = 0, x = 1970 - 1, xend = 2012 + 1, y = 0, yend = 0, color = "grey50", size = 0.7) + 
  theme(panel.grid = element_blank()) + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.title.y = element_blank()) + 
  theme(axis.title.x = element_blank()) + 
  theme(plot.margin = unit(rep(1, 4), "cm")) + 
  scale_x_continuous(breaks = seq(1970, 2012, 1), labels = label_x) + 
  scale_y_continuous(limits = c(0, 3100)) + 
  labs(title = "Aircraft Safety", subtitle = "Worldwide", caption = "Source: World Bank; Aviation Safety Network") + 
  theme(axis.text.x = element_text(color = "grey20", vjust = 8, family = my_font, size = 12)) +
  theme(plot.title = element_text(vjust = 3, hjust = 0, family = my_font, size = 16, face = "bold", color = "grey20")) + 
  theme(plot.subtitle = element_text(vjust = 3, hjust = 0, family = my_font, size = 12, color = "grey30")) + 
  theme(plot.caption = element_text(family = my_font, size = 10, color = "grey20")) + 
  annotate("text", x = 2012 + 1, y = seq(0, 3000, 500), label = c("0", "0.5", "1.0", "1.5", "2.0", "2.5", "3.0"), 
           hjust = -0.25, vjust = 0.4,  color = line_color, size = 4.5, family = my_font) + 
  annotate("text", x = 1970 - 1, y = seq(0, 3000, 500), label = seq(0, 3000, 500), 
           hjust = 1.3, vjust = 0.4, color = bar_colors[2], size = 4.5, family = my_font) + 
  geom_text(data = data.frame(Year = 2009, value = 3070), aes(Year, value, label = "Aircraft passengers carried, bn"), 
            color = line_color, size = 4.1, vjust = -1.5, family = my_font, fontface = "italic")


library(grid)
grid.rect(x = 0.015, y = 0.93, hjust = 1, vjust = 0, gp = gpar(fill = "#e5001c", lwd = 0))  
grid.rect(x = 1, y = 1 - 0.005, hjust = 1, vjust = 0,  gp = gpar(fill = "#e5001c", lwd = 0))
LS0tDQp0aXRsZTogJ0R1YWwgeS1heGlzIHdpdGggZ2dwbG90MjogU2FmZSBTa2llcycNCmF1dGhvcjogJ0F1dGhvcjogTmd1eWVuIENoaSBEdW5nJw0Kc3VidGl0bGU6ICJEYWlseSBHcmFwaCBTZXJpZXMiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6IA0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCiAgICAjIGNvZGVfZm9sZGluZzogaGlkZQ0KICAgIGhpZ2hsaWdodDogemVuYnVybg0KICAgICMgbnVtYmVyX3NlY3Rpb25zOiB5ZXMNCiAgICB0aGVtZTogImZsYXRseSINCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCi0tLQ0KDQpgYGB7ciBzZXR1cCxpbmNsdWRlPUZBTFNFfQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCB3YXJuaW5nID0gRkFMU0UsIG1lc3NhZ2UgPSBGQUxTRSwgZmlnLndpZHRoID0gMTAsIGZpZy5oZWlnaHQgPSA2KQ0KYGBgDQoNCg0KIyBNb3RpdmF0aW9ucw0KDQpUaGUgb3JpZ2luYWwgcGxvdCBjcmVhdGVkIGJ5IFRoZSBFY29ub21pc3QgYW5kIHlvdSBjYW4gc2VlIFtoZXJlXShodHRwczovL3d3dy5jb25zdWx0YW50c21pbmQuY29tLzIwMTQvMDMvMjUvZ29vZC1ncmFwaHMvP2ZiY2xpZD1Jd0FSMjQwQUx0RmMxeVN2S0t3bGgxMU8zZFNpZEdPR1o4YnJYd1lhN0dobExPNnRZbl9yVmdaNzRLNDV3KS4gUiBjYW4gYmUgdXNlZCBmb3IgcmVjcmVhdGluZyB0aGlzIHBsb3QgYXMgZm9sbG93OiANCg0KIVtdKEM6L1VzZXJzL0FETUlOL0RvY3VtZW50cy9jcmFmdC5qcGcpDQoNCiMgUiBjb2Rlcw0KDQpSIGNvZGVzIGZvciB0aGUgcGxvdDogDQoNCmBgYHtyLCBldmFsPUZBTFNFfQ0KIyBDbGVhciB3b3Jrc3BhY2U6IA0Kcm0obGlzdCA9IGxzKCkpDQoNCiMgSW1wb3J0IGRhdGE6IA0KDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmF2aWF0aW9uIDwtIHJlYWRfY3N2KCJodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vb25seXBoYW50b20vc2FmZXNraWVzL21hc3Rlci9hdmlhdGlvbi5jc3YiKQ0KDQojIFJlbmFtZSBmb3IgY29sdW1uczogDQoNCm9sZF9uYW1lcyA8LSBuYW1lcyhhdmlhdGlvbikNCm5hbWVzKGF2aWF0aW9uKSA8LSBzdHJfcmVwbGFjZV9hbGwob2xkX25hbWVzLCAiICIsICJfIikNCg0KIyBQcmVwYXJlIGRhdGEgZm9yIHBsb3Rpbmc6IA0KDQpteV9sZXZlbHMgPC0gYygiYm9tYmluZyIsICJoaWphY2tpbmciLCAiYWNjaWRlbnQiKQ0KDQphdmlfbG9uZyA8LSBhdmlhdGlvbiAlPiUgDQogIHNlbGVjdChZZWFyLCBjb250YWlucygiQ2FzdWFsdGllcyIpKSAlPiUgDQogIGdhdGhlcih2YXJpYWJsZSwgdmFsdWUsIC1ZZWFyKSAlPiUgDQogIGZpbHRlcihZZWFyIDw9IDIwMTIpICU+JSANCiAgbXV0YXRlKHZhcmlhYmxlID0gY2FzZV93aGVuKHN0cl9kZXRlY3QodmFyaWFibGUsICJBaXJsaW5lciIpIH4gImFjY2lkZW50IiwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBzdHJfZGV0ZWN0KHZhcmlhYmxlLCAiQm9tYmluZyIpIH4gImJvbWJpbmciLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIFRSVUUgfiAiaGlqYWNraW5nIikpICU+JSANCiAgbXV0YXRlKHZhcmlhYmxlID0gZmFjdG9yKHZhcmlhYmxlLCBsZXZlbHMgPSBteV9sZXZlbHMpKQ0KDQoNCmF2aWF0aW9uICU+JSANCiAgZmlsdGVyKFllYXIgPD0gMjAxMikgJT4lIA0KICBzZWxlY3QoWWVhciwgbl9wYXNzID0gV29ybGR3aWRlX3Bhc3NlbmdlcnNfY2FycmllZCkgJT4lIA0KICBtdXRhdGUodmFsdWUgPSBuX3Bhc3MgLyAxMDAwMDAwLCB2YXJpYWJsZSA9ICJsaW5lIikgJT4lIA0KICBtdXRhdGUobGFiZWxfeCA9IGFzLmNoYXJhY3RlcihZZWFyKSkgJT4lIA0KICBtdXRhdGUobGFiZWxfeCA9IGNhc2Vfd2hlbighbGFiZWxfeCAlaW4lIGMoIjE5NzAiLCAiMjAwMCIpICYgWWVhciAlJSAyID09IDAgfiBzdHJfc3ViKGxhYmVsX3gsIDMsIDQpLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIWxhYmVsX3ggJWluJSBjKCIxOTcwIiwgIjIwMDAiKSAmIFllYXIgJSUgMiAhPSAwIH4gIiIsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBUUlVFIH4gbGFiZWxfeCkpIC0+IGRmX3Bhc3MNCg0KbGFiZWxfeCA8LSBkZl9wYXNzICU+JSANCiAgYXJyYW5nZShZZWFyKSAlPiUgDQogIHB1bGwobGFiZWxfeCkNCg0KDQojIE1ha2UgYSBkcmFmdCBwbG90OiANCg0KYmFyX2NvbG9ycyA8LSBjKCIjZWY0NjIzIiwgIiM3NzIyMTAiLCAiI2VlYTA4MyIpDQpsaW5lX2NvbG9yIDwtICIjMDBhMWNlIg0KbXlfZm9udCA8LSAiVWJ1bnR1IENvbmRlbnNlZCINCg0KdGhlbWVfc2V0KHRoZW1lX21pbmltYWwoKSkNCg0KZ2dwbG90KCkgKyANCiAgYW5ub3RhdGUoImN1cnZlIiwgY3VydmF0dXJlID0gMCwgeCA9IDE5NzAgLSAxLCB4ZW5kID0gMjAxMiArIDEsIHkgPSBzZXEoMCwgMzAwMCwgNTAwKSwgeWVuZCA9IHNlcSgwLCAzMDAwLCA1MDApLCANCiAgICAgICAgICAgY29sb3IgPSAiZ3JleTgwIiwgc2l6ZSA9IDAuNSkgKyANCiAgZ2VvbV9jb2woZGF0YSA9IGF2aV9sb25nLCBhZXMoWWVhciwgdmFsdWUsIGZpbGwgPSB2YXJpYWJsZSksIHdpZHRoID0gMC42KSArIA0KICBndWlkZXMoZmlsbCA9IGd1aWRlX2xlZ2VuZChyZXZlcnNlID0gVFJVRSkpICsgDQogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGJhcl9jb2xvcnMsIG5hbWUgPSAiQ2FzdWFsdGllcyogZHVlIHRvOiIpICsgDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9IGMoMC4yNCwgMC45OSksIGxlZ2VuZC5kaXJlY3Rpb24gPSAiaG9yaXpvbnRhbCIpICsgDQogIHRoZW1lKGxlZ2VuZC50ZXh0ID0gZWxlbWVudF90ZXh0KHNpemUgPSAxMSwgZmFjZSA9ICJpdGFsaWMiLCBjb2xvciA9IGJhcl9jb2xvcnNbMl0sIGZhbWlseSA9IG15X2ZvbnQpKSArIA0KICB0aGVtZShsZWdlbmQudGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDExLCBmYWNlID0gImJvbGQuaXRhbGljIiwgY29sb3IgPSBiYXJfY29sb3JzWzJdLCBmYW1pbHkgPSBteV9mb250KSkgKyANCiAgdGhlbWUobGVnZW5kLmtleS53aWR0aCA9IHVuaXQoMC45LCAiY20iKSkgKyANCiAgdGhlbWUobGVnZW5kLmtleS5oZWlnaHQgPSB1bml0KDAuMCwgImNtIikpICsgDQogIGdlb21fbGluZShkYXRhID0gZGZfcGFzcywgYWVzKFllYXIsIHZhbHVlKSwgY29sb3IgPSBsaW5lX2NvbG9yLCBzaXplID0gMS41KSArIA0KICBhbm5vdGF0ZSgiY3VydmUiLCBjdXJ2YXR1cmUgPSAwLCB4ID0gMTk3MCAtIDEsIHhlbmQgPSAyMDEyICsgMSwgeSA9IDAsIHllbmQgPSAwLCBjb2xvciA9ICJncmV5NTAiLCBzaXplID0gMC43KSArIA0KICB0aGVtZShwYW5lbC5ncmlkID0gZWxlbWVudF9ibGFuaygpKSArIA0KICB0aGVtZShheGlzLnRleHQueSA9IGVsZW1lbnRfYmxhbmsoKSkgKyANCiAgdGhlbWUoYXhpcy50aXRsZS55ID0gZWxlbWVudF9ibGFuaygpKSArIA0KICB0aGVtZShheGlzLnRpdGxlLnggPSBlbGVtZW50X2JsYW5rKCkpICsgDQogIHRoZW1lKHBsb3QubWFyZ2luID0gdW5pdChyZXAoMSwgNCksICJjbSIpKSArIA0KICBzY2FsZV94X2NvbnRpbnVvdXMoYnJlYWtzID0gc2VxKDE5NzAsIDIwMTIsIDEpLCBsYWJlbHMgPSBsYWJlbF94KSArIA0KICBzY2FsZV95X2NvbnRpbnVvdXMobGltaXRzID0gYygwLCAzMTAwKSkgKyANCiAgbGFicyh0aXRsZSA9ICJBaXJjcmFmdCBTYWZldHkiLCBzdWJ0aXRsZSA9ICJXb3JsZHdpZGUiLCBjYXB0aW9uID0gIlNvdXJjZTogV29ybGQgQmFuazsgQXZpYXRpb24gU2FmZXR5IE5ldHdvcmsiKSArIA0KICB0aGVtZShheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChjb2xvciA9ICJncmV5MjAiLCB2anVzdCA9IDgsIGZhbWlseSA9IG15X2ZvbnQsIHNpemUgPSAxMikpICsNCiAgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dCh2anVzdCA9IDMsIGhqdXN0ID0gMCwgZmFtaWx5ID0gbXlfZm9udCwgc2l6ZSA9IDE2LCBmYWNlID0gImJvbGQiLCBjb2xvciA9ICJncmV5MjAiKSkgKyANCiAgdGhlbWUocGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dCh2anVzdCA9IDMsIGhqdXN0ID0gMCwgZmFtaWx5ID0gbXlfZm9udCwgc2l6ZSA9IDEyLCBjb2xvciA9ICJncmV5MzAiKSkgKyANCiAgdGhlbWUocGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGZhbWlseSA9IG15X2ZvbnQsIHNpemUgPSAxMCwgY29sb3IgPSAiZ3JleTIwIikpICsgDQogIGFubm90YXRlKCJ0ZXh0IiwgeCA9IDIwMTIgKyAxLCB5ID0gc2VxKDAsIDMwMDAsIDUwMCksIGxhYmVsID0gYygiMCIsICIwLjUiLCAiMS4wIiwgIjEuNSIsICIyLjAiLCAiMi41IiwgIjMuMCIpLCANCiAgICAgICAgICAgaGp1c3QgPSAtMC4yNSwgdmp1c3QgPSAwLjQsICBjb2xvciA9IGxpbmVfY29sb3IsIHNpemUgPSA0LjUsIGZhbWlseSA9IG15X2ZvbnQpICsgDQogIGFubm90YXRlKCJ0ZXh0IiwgeCA9IDE5NzAgLSAxLCB5ID0gc2VxKDAsIDMwMDAsIDUwMCksIGxhYmVsID0gc2VxKDAsIDMwMDAsIDUwMCksIA0KICAgICAgICAgICBoanVzdCA9IDEuMywgdmp1c3QgPSAwLjQsIGNvbG9yID0gYmFyX2NvbG9yc1syXSwgc2l6ZSA9IDQuNSwgZmFtaWx5ID0gbXlfZm9udCkgKyANCiAgZ2VvbV90ZXh0KGRhdGEgPSBkYXRhLmZyYW1lKFllYXIgPSAyMDA5LCB2YWx1ZSA9IDMwNzApLCBhZXMoWWVhciwgdmFsdWUsIGxhYmVsID0gIkFpcmNyYWZ0IHBhc3NlbmdlcnMgY2FycmllZCwgYm4iKSwgDQogICAgICAgICAgICBjb2xvciA9IGxpbmVfY29sb3IsIHNpemUgPSA0LjEsIHZqdXN0ID0gLTEuNSwgZmFtaWx5ID0gbXlfZm9udCwgZm9udGZhY2UgPSAiaXRhbGljIikNCg0KDQpsaWJyYXJ5KGdyaWQpDQpncmlkLnJlY3QoeCA9IDAuMDE1LCB5ID0gMC45MywgaGp1c3QgPSAxLCB2anVzdCA9IDAsIGdwID0gZ3BhcihmaWxsID0gIiNlNTAwMWMiLCBsd2QgPSAwKSkgIA0KZ3JpZC5yZWN0KHggPSAxLCB5ID0gMSAtIDAuMDA1LCBoanVzdCA9IDEsIHZqdXN0ID0gMCwgIGdwID0gZ3BhcihmaWxsID0gIiNlNTAwMWMiLCBsd2QgPSAwKSkNCmBgYA0KDQo=