Matters of the heart

Daily Graph Series

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

Data can be downloaded here.

# Load Data: 
library(tidyverse)
df <- read.table("/home/khanhan/Downloads/NCD_RisC_Lancet_2016_BP_age_standardised_countries.txt", sep = ",")
df %>% select(1:5) -> df

# Rename for columns: 
new_names <- c("Country", "ISO", "Gender", "Year", "Prevalence")
names(df) <- new_names

# Remove the first row and retain observations in 2015: 
df %>% 
  slice(-1) %>% 
  filter(Year == "2015") -> df_2015

full_join(df_2015 %>% filter(Gender == "Men") %>% select(Country, PrevalenceMen = Prevalence), 
          df_2015 %>% filter(Gender == "Women") %>% select(Country, PrevalenceWomen = Prevalence), by = "Country") -> df2015plot

# Central and Eastern Europe Countries: 

library(rvest)

read_html("https://en.wikipedia.org/wiki/Central_and_Eastern_Europe") %>% 
  html_nodes("p+ ul li > a:nth-child(1)") %>% 
  html_text() -> central_easternCountry

central_easternCountry <- central_easternCountry[-c(5, 6)]
central_easternCountry <- case_when(str_detect(central_easternCountry, "North") ~ "Macedonia", TRUE ~ central_easternCountry)
central_easternCountry <- c("Russia", central_easternCountry)

# High-Income Western Countries: 

library(wbstats)
general_information <-  wb_cachelist
m <- general_information[[1]]

m %>% 
  filter(region == "Europe & Central Asia") %>% 
  filter(income == "High income") %>% 
  pull(country) -> highIncomeCountry

# Sub-Saharan Africa Countries: 

m %>% 
  filter(region == "Sub-Saharan Africa ") %>% 
  pull(country) -> subSahAfri

case_when(str_detect(subSahAfri, "Congo, Dem. Rep.") ~ "DR Congo", 
          str_detect(subSahAfri, "Congo, Rep.") ~ "Congo", 
          TRUE ~ subSahAfri) -> subSahAfri

# Create Region column: 

df2015plot %>% 
  mutate_all(as.character) %>% 
  mutate(Country = case_when(Country == "United States of America" ~ "United States", 
                             Country == "Russian Federation" ~ "Russia", 
                             Country == "United Kingdom" ~ "Britain", 
                             TRUE ~ Country)) %>% 
  mutate_at(c("PrevalenceMen", "PrevalenceWomen"), .funs = as.numeric) %>% 
  mutate(Region = case_when(Country %in% central_easternCountry ~ "Central and Eastern Europe", 
                            Country %in% highIncomeCountry ~ "High-Income Western", 
                            Country %in% subSahAfri ~ "Sub-Saharan Africa", 
                            TRUE ~ "Others")) -> df_final

# Make a draft: 

library(scales)
library(ggrepel)

levels <- c("Central and Eastern Europe", "High-Income Western", "Sub-Saharan Africa", "Others")
my_colors <- c("#f15b40", "#eca221", "#00526d", "#b0c6d2")
my_font <- "Ubuntu Condensed"

df_final %>% 
  mutate(Region = factor(Region, levels = levels)) %>% 
  mutate_if(is.numeric, function(x) {rescale(x, to = c(0, 40))}) -> df_final

df_ground <- tibble(PrevalenceWomen = 0:40, PrevalenceMen = 0:40)

some_countries <- c("Russia", "Viet Nam", "Croatia", "India", "Nigeria", 
                    "Germany", "Thailand", "United States", "Singapore") 

df_mini <- df_final %>% filter(Country %in% some_countries)

df_final %>% 
  ggplot(aes(PrevalenceWomen, PrevalenceMen)) + 
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = my_colors[3], size = 0.8, alpha = 0.6) + 
  geom_area(data = df_ground, aes(x = PrevalenceWomen, y = PrevalenceMen), fill = "#E9F2F7", alpha = 0.6) + 
  geom_point(size = 5, aes(color = Region)) + 
  geom_point(aes(x = PrevalenceWomen, y = PrevalenceMen, color = Region), data = df_mini, 
             shape = 21, size = 5, color = "black") + 
  theme_minimal(base_family = my_font) + 
  scale_y_continuous(limits = c(0, 40)) + 
  scale_x_continuous(limits = c(0, 40)) + 
  scale_color_manual(values = my_colors) + 
  theme(panel.grid.major = element_line(colour = "#dbe2e7", size = 0.5)) + 
  theme(panel.grid.minor = element_blank()) + 
  theme(legend.title = element_blank()) + 
  theme(legend.position = "top") + 
  geom_text_repel(data = df_mini, family = my_font, color = "grey20", size = 5, force = 19,
            aes(x = PrevalenceWomen, y = PrevalenceMen, label = Country)) + 
  theme(plot.margin = unit(rep(1, 4), "cm")) + 
  theme(plot.title = element_text(size = 22, color = "grey20")) +
  theme(plot.subtitle = element_text(size = 16, color = "grey30")) + 
  theme(plot.caption = element_text(size = 12, color = "grey30")) + 
  theme(axis.title = element_text(size = 15, color = "grey15")) + 
  theme(axis.text = element_text(size = 15, color = "grey15")) + 
  theme(legend.text = element_text(color = "grey30", size = 15)) + 
  labs(title = "Matters of the heart",
       subtitle = "Prevalance of raised blood pressure*, by sex, 2015, %",
       caption = "Source: MCD Risk Factor Collaboration",
       x = "Woman",
       y = "Man")

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