Motivation

Practice recreate chart of The Economist by R with introduction of chidungkt

Data Processing

# Clear R environment: 
rm(list = ls())

# Setwd
setwd("D:/0 - My documents/TOOLS/R/The Economist/Nobel")

# Load packages
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 <- mydf2 %>% 
  select(year, age, category) %>% 
  na.omit() %>% 
  mutate(category = factor(category, levels = my_orders))

# 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)) 

Visualization

# Colours selected: 
my_col <-  c("#04536e", "#7c2817", "#f15c42", "#3d6a51", "#eca324", "#12a4dc")
my_font <- "Ubuntu Condensed"

# Make a base draft: 
p <- 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())

# 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: 

p1 <- 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 + 
  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 = 25, 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")) 


ggsave("nobel.png", width = 15, height = 7,dpi = 300,units = c("in") )