Economist-Style Plot using R
Origin of the plot can be found here. This plot can be replicated by using R as follows:

R Codes for Data Cleaning and Visualization
#=======================================================================================
# References:
# https://www.economist.com/graphic-detail/2016/10/03/greying-of-the-nobel-laureates
#=======================================================================================
# Load some packages and load data:
rm(list = ls())
library(tidyverse)
library(lubridate)
library(grid)
path <- "http://api.nobelprize.org/v1/laureate.csv"
laureate <- read_csv(path)
# Clear data:
mydf2 <- laureate %>%
filter(gender != "org", !is.na(category)) %>%
mutate(age = year - year(born),
category = case_when(category == "chemistry" ~ "Chemistry",
category == "economics" ~ "Economics",
category == "literature" ~ "Literature",
category == "medicine" ~ "Medicine",
category == "peace" ~ "Peace",
TRUE ~ "Physics"))
# Set order:
my_orders <- c("Medicine", "Physics", "Chemistry", "Economics", "Literature", "Peace")
mydf2 %>%
select(year, age, category) %>%
na.omit() %>%
mutate(category = factor(category, levels = my_orders)) -> mydf2
# Set label:
label2 <- case_when(str_detect(my_orders, "Econ") ~ "Economics *", TRUE ~ my_orders)
# Prepare data frame 1 for plotting text:
midPoint <- 0.5*(min(mydf2$year) + max(mydf2$year))
dat_text <- tibble(category = factor(my_orders, levels = my_orders),
year = rep(midPoint, 6),
age = rep(105, 6))
# Colours selected:
my_col <- c("#04536e", "#7c2817", "#f15c42", "#3d6a51", "#eca324", "#12a4dc")
my_font <- "Ubuntu Condensed"
# Make a base draft:
mydf2 %>%
ggplot(aes(year, age, colour = category)) +
geom_point(show.legend = FALSE, size = 2, alpha = 0.5) +
geom_smooth(method = "loess", show.legend = FALSE, se = FALSE, size = 1.8) +
scale_color_manual(values = my_col) +
facet_wrap(~ category, ncol = 6) +
theme(strip.text.x = element_blank()) -> p
# Prepare data frame 1 + 2 for plotting text:
text1 <- dat_text %>%
filter(category == "Economics") %>%
mutate(year = 1945, age = 95)
text2 <- dat_text %>%
filter(category == "Peace") %>%
mutate(year = 1945, age = 23)
text3 <- dat_text %>%
filter(category == "Economics") %>%
mutate(year = 1980, age = 97)
text4 <- dat_text %>%
filter(category == "Peace") %>%
mutate(year = 1985, age = 25)
# The first adjustment:
p +
geom_text(data = dat_text, label = label2, family = my_font, fontface = "bold", size = 5) +
guides(col = F) +
geom_text(data = text1, label = "Oldest Winner\nLeonid Hurwicz, 90", family = my_font, size = 4.5) +
geom_text(data = text2, label = "Youngest Winner\nMalala Yousafzai, 17", family = my_font, size = 4.5) +
geom_curve(data = text3, xend = 2007, yend = 90, curvature = -0.5) +
geom_curve(data = text4, xend = 2014, yend = 17, curvature = -0.5) -> p1
# Finalize our plot:
p1 +
scale_x_continuous(breaks = seq(1900, 2010, 25), labels = c("1900", " ", "50", " ", "2000")) +
scale_y_continuous(sec.axis = sec_axis(~. *1), breaks = seq(0, 105, 25), limits = c(15, 105)) +
theme(panel.grid.minor = element_blank()) +
theme(panel.grid.major.x = element_blank()) +
theme(panel.grid.major.y = element_line(size = 0.8)) +
theme(axis.text.y.left = element_blank()) +
theme(axis.ticks.y = element_blank()) +
theme(axis.ticks.length = unit(0.15, "cm")) +
theme(axis.text.x = element_text(size = 13, color = "grey20", family = my_font)) +
theme(axis.text.y = element_text(size = 13, color = "grey20", family = my_font)) +
theme(plot.margin = unit(c(0.7, 0.7, 0.7, 1), "cm")) +
labs(x = NULL, y = NULL,
title = "Senescience",
subtitle = "Age of Nobel laureates, at the date of award",
caption = "Data Source: Nobelprize.org") +
theme(plot.title = element_text(face = "bold", size = 21, family = my_font, hjust = 0, color = "grey10")) +
theme(plot.subtitle = element_text(size = 15, margin = margin(b = 20), hjust = 0, family = my_font, color = "grey20")) +
theme(plot.caption = element_text(size = 11, family = my_font, color = "grey20"))
grid.rect(x = 0.015, y = 0.92, 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))
LS0tCnRpdGxlOiAiR3JleWluZyBvZiB0aGUgTm9iZWwgbGF1cmVhdGVzIgphdXRob3I6ICdOZ3V5ZW4gQ2hpIER1bmcnCnN1YnRpdGxlOiAiRGFpbHkgR3JhcGggU2VyaWVzIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDogCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCiAgICAjICAgY29kZV9mb2xkaW5nOiBoaWRlCiAgICBoaWdobGlnaHQ6IHplbmJ1cm4KICAgICMgbnVtYmVyX3NlY3Rpb25zOiB5ZXMKICAgIHRoZW1lOiAiZmxhdGx5IgogICAgdG9jOiBUUlVFCiAgICB0b2NfZmxvYXQ6IFRSVUUKLS0tCgpgYGB7ciBzZXR1cCxpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUsIHdhcm5pbmcgPSBGQUxTRSwgbWVzc2FnZSA9IEZBTFNFLCBmaWcud2lkdGggPSAxMCwgZmlnLmhlaWdodCA9IDYpCmBgYAoKIyBFY29ub21pc3QtU3R5bGUgUGxvdCB1c2luZyBSCgpPcmlnaW4gb2YgdGhlIHBsb3QgY2FuIGJlIGZvdW5kIFtoZXJlXShodHRwczovL3d3dy5lY29ub21pc3QuY29tL2dyYXBoaWMtZGV0YWlsLzIwMTYvMTAvMDMvZ3JleWluZy1vZi10aGUtbm9iZWwtbGF1cmVhdGVzKS4gVGhpcyBwbG90IGNhbiBiZSByZXBsaWNhdGVkIGJ5IHVzaW5nIFIgYXMgZm9sbG93czogCgohW10oL2hvbWUva2hhbmhhbi9ub2JlbC5wbmcpCgoKIyBSIENvZGVzIGZvciBEYXRhIENsZWFuaW5nIGFuZCBWaXN1YWxpemF0aW9uCgpgYGB7ciwgZXZhbD1GQUxTRX0KCgoKIz09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PQojICAgICAgICAgUmVmZXJlbmNlczogCiMgICBodHRwczovL3d3dy5lY29ub21pc3QuY29tL2dyYXBoaWMtZGV0YWlsLzIwMTYvMTAvMDMvZ3JleWluZy1vZi10aGUtbm9iZWwtbGF1cmVhdGVzCiM9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0KCiMgTG9hZCBzb21lIHBhY2thZ2VzIGFuZCBsb2FkIGRhdGE6IApybShsaXN0ID0gbHMoKSkKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkobHVicmlkYXRlKQpsaWJyYXJ5KGdyaWQpCgpwYXRoIDwtICJodHRwOi8vYXBpLm5vYmVscHJpemUub3JnL3YxL2xhdXJlYXRlLmNzdiIKbGF1cmVhdGUgPC0gcmVhZF9jc3YocGF0aCkKCiMgQ2xlYXIgZGF0YTogCm15ZGYyIDwtIGxhdXJlYXRlICU+JSAKICBmaWx0ZXIoZ2VuZGVyICE9ICJvcmciLCAhaXMubmEoY2F0ZWdvcnkpKSAlPiUgCiAgbXV0YXRlKGFnZSA9IHllYXIgLSB5ZWFyKGJvcm4pLCAKICAgICAgICAgY2F0ZWdvcnkgPSBjYXNlX3doZW4oY2F0ZWdvcnkgPT0gImNoZW1pc3RyeSIgfiAiQ2hlbWlzdHJ5IiwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNhdGVnb3J5ID09ICJlY29ub21pY3MiIH4gIkVjb25vbWljcyIsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjYXRlZ29yeSA9PSAibGl0ZXJhdHVyZSIgfiAiTGl0ZXJhdHVyZSIsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjYXRlZ29yeSA9PSAibWVkaWNpbmUiIH4gIk1lZGljaW5lIiwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNhdGVnb3J5ID09ICJwZWFjZSIgfiAiUGVhY2UiLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgVFJVRSB+ICJQaHlzaWNzIikpCgojIFNldCBvcmRlcjogCm15X29yZGVycyA8LSBjKCJNZWRpY2luZSIsICJQaHlzaWNzIiwgIkNoZW1pc3RyeSIsICJFY29ub21pY3MiLCAiTGl0ZXJhdHVyZSIsICJQZWFjZSIpCgpteWRmMiAlPiUgCiAgc2VsZWN0KHllYXIsIGFnZSwgY2F0ZWdvcnkpICU+JSAKICBuYS5vbWl0KCkgJT4lIAogIG11dGF0ZShjYXRlZ29yeSA9IGZhY3RvcihjYXRlZ29yeSwgbGV2ZWxzID0gbXlfb3JkZXJzKSkgLT4gbXlkZjIKCiMgU2V0IGxhYmVsOiAKbGFiZWwyIDwtIGNhc2Vfd2hlbihzdHJfZGV0ZWN0KG15X29yZGVycywgIkVjb24iKSB+ICJFY29ub21pY3MgKiIsIFRSVUUgfiBteV9vcmRlcnMpCgojIFByZXBhcmUgZGF0YSBmcmFtZSAxIGZvciBwbG90dGluZyB0ZXh0OiAKCm1pZFBvaW50IDwtIDAuNSoobWluKG15ZGYyJHllYXIpICsgbWF4KG15ZGYyJHllYXIpKQoKZGF0X3RleHQgPC0gdGliYmxlKGNhdGVnb3J5ID0gZmFjdG9yKG15X29yZGVycywgbGV2ZWxzID0gbXlfb3JkZXJzKSwgCiAgICAgICAgICAgICAgICAgICB5ZWFyID0gcmVwKG1pZFBvaW50LCA2KSwgCiAgICAgICAgICAgICAgICAgICBhZ2UgPSByZXAoMTA1LCA2KSkgCgojIENvbG91cnMgc2VsZWN0ZWQ6IApteV9jb2wgPC0gIGMoIiMwNDUzNmUiLCAiIzdjMjgxNyIsICIjZjE1YzQyIiwgIiMzZDZhNTEiLCAiI2VjYTMyNCIsICIjMTJhNGRjIikKbXlfZm9udCA8LSAiVWJ1bnR1IENvbmRlbnNlZCIKCiMgTWFrZSBhIGJhc2UgZHJhZnQ6IAoKbXlkZjIgJT4lIAogIGdncGxvdChhZXMoeWVhciwgYWdlLCBjb2xvdXIgPSBjYXRlZ29yeSkpICsgCiAgZ2VvbV9wb2ludChzaG93LmxlZ2VuZCA9IEZBTFNFLCBzaXplID0gMiwgYWxwaGEgPSAwLjUpICsgCiAgZ2VvbV9zbW9vdGgobWV0aG9kID0gImxvZXNzIiwgc2hvdy5sZWdlbmQgPSBGQUxTRSwgc2UgPSBGQUxTRSwgc2l6ZSA9IDEuOCkgKyAKICBzY2FsZV9jb2xvcl9tYW51YWwodmFsdWVzID0gbXlfY29sKSArIAogIGZhY2V0X3dyYXAofiBjYXRlZ29yeSwgbmNvbCA9IDYpICsgCiAgdGhlbWUoc3RyaXAudGV4dC54ID0gZWxlbWVudF9ibGFuaygpKSAtPiBwCgojIFByZXBhcmUgZGF0YSBmcmFtZSAxICsgMiBmb3IgcGxvdHRpbmcgdGV4dDogCgp0ZXh0MSA8LSBkYXRfdGV4dCAlPiUgCiAgZmlsdGVyKGNhdGVnb3J5ID09ICJFY29ub21pY3MiKSAlPiUgCiAgbXV0YXRlKHllYXIgPSAxOTQ1LCBhZ2UgPSA5NSkKCnRleHQyIDwtIGRhdF90ZXh0ICU+JSAKICBmaWx0ZXIoY2F0ZWdvcnkgPT0gIlBlYWNlIikgJT4lIAogIG11dGF0ZSh5ZWFyID0gMTk0NSwgYWdlID0gMjMpCgp0ZXh0MyA8LSBkYXRfdGV4dCAlPiUgCiAgZmlsdGVyKGNhdGVnb3J5ID09ICJFY29ub21pY3MiKSAlPiUgCiAgbXV0YXRlKHllYXIgPSAxOTgwLCBhZ2UgPSA5NykKCgp0ZXh0NCA8LSBkYXRfdGV4dCAlPiUgCiAgZmlsdGVyKGNhdGVnb3J5ID09ICJQZWFjZSIpICU+JSAKICBtdXRhdGUoeWVhciA9IDE5ODUsIGFnZSA9IDI1KQoKIyBUaGUgZmlyc3QgYWRqdXN0bWVudDogCgpwICsgCiAgZ2VvbV90ZXh0KGRhdGEgPSBkYXRfdGV4dCwgbGFiZWwgPSBsYWJlbDIsIGZhbWlseSA9IG15X2ZvbnQsIGZvbnRmYWNlID0gImJvbGQiLCBzaXplID0gNSkgKyAKICBndWlkZXMoY29sID0gRikgKyAKICBnZW9tX3RleHQoZGF0YSA9IHRleHQxLCBsYWJlbCA9ICJPbGRlc3QgV2lubmVyXG5MZW9uaWQgSHVyd2ljeiwgOTAiLCBmYW1pbHkgPSBteV9mb250LCBzaXplID0gNC41KSArIAogIGdlb21fdGV4dChkYXRhID0gdGV4dDIsIGxhYmVsID0gIllvdW5nZXN0IFdpbm5lclxuTWFsYWxhIFlvdXNhZnphaSwgMTciLCBmYW1pbHkgPSBteV9mb250LCBzaXplID0gNC41KSArIAogIGdlb21fY3VydmUoZGF0YSA9IHRleHQzLCB4ZW5kID0gMjAwNywgeWVuZCA9IDkwLCBjdXJ2YXR1cmUgPSAtMC41KSArIAogIGdlb21fY3VydmUoZGF0YSA9IHRleHQ0LCB4ZW5kID0gMjAxNCwgeWVuZCA9IDE3LCBjdXJ2YXR1cmUgPSAtMC41KSAtPiBwMQoKIyBGaW5hbGl6ZSBvdXIgcGxvdDogCgpwMSArIAogIHNjYWxlX3hfY29udGludW91cyhicmVha3MgPSBzZXEoMTkwMCwgMjAxMCwgMjUpLCBsYWJlbHMgPSBjKCIxOTAwIiwgIiAiLCAiNTAiLCAiICIsICIyMDAwIikpICsgCiAgc2NhbGVfeV9jb250aW51b3VzKHNlYy5heGlzID0gc2VjX2F4aXMofi4gKjEpLCBicmVha3MgPSBzZXEoMCwgMTA1LCAyNSksIGxpbWl0cyA9IGMoMTUsIDEwNSkpICsgCiAgdGhlbWUocGFuZWwuZ3JpZC5taW5vciA9IGVsZW1lbnRfYmxhbmsoKSkgKyAKICB0aGVtZShwYW5lbC5ncmlkLm1ham9yLnggPSBlbGVtZW50X2JsYW5rKCkpICsgCiAgdGhlbWUocGFuZWwuZ3JpZC5tYWpvci55ID0gZWxlbWVudF9saW5lKHNpemUgPSAwLjgpKSArIAogIHRoZW1lKGF4aXMudGV4dC55LmxlZnQgPSBlbGVtZW50X2JsYW5rKCkpICsgCiAgdGhlbWUoYXhpcy50aWNrcy55ID0gZWxlbWVudF9ibGFuaygpKSArIAogIHRoZW1lKGF4aXMudGlja3MubGVuZ3RoID0gdW5pdCgwLjE1LCAiY20iKSkgKyAKICB0aGVtZShheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChzaXplID0gMTMsIGNvbG9yID0gImdyZXkyMCIsIGZhbWlseSA9IG15X2ZvbnQpKSArIAogIHRoZW1lKGF4aXMudGV4dC55ID0gZWxlbWVudF90ZXh0KHNpemUgPSAxMywgY29sb3IgPSAiZ3JleTIwIiwgZmFtaWx5ID0gbXlfZm9udCkpICsgCiAgdGhlbWUocGxvdC5tYXJnaW4gPSB1bml0KGMoMC43LCAwLjcsIDAuNywgMSksICJjbSIpKSArIAogIGxhYnMoeCA9IE5VTEwsIHkgPSBOVUxMLCAKICAgICAgIHRpdGxlID0gIlNlbmVzY2llbmNlIiwgCiAgICAgICBzdWJ0aXRsZSA9ICJBZ2Ugb2YgTm9iZWwgbGF1cmVhdGVzLCBhdCB0aGUgZGF0ZSBvZiBhd2FyZCIsIAogICAgICAgY2FwdGlvbiA9ICJEYXRhIFNvdXJjZTogTm9iZWxwcml6ZS5vcmciKSArICAKICB0aGVtZShwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGZhY2UgPSAiYm9sZCIsIHNpemUgPSAyMSwgZmFtaWx5ID0gbXlfZm9udCwgaGp1c3QgPSAwLCBjb2xvciA9ICJncmV5MTAiKSkgKyAKICB0aGVtZShwbG90LnN1YnRpdGxlID0gZWxlbWVudF90ZXh0KHNpemUgPSAxNSwgbWFyZ2luID0gbWFyZ2luKGIgPSAyMCksIGhqdXN0ID0gMCwgZmFtaWx5ID0gbXlfZm9udCwgY29sb3IgPSAiZ3JleTIwIikpICsgCiAgdGhlbWUocGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KHNpemUgPSAxMSwgZmFtaWx5ID0gbXlfZm9udCwgY29sb3IgPSAiZ3JleTIwIikpIAoKZ3JpZC5yZWN0KHggPSAwLjAxNSwgeSA9IDAuOTIsIGhqdXN0ID0gMSwgdmp1c3QgPSAwLCBncCA9IGdwYXIoZmlsbCA9ICIjZTUwMDFjIiwgbHdkID0gMCkpICAKZ3JpZC5yZWN0KHggPSAxLCB5ID0gMSAtIDAuMDA1LCBoanVzdCA9IDEsIHZqdXN0ID0gMCwgIGdwID0gZ3BhcihmaWxsID0gIiNlNTAwMWMiLCBsd2QgPSAwKSkgCmBgYAoKCiAg