#==================================================================================
#   Scrapping population data with inputs are: 
#   1. Given year, 
#   2. Country code selected from https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2
#==================================================================================

# Clear workspace: 
rm(list = ls())

# Load some packages for scrapping data and data manipulation: 
library(rvest)
library(magrittr)
library(tidyverse)
library(extrafont)

# A function for collecting population data: 

get_population <- function(countryCode_selected, year_selected) {
  
  base_url <- "https://www.census.gov/data-tools/demo/idb/region.php?N=%20Results%20&T=10&A=separate&RT=0&Y="
  link <- paste0(paste0(paste0(base_url, year_selected), "&R=-1&C="), countryCode_selected)
  
  link %>% 
    read_html() -> html_content  
  
  html_content %>% 
    html_table(fill = TRUE) %>% 
    .[[1]] -> pop_df
  
  names(pop_df) <- str_replace_all(names(pop_df), " ", "_")
  
  country_name <- html_content %>% 
    html_nodes('.query_source a') %>% 
    html_text() 
  
  if (length(country_name) == 2) {
    country_name <- country_name[2]
  }
  
  
  final_df <- pop_df %>% 
    select(-Year, -Age, -contains("Percent"), -Sex_Ratio) %>% 
    mutate_all(function(x) {str_replace_all(x, "[^0-9]", "") %>% as.numeric()}) %>% 
    mutate(Year = pop_df$Year, Country = country_name[1], Age = pop_df$Age) %>% 
    select(Year, Country, Age, everything()) %>% 
    mutate(Percent_Both_Sexes = Both_Sexes_Population / Both_Sexes_Population[1], 
           Percent_Male = Male_Population / Male_Population[1], 
           Percent_Female = Female_Population / Female_Population[1], 
           Sex_Ratio = Male_Population / Female_Population, 
           Age = case_when(Age == "0-4" ~ "00-04", Age == "5-9" ~ "05-09", TRUE ~ Age))
  
  return(final_df)
  
}



vn_2018_pop <- get_population("VM", 2018)

#======================
#     Make  Graph
#======================


# Colors selected: 
my_colors <- c("#2E74C0", "#CB454A")
my_font <- "Roboto Condensed"


vn_2018_pop %>% 
  slice(-c(1, 21:22)) %>% 
  select(Age, Male_Population, Female_Population) %>% 
  mutate(Male_Population = -1*Male_Population) %>% 
  gather(Gender, Value, -Age) %>% 
  ggplot(aes(Age, Value, fill = Gender)) + 
  geom_col(position = "stack") + 
  coord_flip() + 
  scale_y_continuous(breaks = seq(-5000000, 5000000, 1000000), 
                     limits = c(-5000000, 5000000), 
                     labels = c(paste0(seq(5, 0, -1), "M"), paste0(1:5, "M"))) + 
  theme_minimal() + 
  scale_fill_manual(values = my_colors, name = "", labels = c("Female", "Male")) + 
  guides(fill = guide_legend(reverse = TRUE)) + 
  theme(panel.grid.major.x = element_line(linetype = "dotted", size = 0.2, color = "grey40")) + 
  theme(panel.grid.major.y = element_blank()) + 
  theme(panel.grid.minor.y = element_blank()) + 
  theme(panel.grid.minor.x = element_blank()) + 
  theme(legend.position = "top") + 
  theme(plot.title = element_text(family = my_font, size = 28)) + 
  theme(plot.subtitle = element_text(family = my_font, size = 13, color = "gray40")) + 
  theme(plot.caption = element_text(family = my_font, size = 12, colour = "grey40", face = "italic")) + 
  theme(plot.margin = unit(c(1.2, 1.2, 1.2, 1.2), "cm")) + 
  theme(axis.text = element_text(size = 13, family = my_font)) + 
  theme(legend.text = element_text(size = 12, face = "bold", color = "grey30", family = my_font)) + 
  labs(x = NULL, y = NULL, 
       title = "Population Pyramids of Vietnam in 2018",
       subtitle = "A population pyramid illustrates the age-sex structure of a country's population and may provide insights about\npolitical and social stability, as well as economic development. Countries with young populations need to\ninvest more in schools, while countries with older populations need to invest more in the health sector.",
       caption = "Data Source: https://www.census.gov")

LS0tDQp0aXRsZTogIlBvcHVsYXRpb24gUHlyYW1pZCBHcmFwaCBmb3IgVmlldG5hbSBpbiAyMDE4Ig0KYXV0aG9yOiAiTmd1eWVuIENoaSBEdW5nIg0Kc3VidGl0bGU6ICJEYWlseSBHcmFwaCBTZXJpZXMiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgY29kZV9kb3dubG9hZDogeWVzDQogICAgIyBjb2RlX2ZvbGRpbmc6IGhpZGUNCiAgICBoaWdobGlnaHQ6IHplbmJ1cm4NCiAgICB0aGVtZTogZmxhdGx5DQogICAgdG9jOiB5ZXMNCiAgICB0b2NfZmxvYXQ6IHllcw0KICB3b3JkX2RvY3VtZW50Og0KICAgIHRvYzogeWVzDQotLS0NCg0KYGBge3Igc2V0dXAsaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSwgd2FybmluZyA9IEZBTFNFLCBtZXNzYWdlID0gRkFMU0UsIGZpZy5yZXRpbmE9MikNCmBgYA0KDQojIERhdGEgU291cmNlIGFuZCBEZXNjcmlwdGlvbg0KDQpJbiB0aGlzIHBvc3QgSSB3aWxsIHByZXNlbnQgUiBjb2RlcyBmb3IgY29sbGVjdGluZyBwb3B1bGF0aW9uIGRhdGEgcHJvdmlkZWQgYnkgVS5TLiBDZW5zdXMgQnVyZWF1IHdpdGggaW5wdXRzIGFyZSBnaXZlbiBjb3VudHJ5IGNvZGUgYW5kIHllYXIgc2VsZWN0ZWQuIEluIGFkZGl0aW9uLCBSIGNvZGVzIGZvciBtYWtpbmcgUG9wdWxhdGlvbiBQeXJhbWlkcyBmb3IgVmlldG5hbSBpbiAyMDE4IGFyZSBzaG93bi4NCg0KIyBQb3B1bGF0aW9uIFB5cmFtaWQgR3JhcGgNCg0KDQohW10oQzpcVXNlcnNcWmJvb2tcRGVza3RvcFxwaWNccGljMjAucG5nKQ0KDQpSIGNvZGVzIGZvciB0aGlzIGdyYXBoOiANCg0KDQpgYGB7ciwgZXZhbD1GQUxTRX0NCg0KDQoNCiM9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09DQojICAgU2NyYXBwaW5nIHBvcHVsYXRpb24gZGF0YSB3aXRoIGlucHV0cyBhcmU6IA0KIyAgIDEuIEdpdmVuIHllYXIsIA0KIyAgIDIuIENvdW50cnkgY29kZSBzZWxlY3RlZCBmcm9tIGh0dHBzOi8vZW4ud2lraXBlZGlhLm9yZy93aWtpL0lTT18zMTY2LTFfYWxwaGEtMg0KIz09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0NCg0KIyBDbGVhciB3b3Jrc3BhY2U6IA0Kcm0obGlzdCA9IGxzKCkpDQoNCiMgTG9hZCBzb21lIHBhY2thZ2VzIGZvciBzY3JhcHBpbmcgZGF0YSBhbmQgZGF0YSBtYW5pcHVsYXRpb246IA0KbGlicmFyeShydmVzdCkNCmxpYnJhcnkobWFncml0dHIpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkoZXh0cmFmb250KQ0KDQojIEEgZnVuY3Rpb24gZm9yIGNvbGxlY3RpbmcgcG9wdWxhdGlvbiBkYXRhOiANCg0KZ2V0X3BvcHVsYXRpb24gPC0gZnVuY3Rpb24oY291bnRyeUNvZGVfc2VsZWN0ZWQsIHllYXJfc2VsZWN0ZWQpIHsNCiAgDQogIGJhc2VfdXJsIDwtICJodHRwczovL3d3dy5jZW5zdXMuZ292L2RhdGEtdG9vbHMvZGVtby9pZGIvcmVnaW9uLnBocD9OPSUyMFJlc3VsdHMlMjAmVD0xMCZBPXNlcGFyYXRlJlJUPTAmWT0iDQogIGxpbmsgPC0gcGFzdGUwKHBhc3RlMChwYXN0ZTAoYmFzZV91cmwsIHllYXJfc2VsZWN0ZWQpLCAiJlI9LTEmQz0iKSwgY291bnRyeUNvZGVfc2VsZWN0ZWQpDQogIA0KICBsaW5rICU+JSANCiAgICByZWFkX2h0bWwoKSAtPiBodG1sX2NvbnRlbnQgIA0KICANCiAgaHRtbF9jb250ZW50ICU+JSANCiAgICBodG1sX3RhYmxlKGZpbGwgPSBUUlVFKSAlPiUgDQogICAgLltbMV1dIC0+IHBvcF9kZg0KICANCiAgbmFtZXMocG9wX2RmKSA8LSBzdHJfcmVwbGFjZV9hbGwobmFtZXMocG9wX2RmKSwgIiAiLCAiXyIpDQogIA0KICBjb3VudHJ5X25hbWUgPC0gaHRtbF9jb250ZW50ICU+JSANCiAgICBodG1sX25vZGVzKCcucXVlcnlfc291cmNlIGEnKSAlPiUgDQogICAgaHRtbF90ZXh0KCkgDQogIA0KICBpZiAobGVuZ3RoKGNvdW50cnlfbmFtZSkgPT0gMikgew0KICAgIGNvdW50cnlfbmFtZSA8LSBjb3VudHJ5X25hbWVbMl0NCiAgfQ0KICANCiAgDQogIGZpbmFsX2RmIDwtIHBvcF9kZiAlPiUgDQogICAgc2VsZWN0KC1ZZWFyLCAtQWdlLCAtY29udGFpbnMoIlBlcmNlbnQiKSwgLVNleF9SYXRpbykgJT4lIA0KICAgIG11dGF0ZV9hbGwoZnVuY3Rpb24oeCkge3N0cl9yZXBsYWNlX2FsbCh4LCAiW14wLTldIiwgIiIpICU+JSBhcy5udW1lcmljKCl9KSAlPiUgDQogICAgbXV0YXRlKFllYXIgPSBwb3BfZGYkWWVhciwgQ291bnRyeSA9IGNvdW50cnlfbmFtZVsxXSwgQWdlID0gcG9wX2RmJEFnZSkgJT4lIA0KICAgIHNlbGVjdChZZWFyLCBDb3VudHJ5LCBBZ2UsIGV2ZXJ5dGhpbmcoKSkgJT4lIA0KICAgIG11dGF0ZShQZXJjZW50X0JvdGhfU2V4ZXMgPSBCb3RoX1NleGVzX1BvcHVsYXRpb24gLyBCb3RoX1NleGVzX1BvcHVsYXRpb25bMV0sIA0KICAgICAgICAgICBQZXJjZW50X01hbGUgPSBNYWxlX1BvcHVsYXRpb24gLyBNYWxlX1BvcHVsYXRpb25bMV0sIA0KICAgICAgICAgICBQZXJjZW50X0ZlbWFsZSA9IEZlbWFsZV9Qb3B1bGF0aW9uIC8gRmVtYWxlX1BvcHVsYXRpb25bMV0sIA0KICAgICAgICAgICBTZXhfUmF0aW8gPSBNYWxlX1BvcHVsYXRpb24gLyBGZW1hbGVfUG9wdWxhdGlvbiwgDQogICAgICAgICAgIEFnZSA9IGNhc2Vfd2hlbihBZ2UgPT0gIjAtNCIgfiAiMDAtMDQiLCBBZ2UgPT0gIjUtOSIgfiAiMDUtMDkiLCBUUlVFIH4gQWdlKSkNCiAgDQogIHJldHVybihmaW5hbF9kZikNCiAgDQp9DQoNCg0KDQp2bl8yMDE4X3BvcCA8LSBnZXRfcG9wdWxhdGlvbigiVk0iLCAyMDE4KQ0KDQojPT09PT09PT09PT09PT09PT09PT09PQ0KIyAgICAgTWFrZSAgR3JhcGgNCiM9PT09PT09PT09PT09PT09PT09PT09DQoNCg0KIyBDb2xvcnMgc2VsZWN0ZWQ6IA0KbXlfY29sb3JzIDwtIGMoIiMyRTc0QzAiLCAiI0NCNDU0QSIpDQpteV9mb250IDwtICJSb2JvdG8gQ29uZGVuc2VkIg0KDQoNCnZuXzIwMThfcG9wICU+JSANCiAgc2xpY2UoLWMoMSwgMjE6MjIpKSAlPiUgDQogIHNlbGVjdChBZ2UsIE1hbGVfUG9wdWxhdGlvbiwgRmVtYWxlX1BvcHVsYXRpb24pICU+JSANCiAgbXV0YXRlKE1hbGVfUG9wdWxhdGlvbiA9IC0xKk1hbGVfUG9wdWxhdGlvbikgJT4lIA0KICBnYXRoZXIoR2VuZGVyLCBWYWx1ZSwgLUFnZSkgJT4lIA0KICBnZ3Bsb3QoYWVzKEFnZSwgVmFsdWUsIGZpbGwgPSBHZW5kZXIpKSArIA0KICBnZW9tX2NvbChwb3NpdGlvbiA9ICJzdGFjayIpICsgDQogIGNvb3JkX2ZsaXAoKSArIA0KICBzY2FsZV95X2NvbnRpbnVvdXMoYnJlYWtzID0gc2VxKC01MDAwMDAwLCA1MDAwMDAwLCAxMDAwMDAwKSwgDQogICAgICAgICAgICAgICAgICAgICBsaW1pdHMgPSBjKC01MDAwMDAwLCA1MDAwMDAwKSwgDQogICAgICAgICAgICAgICAgICAgICBsYWJlbHMgPSBjKHBhc3RlMChzZXEoNSwgMCwgLTEpLCAiTSIpLCBwYXN0ZTAoMTo1LCAiTSIpKSkgKyANCiAgdGhlbWVfbWluaW1hbCgpICsgDQogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IG15X2NvbG9ycywgbmFtZSA9ICIiLCBsYWJlbHMgPSBjKCJGZW1hbGUiLCAiTWFsZSIpKSArIA0KICBndWlkZXMoZmlsbCA9IGd1aWRlX2xlZ2VuZChyZXZlcnNlID0gVFJVRSkpICsgDQogIHRoZW1lKHBhbmVsLmdyaWQubWFqb3IueCA9IGVsZW1lbnRfbGluZShsaW5ldHlwZSA9ICJkb3R0ZWQiLCBzaXplID0gMC4yLCBjb2xvciA9ICJncmV5NDAiKSkgKyANCiAgdGhlbWUocGFuZWwuZ3JpZC5tYWpvci55ID0gZWxlbWVudF9ibGFuaygpKSArIA0KICB0aGVtZShwYW5lbC5ncmlkLm1pbm9yLnkgPSBlbGVtZW50X2JsYW5rKCkpICsgDQogIHRoZW1lKHBhbmVsLmdyaWQubWlub3IueCA9IGVsZW1lbnRfYmxhbmsoKSkgKyANCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInRvcCIpICsgDQogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoZmFtaWx5ID0gbXlfZm9udCwgc2l6ZSA9IDI4KSkgKyANCiAgdGhlbWUocGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChmYW1pbHkgPSBteV9mb250LCBzaXplID0gMTMsIGNvbG9yID0gImdyYXk0MCIpKSArIA0KICB0aGVtZShwbG90LmNhcHRpb24gPSBlbGVtZW50X3RleHQoZmFtaWx5ID0gbXlfZm9udCwgc2l6ZSA9IDEyLCBjb2xvdXIgPSAiZ3JleTQwIiwgZmFjZSA9ICJpdGFsaWMiKSkgKyANCiAgdGhlbWUocGxvdC5tYXJnaW4gPSB1bml0KGMoMS4yLCAxLjIsIDEuMiwgMS4yKSwgImNtIikpICsgDQogIHRoZW1lKGF4aXMudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMTMsIGZhbWlseSA9IG15X2ZvbnQpKSArIA0KICB0aGVtZShsZWdlbmQudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMTIsIGZhY2UgPSAiYm9sZCIsIGNvbG9yID0gImdyZXkzMCIsIGZhbWlseSA9IG15X2ZvbnQpKSArIA0KICBsYWJzKHggPSBOVUxMLCB5ID0gTlVMTCwgDQogICAgICAgdGl0bGUgPSAiUG9wdWxhdGlvbiBQeXJhbWlkcyBvZiBWaWV0bmFtIGluIDIwMTgiLA0KICAgICAgIHN1YnRpdGxlID0gIkEgcG9wdWxhdGlvbiBweXJhbWlkIGlsbHVzdHJhdGVzIHRoZSBhZ2Utc2V4IHN0cnVjdHVyZSBvZiBhIGNvdW50cnkncyBwb3B1bGF0aW9uIGFuZCBtYXkgcHJvdmlkZSBpbnNpZ2h0cyBhYm91dFxucG9saXRpY2FsIGFuZCBzb2NpYWwgc3RhYmlsaXR5LCBhcyB3ZWxsIGFzIGVjb25vbWljIGRldmVsb3BtZW50LiBDb3VudHJpZXMgd2l0aCB5b3VuZyBwb3B1bGF0aW9ucyBuZWVkIHRvXG5pbnZlc3QgbW9yZSBpbiBzY2hvb2xzLCB3aGlsZSBjb3VudHJpZXMgd2l0aCBvbGRlciBwb3B1bGF0aW9ucyBuZWVkIHRvIGludmVzdCBtb3JlIGluIHRoZSBoZWFsdGggc2VjdG9yLiIsDQogICAgICAgY2FwdGlvbiA9ICJEYXRhIFNvdXJjZTogaHR0cHM6Ly93d3cuY2Vuc3VzLmdvdiIpDQoNCg0KDQpgYGANCg0K