Introduction

Life Expectancy (tuổi thọ) là thước đo để đánh giá sức khỏe dân số, nó cho chúng ta biết tuổi chết trung bình của một quốc gia. GDP per Capita (Tổng sản phẩm quốc nội bình quân đầu người) là một số liệu GDP của mỗi quốc gia trên cơ sở mỗi cá nhân để đo lường mức độ giàu có của một quốc gia.

Ở bài viết này, tôi thực hiện minh họa mối quan hệ giữa Life Expectancy và GDP per Capita của một số nước trong khu vực Châu Á năm 2018. Dữ liệu được thu thập từ ngân hàng thế giới (World Bank Group).

rm(list = ls())
#Load packages:
library(tidyverse)
library(extrafont)
library(ggthemes)
library(grid)
library(ggrepel)
library(scales)
library(ggsci)
library(wbstats)


# General information in list structure: 

ge_inf <- wb_cachelist

# Show some basic information: 

str(ge_inf, max.level = 1)

# Extract data frame that contains general information for countries

df_countries <- ge_inf[[1]]

#  Indicators provided by wb

indicators <- ge_inf[[2]]

# A list of indicators: 

indi <- c("SP.POP.TOTL", "SP.DYN.LE00.IN", "NY.GDP.PCAP.PP.CD")

indicators %>% 
  filter(indicator_id %in% indi) %>% 
  select(1:2)

# Collect some indicators for some nations:

df_ren <- wb(country = "all",
             indicator = indi,
             startdate = 2016,
             enddate = 2020)

# Rename some columns and filter data for year of 2016: 
df_ren_1 <- df_ren %>% 
  filter(date == 2018) %>% 
  select(country, iso2c, indicatorID, value)

# Convert to wide form and rename for some columns: 

df_ren_1 %>% 
  ungroup() %>% 
  spread(key = "indicatorID", value = "value") %>% 
  na.omit() %>% 
  rename(Pop = SP.POP.TOTL, Life = SP.DYN.LE00.IN, GDP = NY.GDP.PCAP.PP.CD) -> my_df_Ren

# Filter our data (remove Aggregates label): 
df_countries %>% 
  mutate_if(is.factor, as.character) %>% 
  filter(income_level != "Aggregates") %>% 
  select(iso2c, region, income_level) -> income

# Meger data sets and remove missing points: 

df_me <- right_join(my_df_Ren, income, by = "iso2c") %>% 
  na.omit()

my_font <- "Roboto"


my_country <- c("Vietnam", "China", "India", "Thailand", "Malaysia", "Kazakhstan", "Cambodia", "Korea, Rep.", "Japan", "Brazil", "Indonesia", "Singapore", "Bhutan","Iran", "Iraq","Australia", "Philippines", "Lao PDR") # Select some nations. 


df_me %>% 
  filter(GDP < 100000) %>% 
  ggplot(aes(GDP, Life, size = Pop, color = income_level)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", formula = y ~ log(x), color = "orange", alpha = 0.1, se = FALSE) +
  geom_text_repel(data = df_me %>% filter(country %in% my_country),
                  aes(label = country), color = "grey20", size = 5, force = 19, family = my_font) +
  scale_x_continuous(breaks = seq(0, 100000, 10000), labels = dollar) +
  scale_y_continuous(breaks = seq(50, 85, 5)) +
  scale_size(range = c(1,30)) +
  scale_color_lancet(name = "") +
  guides(size = FALSE) +
  theme(legend.position = c(0.83, 0.30)) + 
  theme(legend.title = element_text(size = 30, face = "bold", family = my_font)) + 
  theme(plot.margin = unit(c(1, 1, 1, 1), "cm")) + 
  theme(plot.title = element_text(family = my_font, size = 30, color = "grey10")) + 
  theme(plot.caption = element_text(family = my_font, size = 12, color = "grey40", face = "italic")) + 
  theme(axis.text = element_text(family = my_font, size = 14, color = "gray30")) + 
  theme(legend.text = element_text(family = my_font, size = 12, color = "grey30")) + 
  theme(legend.title = element_text(family = my_font, size = 30, color = "grey30")) + 
  theme(axis.title = element_text(family = my_font, size = 30)) + 
  theme(panel.grid.minor = element_blank()) +
  theme(plot.background = element_rect(fill = "seashell", color = NA)) +
  labs(x = "GDP per Capita", 
       y = "Life Expectancy",
       title = "Life Expectancy vs GDP per Capita in 2018",
       caption = "Data Source: The World Bank") +
  theme_minimal()

LS0tDQp0aXRsZTogIlByYWN0aWNlIDU6IExpZmUgRXhwZWN0YW5jeSB2cyBHRFAgcGVyIENhcGl0YSBpbiAyMDE4Ig0KYXV0aG9yOiAiTmd1eWVuIFRoaSBOZ29jIEh1eWVuIg0KZGF0ZTogIjMvMTQvMjAyMSINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQ0KICAgIGNvZGVfZm9sZGluZzogaGlkZQ0KICAgIGhpZ2hsaWdodDogemVuYnVybg0KICAgICMgbnVtYmVyX3NlY3Rpb25zOiB5ZXMNCiAgICB0aGVtZTogZmxhdGx5DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQotLS0NCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUsIHdhcm5pbmcgPSBGQUxTRSwgbWVzc2FnZSA9IEZBTFNFLCBmaWcud2lkdGggPSAxMCwgZmlnLmhlaWdodCA9IDYpDQpgYGANCg0KIyBJbnRyb2R1Y3Rpb24NCg0KTGlmZSBFeHBlY3RhbmN5ICh0deG7lWkgdGjhu40pIGzDoCB0aMaw4bubYyDEkW8gxJHhu4MgxJHDoW5oIGdpw6Egc+G7qWMga2jhu49lIGTDom4gc+G7kSwgbsOzIGNobyBjaMO6bmcgdGEgYmnhur90IHR14buVaSBjaOG6v3QgdHJ1bmcgYsOsbmggY+G7p2EgbeG7mXQgcXXhu5FjIGdpYS4NCkdEUCBwZXIgQ2FwaXRhIChU4buVbmcgc+G6o24gcGjhuqltIHF14buRYyBu4buZaSBiw6xuaCBxdcOibiDEkeG6p3UgbmfGsOG7nWkpIGzDoCBt4buZdCBz4buRIGxp4buHdSBHRFAgY+G7p2EgbeG7l2kgcXXhu5FjIGdpYSB0csOqbiBjxqEgc+G7nyBt4buXaSBjw6EgbmjDom4gxJHhu4MgxJFvIGzGsOG7nW5nIG3hu6ljIMSR4buZIGdpw6B1IGPDsyBj4bunYSBt4buZdCBxdeG7kWMgZ2lhLg0KDQrhu54gYsOgaSB2aeG6v3QgbsOgeSwgdMO0aSB0aOG7sWMgaGnhu4duIG1pbmggaOG7jWEgbeG7kWkgcXVhbiBo4buHIGdp4buvYSBMaWZlIEV4cGVjdGFuY3kgdsOgIEdEUCBwZXIgQ2FwaXRhIGPhu6dhIG3hu5l0IHPhu5Egbsaw4bubYyB0cm9uZyBraHUgduG7sWMgQ2jDonUgw4EgbsSDbSAyMDE4LiBE4buvIGxp4buHdSDEkcaw4bujYyB0aHUgdGjhuq1wIHThu6sgbmfDom4gaMOgbmcgdGjhur8gZ2nhu5tpIChXb3JsZCBCYW5rIEdyb3VwKS4NCg0KDQpgYGB7cixldmFsPUZBTFNFfQ0Kcm0obGlzdCA9IGxzKCkpDQojTG9hZCBwYWNrYWdlczoNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShleHRyYWZvbnQpDQpsaWJyYXJ5KGdndGhlbWVzKQ0KbGlicmFyeShncmlkKQ0KbGlicmFyeShnZ3JlcGVsKQ0KbGlicmFyeShzY2FsZXMpDQpsaWJyYXJ5KGdnc2NpKQ0KbGlicmFyeSh3YnN0YXRzKQ0KDQoNCiMgR2VuZXJhbCBpbmZvcm1hdGlvbiBpbiBsaXN0IHN0cnVjdHVyZTogDQoNCmdlX2luZiA8LSB3Yl9jYWNoZWxpc3QNCg0KIyBTaG93IHNvbWUgYmFzaWMgaW5mb3JtYXRpb246IA0KDQpzdHIoZ2VfaW5mLCBtYXgubGV2ZWwgPSAxKQ0KDQojIEV4dHJhY3QgZGF0YSBmcmFtZSB0aGF0IGNvbnRhaW5zIGdlbmVyYWwgaW5mb3JtYXRpb24gZm9yIGNvdW50cmllcw0KDQpkZl9jb3VudHJpZXMgPC0gZ2VfaW5mW1sxXV0NCg0KIyAgSW5kaWNhdG9ycyBwcm92aWRlZCBieSB3Yg0KDQppbmRpY2F0b3JzIDwtIGdlX2luZltbMl1dDQoNCiMgQSBsaXN0IG9mIGluZGljYXRvcnM6IA0KDQppbmRpIDwtIGMoIlNQLlBPUC5UT1RMIiwgIlNQLkRZTi5MRTAwLklOIiwgIk5ZLkdEUC5QQ0FQLlBQLkNEIikNCg0KaW5kaWNhdG9ycyAlPiUgDQogIGZpbHRlcihpbmRpY2F0b3JfaWQgJWluJSBpbmRpKSAlPiUgDQogIHNlbGVjdCgxOjIpDQoNCiMgQ29sbGVjdCBzb21lIGluZGljYXRvcnMgZm9yIHNvbWUgbmF0aW9uczoNCg0KZGZfcmVuIDwtIHdiKGNvdW50cnkgPSAiYWxsIiwNCiAgICAgICAgICAgICBpbmRpY2F0b3IgPSBpbmRpLA0KICAgICAgICAgICAgIHN0YXJ0ZGF0ZSA9IDIwMTYsDQogICAgICAgICAgICAgZW5kZGF0ZSA9IDIwMjApDQoNCiMgUmVuYW1lIHNvbWUgY29sdW1ucyBhbmQgZmlsdGVyIGRhdGEgZm9yIHllYXIgb2YgMjAxNjogDQpkZl9yZW5fMSA8LSBkZl9yZW4gJT4lIA0KICBmaWx0ZXIoZGF0ZSA9PSAyMDE4KSAlPiUgDQogIHNlbGVjdChjb3VudHJ5LCBpc28yYywgaW5kaWNhdG9ySUQsIHZhbHVlKQ0KDQojIENvbnZlcnQgdG8gd2lkZSBmb3JtIGFuZCByZW5hbWUgZm9yIHNvbWUgY29sdW1uczogDQoNCmRmX3Jlbl8xICU+JSANCiAgdW5ncm91cCgpICU+JSANCiAgc3ByZWFkKGtleSA9ICJpbmRpY2F0b3JJRCIsIHZhbHVlID0gInZhbHVlIikgJT4lIA0KICBuYS5vbWl0KCkgJT4lIA0KICByZW5hbWUoUG9wID0gU1AuUE9QLlRPVEwsIExpZmUgPSBTUC5EWU4uTEUwMC5JTiwgR0RQID0gTlkuR0RQLlBDQVAuUFAuQ0QpIC0+IG15X2RmX1Jlbg0KDQojIEZpbHRlciBvdXIgZGF0YSAocmVtb3ZlIEFnZ3JlZ2F0ZXMgbGFiZWwpOiANCmRmX2NvdW50cmllcyAlPiUgDQogIG11dGF0ZV9pZihpcy5mYWN0b3IsIGFzLmNoYXJhY3RlcikgJT4lIA0KICBmaWx0ZXIoaW5jb21lX2xldmVsICE9ICJBZ2dyZWdhdGVzIikgJT4lIA0KICBzZWxlY3QoaXNvMmMsIHJlZ2lvbiwgaW5jb21lX2xldmVsKSAtPiBpbmNvbWUNCg0KIyBNZWdlciBkYXRhIHNldHMgYW5kIHJlbW92ZSBtaXNzaW5nIHBvaW50czogDQoNCmRmX21lIDwtIHJpZ2h0X2pvaW4obXlfZGZfUmVuLCBpbmNvbWUsIGJ5ID0gImlzbzJjIikgJT4lIA0KICBuYS5vbWl0KCkNCg0KbXlfZm9udCA8LSAiUm9ib3RvIg0KDQoNCm15X2NvdW50cnkgPC0gYygiVmlldG5hbSIsICJDaGluYSIsICJJbmRpYSIsICJUaGFpbGFuZCIsICJNYWxheXNpYSIsICJLYXpha2hzdGFuIiwgIkNhbWJvZGlhIiwgIktvcmVhLCBSZXAuIiwgIkphcGFuIiwgIkJyYXppbCIsICJJbmRvbmVzaWEiLCAiU2luZ2Fwb3JlIiwgIkJodXRhbiIsIklyYW4iLCAiSXJhcSIsIkF1c3RyYWxpYSIsICJQaGlsaXBwaW5lcyIsICJMYW8gUERSIikgIyBTZWxlY3Qgc29tZSBuYXRpb25zLiANCg0KDQpkZl9tZSAlPiUgDQogIGZpbHRlcihHRFAgPCAxMDAwMDApICU+JSANCiAgZ2dwbG90KGFlcyhHRFAsIExpZmUsIHNpemUgPSBQb3AsIGNvbG9yID0gaW5jb21lX2xldmVsKSkgKw0KICBnZW9tX3BvaW50KGFscGhhID0gMC41KSArDQogIGdlb21fc21vb3RoKG1ldGhvZCA9ICJsbSIsIGZvcm11bGEgPSB5IH4gbG9nKHgpLCBjb2xvciA9ICJvcmFuZ2UiLCBhbHBoYSA9IDAuMSwgc2UgPSBGQUxTRSkgKw0KICBnZW9tX3RleHRfcmVwZWwoZGF0YSA9IGRmX21lICU+JSBmaWx0ZXIoY291bnRyeSAlaW4lIG15X2NvdW50cnkpLA0KICAgICAgICAgICAgICAgICAgYWVzKGxhYmVsID0gY291bnRyeSksIGNvbG9yID0gImdyZXkyMCIsIHNpemUgPSA1LCBmb3JjZSA9IDE5LCBmYW1pbHkgPSBteV9mb250KSArDQogIHNjYWxlX3hfY29udGludW91cyhicmVha3MgPSBzZXEoMCwgMTAwMDAwLCAxMDAwMCksIGxhYmVscyA9IGRvbGxhcikgKw0KICBzY2FsZV95X2NvbnRpbnVvdXMoYnJlYWtzID0gc2VxKDUwLCA4NSwgNSkpICsNCiAgc2NhbGVfc2l6ZShyYW5nZSA9IGMoMSwzMCkpICsNCiAgc2NhbGVfY29sb3JfbGFuY2V0KG5hbWUgPSAiIikgKw0KICBndWlkZXMoc2l6ZSA9IEZBTFNFKSArDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9IGMoMC44MywgMC4zMCkpICsgDQogIHRoZW1lKGxlZ2VuZC50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMzAsIGZhY2UgPSAiYm9sZCIsIGZhbWlseSA9IG15X2ZvbnQpKSArIA0KICB0aGVtZShwbG90Lm1hcmdpbiA9IHVuaXQoYygxLCAxLCAxLCAxKSwgImNtIikpICsgDQogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoZmFtaWx5ID0gbXlfZm9udCwgc2l6ZSA9IDMwLCBjb2xvciA9ICJncmV5MTAiKSkgKyANCiAgdGhlbWUocGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGZhbWlseSA9IG15X2ZvbnQsIHNpemUgPSAxMiwgY29sb3IgPSAiZ3JleTQwIiwgZmFjZSA9ICJpdGFsaWMiKSkgKyANCiAgdGhlbWUoYXhpcy50ZXh0ID0gZWxlbWVudF90ZXh0KGZhbWlseSA9IG15X2ZvbnQsIHNpemUgPSAxNCwgY29sb3IgPSAiZ3JheTMwIikpICsgDQogIHRoZW1lKGxlZ2VuZC50ZXh0ID0gZWxlbWVudF90ZXh0KGZhbWlseSA9IG15X2ZvbnQsIHNpemUgPSAxMiwgY29sb3IgPSAiZ3JleTMwIikpICsgDQogIHRoZW1lKGxlZ2VuZC50aXRsZSA9IGVsZW1lbnRfdGV4dChmYW1pbHkgPSBteV9mb250LCBzaXplID0gMzAsIGNvbG9yID0gImdyZXkzMCIpKSArIA0KICB0aGVtZShheGlzLnRpdGxlID0gZWxlbWVudF90ZXh0KGZhbWlseSA9IG15X2ZvbnQsIHNpemUgPSAzMCkpICsgDQogIHRoZW1lKHBhbmVsLmdyaWQubWlub3IgPSBlbGVtZW50X2JsYW5rKCkpICsNCiAgdGhlbWUocGxvdC5iYWNrZ3JvdW5kID0gZWxlbWVudF9yZWN0KGZpbGwgPSAic2Vhc2hlbGwiLCBjb2xvciA9IE5BKSkgKw0KICBsYWJzKHggPSAiR0RQIHBlciBDYXBpdGEiLCANCiAgICAgICB5ID0gIkxpZmUgRXhwZWN0YW5jeSIsDQogICAgICAgdGl0bGUgPSAiTGlmZSBFeHBlY3RhbmN5IHZzIEdEUCBwZXIgQ2FwaXRhIGluIDIwMTgiLA0KICAgICAgIGNhcHRpb24gPSAiRGF0YSBTb3VyY2U6IFRoZSBXb3JsZCBCYW5rIikgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KDQpgYGANCg0KIVtdKEQ6XFJcTEUgdnMgR0RQIDIwMTgucG5nKQ0K