# 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 = "The countries with the shortest people in the world", 
       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"))

LS0tCnRpdGxlOiAiVGhlIGNvdW50cmllcyB3aXRoIHRoZSBzaG9ydGVzdCBwZW9wbGUgaW4gdGhlIHdvcmxkIgphdXRob3I6ICJKZW5ueSIKcmVmZXJlbmNlOiAiTmd1eWVuIENoaSBEdW5nIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIGNvZGVfZG93bmxvYWQ6IHllcwogICAgIyBjb2RlX2ZvbGRpbmc6IGhpZGUKICAgIGhpZ2hsaWdodDogemVuYnVybgogICAgdGhlbWU6IGZsYXRseQogICAgdG9jOiB5ZXMKICAgIHRvY19mbG9hdDogeWVzCiAgd29yZF9kb2N1bWVudDoKICAgIHRvYzogeWVzCi0tLQoKYGBge3Igc2V0dXAsaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCB3YXJuaW5nID0gRkFMU0UsIG1lc3NhZ2UgPSBGQUxTRSwgZmlnLnJldGluYT0yKQpgYGAKCgojIFRvcCAzMCBDb3VudHJpZXMgd2l0aCBTaG9ydGVzdCBwZW9wbGUKCiFbVmlzdWxpc2F0aW9uXSgvVXNlcnMvamVubnluZ3V5ZW4vRGVza3RvcC9oZWlnaHQucG5nKQoKCiMgUiBDb2RlIGZvciBQbG90CgpgYGB7ciwgZXZhbD1GQUxTRX0KIyBMb2FkIHNvbWUgUiBwYWNrYWdlczogCgpsaWJyYXJ5KHJ2ZXN0KQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShocmJydGhlbWVzKQpteV9mb250IDwtICJSb2JvdG8gQ29uZGVuc2VkIgoKIyBDb2xsZWN0IGRhdGE6IAoKImh0dHA6Ly93b3JsZHBvcHVsYXRpb25yZXZpZXcuY29tL2NvdW50cmllcy9hdmVyYWdlLWhlaWdodC1ieS1jb3VudHJ5LyIgJT4lIAogIHJlYWRfaHRtbCgpICU+JSAKICBodG1sX3RhYmxlKCkgJT4lIAogIC5bWzFdXSAlPiUgCiAgc2VsZWN0KFgyOlg3KSAlPiUgCiAgc2xpY2UoLTEpIC0+IGhlaWdodERhdGEKCiMgUmVuYW1lIGZvciBhbGwgY29sdW1uczogCgpuYW1lcyhoZWlnaHREYXRhKSA8LSBjKCJjb3VudHJ5IiwgIm1hbGVfY20iLCAiZmVtYWxlX2NtIiwgIm1hbGVfZnQiLCAiZmVtYWxlX2Z0IiwgInBvcHVhdGlvbiIpCgojIFByZXBhcmUgZGF0YTogCgpoZWlnaHREYXRhICU+JSAKICBtdXRhdGVfYXQoYygibWFsZV9jbSIsICJmZW1hbGVfY20iKSwgZnVuY3Rpb24oeCkge3ggJT4lIGFzLm51bWVyaWMoKX0pIC0+IGhlaWdodERhdGEKCm9ubHlfbWFsZSA8LSBoZWlnaHREYXRhICU+JSAKICBzZWxlY3QoY291bnRyeSwgbWFsZV9jbSkgJT4lIAogIGZpbHRlcighaXMubmEobWFsZV9jbSkpICU+JSAKICBtdXRhdGUobGFiZWxfbWFsZSA9IGFzLmNoYXJhY3Rlcihyb3VuZChtYWxlX2NtLCAxKSkpICU+JSAKICBtdXRhdGUobGFiZWxfbWFsZSA9IGNhc2Vfd2hlbihzdHJfY291bnQobGFiZWxfbWFsZSkgIT0gNSB+IHBhc3RlMChsYWJlbF9tYWxlLCAiLjAiKSwgVFJVRSB+IGxhYmVsX21hbGUpKQoKb25seV9mZW1hbGUgPC0gaGVpZ2h0RGF0YSAlPiUgCiAgc2VsZWN0KGNvdW50cnksIGZlbWFsZV9jbSkgJT4lIAogIGZpbHRlcighaXMubmEoZmVtYWxlX2NtKSkgJT4lIAogIG11dGF0ZShsYWJlbF9mZW1hbGUgPSBhcy5jaGFyYWN0ZXIocm91bmQoZmVtYWxlX2NtLCAxKSkpICU+JSAKICBtdXRhdGUobGFiZWxfZmVtYWxlID0gY2FzZV93aGVuKHN0cl9jb3VudChsYWJlbF9mZW1hbGUpICE9IDUgfiBwYXN0ZTAobGFiZWxfZmVtYWxlLCAiLjAiKSwgVFJVRSB+IGxhYmVsX2ZlbWFsZSkpCgppbm5lcl9qb2luKG9ubHlfZmVtYWxlLCBvbmx5X21hbGUsIGJ5ID0gImNvdW50cnkiKSAlPiUgCiAgYXJyYW5nZShtYWxlX2NtKSAlPiUgCiAgbXV0YXRlKGNvdW50cnkgPSBmYWN0b3IoY291bnRyeSwgbGV2ZWxzID0gY291bnRyeSkpIC0+IGRmX2Zvcl92aXMKCmRmX2Zvcl92aXMgJT4lIAogIG11dGF0ZShlbmRfcG9pbnQgPSBmZW1hbGVfY20gLSAzLjMpICU+JSAKICBtdXRhdGUoY291bnRyeV9jb2xvciA9IGNhc2Vfd2hlbihjb3VudHJ5ID09ICJWaWV0bmFtIiB+ICJyZWQiLCBUUlVFIH4gIndoaXRlIikpIC0+IGRmX2Zvcl92aXMKCiMgVmlzdWFsaXphdGlvbjogCgpkZl9mb3JfdmlzICU+JSAKICB0b3BfbigtMzAsIHd0ID0gbWFsZV9jbSkgJT4lIAogIGdncGxvdChhZXMoeCA9IGNvdW50cnkpKSArIAogIGdlb21fc2VnbWVudChhZXMoeSA9IGZlbWFsZV9jbSwgeWVuZCA9IG1hbGVfY20sIHggPSBjb3VudHJ5LCB4ZW5kID0gY291bnRyeSksIGNvbG9yID0gIndoaXRlIikgKyAKICBnZW9tX3BvaW50KGFlcyh4ID0gY291bnRyeSwgeSA9IG1hbGVfY20sIGNvbG9yID0gIk1hbGUiKSwgc2l6ZSA9IDQpICsgCiAgZ2VvbV9wb2ludChhZXMoeCA9IGNvdW50cnksIHkgPSBmZW1hbGVfY20sIGNvbG9yID0gIkZlbWFsZSIpLCBzaXplID0gNCkgKyAKICBjb29yZF9mbGlwKCkgKyAKICB0aGVtZV9tb2Rlcm5fcmMoKSArIAogIHNjYWxlX2NvbG9yX21hbnVhbChuYW1lID0gIiIsIGxhYmVscyA9IGMoIkZlbWFsZSIsICJNYWxlIiksIHZhbHVlcyA9IGMoInllbGxvdyIsICJjeWFuIikpICsgCiAgdGhlbWUocGFuZWwuZ3JpZCA9IGVsZW1lbnRfYmxhbmsoKSkgKyAKICB0aGVtZShheGlzLnRleHQueSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTEsIGNvbG9yID0gIndoaXRlIikpICsgCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X2JsYW5rKCkpICsgCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gYygwLjkzLCAwLjUpKSArIAogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJ0b3AiKSArIAogIHNjYWxlX3lfY29udGludW91cyhsaW1pdHMgPSBjKDEzOCwgMTgwKSwgZXhwYW5kID0gYygwLCAwKSkgKyAKICBnZW9tX3RleHQoYWVzKHggPSBjb3VudHJ5LCB5ID0gIGZlbWFsZV9jbSwgbGFiZWwgPSBsYWJlbF9mZW1hbGUpLCBoanVzdCA9IDEuNCwgY29sb3IgPSAid2hpdGUiLCBzaXplID0gNCwgZmFtaWx5ID0gbXlfZm9udCkgKyAKICBnZW9tX3RleHQoYWVzKHggPSBjb3VudHJ5LCB5ID0gIG1hbGVfY20sIGxhYmVsID0gbGFiZWxfbWFsZSksIGhqdXN0ID0gLTAuNCwgY29sb3IgPSAid2hpdGUiLCBzaXplID0gNCwgZmFtaWx5ID0gbXlfZm9udCkgKyAKICBnZW9tX3NlZ21lbnQoYWVzKHkgPSAxMzksIHllbmQgPSBlbmRfcG9pbnQsIHggPSBjb3VudHJ5LCB4ZW5kID0gY291bnRyeSksIGNvbG9yID0gImdyYXk4MCIsIGxpbmV0eXBlID0gMykgKyAKICBsYWJzKHggPSBOVUxMLCB5ID0gTlVMTCwgCiAgICAgICB0aXRsZSA9ICJUaGUgY291bnRyaWVzIHdpdGggdGhlIHNob3J0ZXN0IHBlb3BsZSBpbiB0aGUgd29ybGQiLCAKICAgICAgIHN1YnRpdGxlID0gIlVuaXQgb2YgbWVhc3VyZW1lbnQ6IGNlbnRpbWV0ZXJzLiIsIAogICAgICAgY2FwdGlvbiA9ICJEYXRhIFNvdXJjZTogaHR0cDovL3dvcmxkcG9wdWxhdGlvbnJldmlldy5jb20iKSArIAogIHRoZW1lKHBsb3QubWFyZ2luID0gdW5pdChjKDEsIDEuNSwgMSwgMSksICJjbSIpKSArIAogIHRoZW1lKHBsb3QudGl0bGUgID0gZWxlbWVudF90ZXh0KHNpemUgPSAyMikpICsgCiAgdGhlbWUocGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTIsIGNvbG9yID0gIndoaXRlIikpICsgCiAgdGhlbWUocGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KHNpemUgPSAxMCwgZmFjZSA9ICJpdGFsaWMiKSkgKyAKICB0aGVtZShsZWdlbmQudGV4dCA9IGVsZW1lbnRfdGV4dChjb2xvciA9ICJ3aGl0ZSIsIHNpemUgPSAxMiwgZmFtaWx5ID0gbXlfZm9udCwgZmFjZSA9ICJib2xkIikpCgpgYGAKCg==