Average Height By 30 Shortest Countries, 2019

Daily Graph Series

30 Shortest Countries

R Code for Plot

# Load some R packages: 

library(rvest)
library(tidyverse)
library(hrbrthemes)
my_font <- "Roboto Condensed"

# Collect data: 

"http://worldpopulationreview.com/countries/average-height-by-country/" %>% 
  read_html() %>% 
  html_table() %>% 
  .[[1]] %>% 
  select(X2:X7) %>% 
  slice(-1) -> heightData

# Rename for all columns: 

names(heightData) <- c("country", "male_cm", "female_cm", "male_ft", "female_ft", "popuation")

# Prepare data: 

heightData %>% 
  mutate_at(c("male_cm", "female_cm"), function(x) {x %>% as.numeric()}) -> heightData

only_male <- heightData %>% 
  select(country, male_cm) %>% 
  filter(!is.na(male_cm)) %>% 
  mutate(label_male = as.character(round(male_cm, 1))) %>% 
  mutate(label_male = case_when(str_count(label_male) != 5 ~ paste0(label_male, ".0"), TRUE ~ label_male))

only_female <- heightData %>% 
  select(country, female_cm) %>% 
  filter(!is.na(female_cm)) %>% 
  mutate(label_female = as.character(round(female_cm, 1))) %>% 
  mutate(label_female = case_when(str_count(label_female) != 5 ~ paste0(label_female, ".0"), TRUE ~ label_female))

inner_join(only_female, only_male, by = "country") %>% 
  arrange(male_cm) %>% 
  mutate(country = factor(country, levels = country)) -> df_for_vis

df_for_vis %>% 
  mutate(end_point = female_cm - 3.3) %>% 
  mutate(country_color = case_when(country == "Vietnam" ~ "red", TRUE ~ "white")) -> df_for_vis

# Visualization: 

df_for_vis %>% 
  top_n(-30, wt = male_cm) %>% 
  ggplot(aes(x = country)) + 
  geom_segment(aes(y = female_cm, yend = male_cm, x = country, xend = country), color = "white") + 
  geom_point(aes(x = country, y = male_cm, color = "Male"), size = 4) + 
  geom_point(aes(x = country, y = female_cm, color = "Female"), size = 4) + 
  coord_flip() + 
  theme_modern_rc() + 
  scale_color_manual(name = "", labels = c("Female", "Male"), values = c("yellow", "cyan")) + 
  theme(panel.grid = element_blank()) + 
  theme(axis.text.y = element_text(size = 11, color = "white")) + 
  theme(axis.text.x = element_blank()) + 
  theme(legend.position = c(0.93, 0.5)) + 
  theme(legend.position = "top") + 
  scale_y_continuous(limits = c(138, 180), expand = c(0, 0)) + 
  geom_text(aes(x = country, y =  female_cm, label = label_female), hjust = 1.4, color = "white", size = 4, family = my_font) + 
  geom_text(aes(x = country, y =  male_cm, label = label_male), hjust = -0.4, color = "white", size = 4, family = my_font) + 
  geom_segment(aes(y = 139, yend = end_point, x = country, xend = country), color = "gray80", linetype = 3) + 
  labs(x = NULL, y = NULL, 
       title = "Average Height By 30 Shortest Countries, 2019", 
       subtitle = "Unit of measurement: centimeters.", 
       caption = "Data Source: http://worldpopulationreview.com") + 
  theme(plot.margin = unit(c(1, 1.5, 1, 1), "cm")) + 
  theme(plot.title  = element_text(size = 22)) + 
  theme(plot.subtitle = element_text(size = 12, color = "white")) + 
  theme(plot.caption = element_text(size = 10, face = "italic")) + 
  theme(legend.text = element_text(color = "white", size = 12, family = my_font, face = "bold"))