Practice recreate chart of The Economist by R with introduction of chidungkt
# 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)) # 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") )