report.knit

Show code

d-title {
    display: none;
  }

Show code

# Some variables used for the report
teal <- "#3B9AB2"
red <- "#E05D5D"
grey <- "#6D8299"
orange <- "#F8A488"
green <- "#5AA897"
dark <- "#3C415C"
white <- "#F5F5F5"
yellow <- "#FEC260"

Mục tiêu của phân tích

Phân tích được thực hiện nhằm trực quan hoá dữ liệu về Olympics (Thế vận hội) để từ đó người xem có thể:

1. Có được góc nhìn toàn cảnh thế vận hội
2. Thấy được mối quan hệ giữa kinh tế xã hội với thành tích của các quốc gia tại Olympic.

Dữ liệu

Dữ liệu được sử dụng trong phân tích là dữ liệu về các nước tham dự, cũng như thành tích các nước trong thế vận hội từ năm 1896 đến 2016 (120 năm).

Link download

Show code

data <- fread("athlete_events.csv", encoding = "UTF-8")
regions <- fread("noc_regions.csv", encoding = "UTF-8")

Các trường dữ liệu trong tập data trên là:

1. ID - ID unique của từng vận động viên
2. Name - Tên của vận động viên
3. Sex - Giới tính. M: Nam, F: Nữ
4. Age - Tuổi
5. Height - Chiều cao (Đơn vị centimet)
6. Weight - Cân nặng (Đơn vị Kg)
7. Team - Tên đội tuyển (Tên quốc gia)
8. NOC - Đoàn Olympics tham gia (Viết tắt 3 chữ cái của quốc gia)
9. Games - Năm diễn ra và Mùa (Thế vận đội mùa đông và mùa hè)
10. Year - Năm diễn ra
11. Season - Summer: Mùa hè, Winter: Mùa đông
12. City - Thành phố đăng cai
13. Sport - Môn thi đấu
14. Event - Mục thi đấu cụ thể (nằm bên trong môn thi đấu)
15. Medal - Huy chương. Gold: vàng, Silver: bạc, Bronze: đồng, và NA: Không có huy chương

Data frame cụ thể như sau:

Show code

paged_table(data)

Missing data

Tập dữ liệu có một số trường thông tin bị missing ví dụ:

• Height và Weight là các chỉ số đánh giá thể chất của vận động viên nhưng vẫn có một số lượng không nhỏ dữ liệu thiếu thông tin này.
• Age: Tuổi cũng là một thông tin cá nhân của vận động viên (có thể họ không muốn tiết lộ các thông tin cá nhân này) bị thiếu nhưng không quá nhiều.
• Medal: Việc medal có nhiều giá trị rỗng là hợp lý vì không phải vận động viên nào cũng nhận được huy chương.

Như vậy, trừ phi phải sử dụng đến phân tích liên quan đến weight, height và age, nếu không ta không cần xử lý gì dữ liệu bị thiếu này.

Show code

gg_miss_var(data)

Dữ liệu phụ

Nhằm phân tích thêm góc nhìn là khu vực địa lý (châu lục của quốc gia tham gia thế vận hội) ta có sử dụng thêm data về quốc gia và châu lục

Dữ liệu này gồm 2 cột:

• NOC: 3 chữ cái đầu của đoàn tham gia thế vận hội. Sẽ được dùng để join với bảng data chính.
• region: Tên quốc gia đầy đủ. Được dùng để join với dữ liệu châu lục (có sẵn trong thư viện của R)

Bảng data phụ lúc đầu (trước khi join với tên châu lục)

Show code

paged_table(regions)

Bảng data sau khi join với tên châu lục

Show code

regions$continent <- countrycode(
    sourcevar = regions$region,
    origin = "country.name",
    destination = "continent"
)
regions <- regions %>% 
    mutate(
        continent = ifelse(NOC %in% c("FSM", "TUV"), "Oceania", continent),
        continent = ifelse(NOC == "BOL", "Americas", continent),
        continent = ifelse(NOC == "KOS", "Europe", continent),
        continent = ifelse(is.na(continent), "Other", continent),
        # in the athletes_events data the NOC code for Singapore is SGP, not SIN:
        NOC = ifelse(NOC == "SIN", "SGP", NOC)
    )

Show code

paged_table(regions)

Tổng quan về Olympics

Thế vận hội có một số đối tượng mà ta quan tâm:

• Số lượng môn thể thao mỗi kỳ đại hội
• Các quốc gia có bao nhiêu vận động viên tham gia mỗi kỳ
• Số huy chương mà các quốc gia giành được

Ở Olympics người ta thi gì?

Thế vận hội bắt đầu được tổ chức vào năm 1896 và suốt từ đó đến nay, ngoại trừ giai đoạn chiến tranh thế giới, thì cứ 4 năm một lần thế vận hội mùa hè được tổ chức.

Thế vận hội mùa động được bắt đầu năm 1924, sau khi chiến tranh thế giới thứ nhất kết thúc khoảng 10 năm và cũng được tổ chức 4 năm một lần.

Đến những năm 80 thì 2 thế vận hội này không được tổ chức cùng năm nữa mà xen kẽ nhau. Do nếu tổ chức cùng lúc thì quá tốn kém và gây nhiều khó khăn cho ban tổ chức và các quốc gia tham dự.

Số lượng các môn thể thao đã tăng mạnh kể từ những năm 80 cho đến nay, với thế vận hội mùa hè hiện tại có 34 môn còn thế vận hội mùa đông là 15 môn.

Show code

data %>% 
  distinct(Year, Season, Sport) %>% 
  count(Year, Season) %>% 
  ggplot(aes(x = Year, y = n)) +
    geom_col(aes(fill = Season), show.legend = FALSE) +
    facet_grid(Season ~ .) +
    annotate("rect", xmin = 1914, xmax = 1918, ymin = 0, ymax = 35, alpha = 0.2) +
    annotate("text", x = 1916, y = 27, label = "WW I", size = 2) +
    annotate("rect",xmin = 1939, xmax = 1945, ymin = 0, ymax = 35, alpha = 0.2) +
    annotate("text", x = 1942, y = 27, label = "WW II", size = 2) +
    labs(title = "Số lượng môn thi đấu ở từng thế vận hội", y = "Số lượng môn thi đấu", x = "Năm")+
    theme_minimal(base_size = 8, base_family = "sans") +
    theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text(),
      axis.text.x = element_text(angle = 45, vjust = 0.5, hjust=0.5)
    ) +
    scale_y_continuous(breaks=seq(0, 35, 5)) +
    scale_x_continuous(breaks=seq(1896 , 2016, 4)) +
    scale_fill_manual(values=c(red, teal))

Các môn thi đấu

Tại thế vận hội (tính cả mùa hè và mùa đông):

• Các môn được tổ chức thường xuyên nhất (gần 30 lần) là Bơi lội, thể dục dụng cụ, đấu kiếm, đua xe đạp, và điền kinh.

• Các môn có nhiều nội dung thi đấu nhất là Bắn súng, điền kinh (với hơn 80 bộ môn thi đấu từng xuất hiện trong suốt những năm tổ chức thế vận hội). Ít hơn một chút ta thấy có bơi lội và đua xe đạp.

Show code

sports <- data %>% 
  distinct(Year, Sport) %>% 
  count(Sport) %>%
  mutate(top5 = ifelse(n > 28, "top5", "nonTop"))

sport_plot <- sports %>% filter(n > 10) %>%
  ggplot(aes(x = reorder(Sport, n), y = n)) +
    geom_col(aes(fill = top5), show.legend = FALSE) +
    # facet_grid(cols = vars(Season)) +
    coord_flip() +
    theme_minimal(base_size = 7, base_family = "sans") +
    labs(
      title = "Số năm môn thể thao được thi đấu", 
      x = "Môn thể thao", 
      y = "Số năm xuất hiện"
    )+
    theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text()
    ) +
    scale_fill_manual(values=c(grey, red))
    
events <- data %>% 
  distinct(Sport, Event) %>% 
  count(Sport) %>%
  mutate(top5 = ifelse(n > 35, "top5", "nonTop"))

event_plot <- events %>% filter(n > 5) %>%
  ggplot(aes(x = reorder(Sport, n), y = n)) +
    geom_col(aes(fill = top5), show.legend = FALSE) +
    # facet_grid(cols = vars(Season)) +
    coord_flip() +
    theme_minimal(base_size = 7, base_family = "sans") +
    labs(
      title = "Số nội dung thi đấu trong từng môn", 
      x = "Môn thể thao", 
      y = "Số nội dung thi đấu của môn thể thao"
    )+
    theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text()
    ) +
    scale_fill_manual(values=c(grey, red))

grid.arrange(sport_plot, event_plot, ncol=2)

Hầu hết những môn có nhiều nội dung thi đấu thì thường là những môn được tổ chức thường xuyên (trong nhiều năm). Điều này có thể lý giải mối quan hệ 2 chiều là môn nào được tổ chức lâu năm thì người ta sẽ có nhiều thời gian để nghĩ ra thêm nhiều nội dung. Đồng thời môn nào càng có khả năng nghĩ ra được nhiều nội dung thi đấu đa dạng thì càng được ưa chuộng và tổ chức nhiều.

Tất nhiên cũng có những ngoại lệ như Bóng đá, Bóng rổ, hay Hockey những môn thể thao rất phổ biến dù có Olympics hay không.

Show code

sports %>%
  left_join(events, by = c("Sport")) %>%
  rename("years" = "n.x", "events" = "n.y") %>%
  select(Sport, years, events) %>%
  filter(!(Sport %in% c("Ice Hockey", "Water Polo"))) %>%
  mutate(type = ifelse(sqrt(years) > 4 & log(events) < 1, "outlier", "non_oulier")) %>%
  ggplot(aes(x = sqrt(years), y = log(events), label=Sport)) +
    geom_point(aes(color = type), show.legend = FALSE) +
    geom_smooth(method=lm) +
    geom_text(
      aes(
        label=ifelse(sqrt(years) > 4 & log(events) < 1, Sport, '')),
        hjust=0.5,
        vjust=-0.5,
        angle = 20
      ) +
    labs(
      title = "Tương quan số lần môn thể thao xuất hiện và số nội dung thi đấu", 
      x = "Số lần môn thể thao xuất hiện (lấy logarith)", 
      y = "Số nội dung thi đấu của môn thể thao (lấy căn bậc 2)"
    )+
    theme_minimal(base_size = 10, base_family = "sans") +
    theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text()
    ) +
    scale_color_manual(values=c(grey, red))

Các môn thi đấu các nước tham gia

Do có sự khác biệt đáng kể giữa các môn thể thao của thế vận hội mùa đông và mùa hè, nên bắt đầu từ phần này ta sẽ chỉ phân tích Thế vận hội mùa hè.

Trong thế vận hội mùa hè, ta có thể thấy:

• Các bộ môn lâu đời và phổ biến được nhiều quốc gia tham gia tranh tài nhất ví dụ Bơi lội, điền kinh, bắn súng, thể dục dụng cụ, …

• Sau các cuộc chiến tranh thế giới thứ nhất và thứ hai, đã có nhiều môn thể thao bị huỷ bỏ. Ví dụ như Tug of war (kéo co) hoặc Art Competition thì đã được chuyển sang Olympic về nghệ thuật.

• Một số môn mới xuất hiện nhưng đã thu hút được nhiều nước tham gia như Judo, Taekwondo, … đây thường là các bộ môn đã phổ biến ở cộng đồng nhiều nước nhưng đến gần đây mới được Uỷ ban Olympics đưa vào thi đấu.

Show code

knitr::include_graphics("plot_games_by_years.png")

Các quốc gia tham gia như thế nào tại thế vận hội mùa hè

Sự tham gia của các quốc gia tại thế vận hội được thể hiện ở số vận động viên mà họ cử đến ở mỗi môn thể thao.

Show code

# JOIN data với regions để lấy tên region (tên nước chính xác), trong phân tích sau sẽ sử dụng region như là Country
data <- data %>%
  left_join(regions, by = "NOC") %>%
  rename(Country = region)

Những nước nào cử nhiều vận động viên tham gia?

Ta sẽ chia các quốc gia vào các vùng lãnh thổ và xem trung bình mỗi năm thì các nước cử bao nhiêu vận động viên thi đấu, top 5 nước có nhiều vận động viên nhất.

Dễ thấy, các quốc gia lớn, phát triển có nhiều vận động viên tham gia nhất.

Show code

data %>%
  filter(Season == "Summer") %>%
  distinct(Name, Country, Year) %>%
  group_by(Country, Year) %>%
  summarize(athele_counts = n()) %>%
  group_by(Country) %>%
  summarise(year_counts = n(), athele_counts = sum(athele_counts)) %>%
  mutate(avg_athele_counts = round(athele_counts / year_counts, 2)) %>%
  filter(year_counts > 10) %>%
  arrange(avg_athele_counts) %>%
  top_n(10, avg_athele_counts) %>%
  ggplot(aes(x = reorder(Country, avg_athele_counts), y = avg_athele_counts)) +
    geom_col(aes(fill = grey), show.legend = FALSE) +
    coord_flip() +
    labs(
      title = "Những nước có nhiều vận động viên nhất?",
      y = "Số vận động viên trung bình mỗi năm",
      x = "Quốc gia"
    ) +
    theme_minimal(base_size = 10, base_family = "sans") +
    theme(
        text=element_text(),
        plot.title = element_text(face = "bold", hjust = 0.5), # center title
        axis.title = element_text(),
        axis.text = element_text()
    ) +
    scale_fill_manual(values=c(teal))

Nếu xét theo từng châu lục thì:

• Châu đại dương chỉ có 3 nước tham gia: trong đó Úc là nước có đông vận động viên nhất
• Châu Mỹ có sự chênh lệch lớn giữa Mỹ và phần còn lại. Canada thường tham gia nhiều ở thế vận hội mùa đông nên số lượng của họ cũng rất lớn.
• Châu Phi không có sự chênh lệch quá nhiều giữa các nước và số lượng vận động viên cũng ít hơn nhiều so với các quốc gia khác (vì họ mới tham gia những năm gần đây và chưa có đủ kinh tế để đầu tư vào thể thao)
• Châu Á có sự phân hoá giữa Nhật bản, Trung quốc, Hàn quốc và những nước khác. Khá bất ngờ vì Ấn độ mặc dù có dân số rất cao nhưng số vận động viên lại ít hơn nhiều các nước châu Á khác.
• Châu Âu không có sự phân hoá rõ ràng do các nước có kinh tế và truyền thống tương đồng với nhau.

Show code

data %>%
  filter(Season == "Summer") %>%
  distinct(Name, Country, continent, Year) %>%
  group_by(Country, continent, Year) %>%
  summarize(athele_counts = n()) %>% 
  group_by(Country, continent) %>%
  summarise(year_counts = n(), athele_counts = sum(athele_counts)) %>%
  mutate(avg_athele_counts = round(athele_counts / year_counts, 2)) %>%
  filter(year_counts > 10) %>% # Chỉ lấy những nước tham gia trên 10 năm
  group_by(continent) %>%
  slice_max(avg_athele_counts, n = 7, with_ties = F) %>%
  arrange(avg_athele_counts) %>%
  ggplot(aes(x = reorder(Country, avg_athele_counts), y = avg_athele_counts)) +
    geom_col(aes(fill = continent), show.legend = FALSE) +
    coord_flip() +
    labs(
      title = "Số vận động viên trung bình mỗi năm theo các châu lục",
      y = "Số vận động viên trung bình mỗi năm",
      x = "Quốc gia"
    ) +
    theme_minimal(base_size = 10, base_family = "sans") +
    theme(
        text=element_text(),
        plot.title = element_text(face = "bold", hjust = 0.5), # center title
        axis.title = element_text(),
        axis.text = element_text()
    ) +
    facet_wrap(~ continent, scales = "free") +
    scale_fill_manual(values = c(teal, orange, red, green, grey))

Bình đẳng giới tại Olympics mùa hè

Trong quá khứ phụ nữ thường ít khi được cử đi thi đấu, hoặc chính xác hơn là có ít nội dung thi đấu cho nữ nhưng càng ngày thì điều này càng được thay đổi.

Gần đây, số vận động viên nữ tham gia cũng đang tiến gần bằng số lượng vận động viên nam.

• Trước giai đoạn thế chiến thứ I (năm 1914) tỷ lệ vận động viên nữ rất thấp, đây là giai đoạn đầu của olympic vì thế có rất ít môn dành cho nữ, quyền lợi của phụ nữ lúc này cũng rất hạn chế.

• Sau thế chiến thứ II (năm 1945) tỷ lệ này đã tăng mạnh lên 18% và tiếp tục tăng những năm sau đó, thời điểm này thì nữ quyền bắt đầu được chú ý hơn và nhiều môn thể thao cho nữ ra đời.

• Sau chiến tranh lạnh (1989) tỷ lệ này đã đạt hơn 30% và tăng đến gần 50% trong những năm gần đây, vì sự thay đổi nhận thức của cộng đồng với hoạt động thể thao dành cho phụ nữ, lúc này phụ nữ đã tham gia thế vận hội không kém nam giới.

Show code

knitr::include_graphics("female_percent.png")

Các quốc gia đạt thành tích gì tại thế vận hội mùa hè

Thành tích của quốc gia được thể hiện ở số huy chương mà họ giành được ở mỗi môn thể thao.

Ta sẽ xét 10 quốc gia có số lượng huy chương lớn nhất trong lịch sử thế vận hội mùa hè:

• Dễ thấy Mỹ dẫn đầu thế giới với số lượng huy chương khá áp đảo

• Phía sau là Nga, Anh, Đức, Pháp các nước châu Âu lớn có số huy chương tương tự nhau.

• Một cường quốc là Trung quốc do mới tham gia Olympic chưa lâu nên số lượng huy chương không thể so sánh với những nước phát triển trên.

• Nga và Đức vẫn là những đối trọng lớn nhất của Mỹ trong lĩnh vực thể thao.

Show code

m <- data %>%
  distinct(Country, Medal, Event, Games) %>%
  group_by(Country, Medal) %>%
  summarize(medal_counts = n()) %>%
  filter(!is.na(Medal)) %>%
  spread(Medal, medal_counts) %>%
  mutate(sum_medal = Gold + Silver + Bronze) %>%
  filter(sum_medal >= 512) %>%
  select(-sum_medal) %>%
  pivot_longer(!Country, names_to = "Medal", values_to = "count") %>%
  arrange(-count)

mat <- acast(m, Country~Medal, value.var="count")

chorddiag(mat[order(rowSums(mat),decreasing=F),], type = "bipartite", palette2 = "Paired", showTicks = FALSE, width = 700, height = 700)

Để phản ánh thành tích các quốc gia ở thế vận hội một cách chính xác và cập nhật hơn, ta sẽ xét Số huy chương mà các quốc gia giành được trong 10 kỳ thế vận hội gần nhất (tính từ năm 1988, khi Liên xô bắt đầu tan rã và Trung quốc tham gia thường xuyên ở Olympics). Ta cũng chỉ xét thế vận hội mùa hè.

• Mỹ vẫn dẫn đầu về tổng số huy chương, ngay phía sau là Nga, Đức và Trung Quốc. Có thể thấy trong những kỳ thế vận hội mùa hè gần đây thì Trung Quốc đang dần theo kịp các quốc gia lớn khác.

• Đã xuất hiện các quốc gia châu Á khác như Nhật, Hàn bên cạnh sự thống trị của các nước châu Âu

Show code

m2 <- data %>%
  filter(Year >= 1988, Season == "Summer") %>%
  distinct(Country, Medal, Event, Games) %>%
  group_by(Country, Medal) %>%
  summarize(medal_counts = n()) %>%
  filter(!is.na(Medal)) %>%
  spread(Medal, medal_counts) %>%
  mutate(sum_medal = Gold + Silver + Bronze) %>% 
  filter(sum_medal >= 204) %>%
  select(-sum_medal) %>%
  pivot_longer(!Country, names_to = "Medal", values_to = "count") %>%
  arrange(-count)

mat2 <- acast(m2, Country~Medal, value.var="count")

chorddiag(mat2[order(rowSums(mat2),decreasing=F),], type = "bipartite", palette2 = "RdYlBu", showTicks = FALSE, width = 700, height = 700)

Cụ thể theo thời gian, số lượng huy chương và thứ hạng của các nước đã thay đổi như thế nào?

• Một số nước vào top 10 được 1 năm rồi sau đó lại bị rơi ra ngoài, ví dụ Hàn Quốc, Tây Ban Nha, …

• Một số nước rất ổn định trong top 10, trừ Mỹ thì có Anh, Đức, Trung Quốc, Australia, Nga

• Có những kỳ Olympics Mỹ áp đảo hoàn toàn các nước khác, nhưng cũng có những kỳ không có nhiều chênh lệch ví dụ Olympics năm 2000 khi Nga gần đạt thành tích ngang Mỹ.

• 2008 do là nước chủ nhà nên Trung Quốc vượt Nga để trở thành nước đứng thứ 2.

Show code

race <- data %>%
  filter(Year >= 1988, Season == "Summer") %>%
  distinct(Country, Medal, Event, Year) %>%
  group_by(Country, Year, Medal) %>%
  summarize(medal_counts = n()) %>%
  filter(!is.na(Medal)) %>%
  spread(Medal, medal_counts) %>%
  mutate(sum_medal = Gold + Silver + Bronze) %>%
  arrange(Year, desc(sum_medal)) %>% 
  group_by(Year) %>% 
  mutate(rank=row_number()) %>%
  filter(rank <= 10)

barChartRace(
  data = race,
  x = "sum_medal",
  y = "Country",
  time = "Year",
  xtitle = "Tổng số huy chương",
  transitionDur = 4000,
  frameDur = 0,
  ease = "CubicInOut",
  title = "Số huy chương các nước giành được từng năm (1988 - 2016)",
  titleFontSize = 17,
  bgcol = "#FFFFFF",
  panelcol = "#F5F5F5",
  colorCategory = "Paired"
)

Thể hiện số huy chương các đoàn thể thao giành được trên bản đồ thế giới:

• Mặc dù khu vực Bắc Mỹ có số huy chương rất lớn nhưng Nam Mỹ lại có ít nước giành được huy chương.

• Châu Phi có nhiều nước không có huy chương hoặc giành được rất ít.

• Ở châu Á khu vực Nam Á, Đông Nam Á có rất ít nước có huy chương.

• Châu Âu thì các nước phân bố huy chương khá đồng đều, không có nhiều sự chênh lệch, trừ Đức có nhiều hơn hẳn các nước khác.

• Bắc bán cầu có thành tích ở Olympics tốt hơn nhiều so với Nam bán cầu.

Show code

# MAP NATIONS WITH MOST MEDALS WON
medals_NOC <- data %>% 
  filter(!is.na(Medal), Season == "Summer", Year >= 1988)%>% 
  distinct(NOC, Medal, Event, Year) %>%
  group_by(NOC) %>%
  summarize(count = n()) %>%
  left_join(regions, by = "NOC") %>%
  group_by(region) %>%
  summarize(count = sum(count))

earth <- map_data("world")

earth <- left_join(earth, medals_NOC, by="region")

# PLOT MAP
earth %>% 
  ggplot(aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill = count), colour = dark, size = 0.2) +
  labs(
    x = "", 
    y = "", 
    title="Tổng số huy chương của các nước (từ 1988)" 
  ) +
  guides(fill=guide_colourbar(title="Tổng số huy chương")) +
  scale_fill_gradient(low=white, high=yellow) +
  theme_minimal(base_size = 10, base_family = "sans") +
  theme(
    text=element_text(),
    plot.title = element_text(face = "bold", hjust = 0.5, size=9), # center title
    panel.grid = element_blank(),
    axis.text.y = element_blank(),
    axis.text.x = element_blank()
  )

Mối liên hệ giữa thành tích tại Olympic và các yếu tố khác

Câu hỏi đặt ra là liệu GDP, dân số, HDI (chỉ số phát triển con người) của 1 quốc gia có tương quan gì với Olympic không.

Tương quan giữa GDP và thành tích tại Olympic:

• Một số quốc gia có GDP/người rất cao như Qatar, Nauy, UAE nhưng thành tích tại Olympic lại thấp.

• Trung Quốc thì ở tình trạng ngược lại khi GDP đầu người của họ thấp nhưng thành tích tại Olympic lại tốt

• Các nước như Mỹ, Anh, Đức thì có tương quan đồng biến giữa GDP đầu người và thành tích tại Olympic thể hiện ở việc, GDP đầu người càng cao thì thành tích càng tốt.

Nếu không tính các ngoại lệ như UAE, Trung quốc, … thì có mối liên hệ đồng biến khá rõ giữa GDP đầu người và thành tích tại Olympic.

Show code

gdp <- fread("gdp.csv", header = TRUE, encoding = "UTF-8")

gdp$IOC <- countrycode(sourcevar = gdp$country, origin = "country.name", destination = "ioc")

gdp$Continent <- countrycode(
  sourcevar = gdp$country, origin = "country.name", destination = "continent"
)

OG_years <- data %>% 
  distinct(Year) %>% 
  pull()

gdp_long <- gdp %>% 
  pivot_longer(-c(country, IOC, Continent), names_to = "Year", values_to = "GDPpc", names_transform = list(Year = as.integer)) %>% 
  filter(Year %in% OG_years)

gdp_medal_rel <- gdp_long %>%
  left_join(
    data %>% 
    filter(!is.na(Medal), Season == "Summer", Year >= 1988)%>% 
    distinct(NOC, Medal, Event, Year) %>%
    group_by(NOC, Year) %>%
    summarize(count = n()),
    
    by = c("IOC" = "NOC", "Year" = "Year")
  ) %>% 
  filter(count > 0)
  
gdp_medal_rel <- gdp_medal_rel %>%
  mutate(type = case_when(
    sqrt(GDPpc) > 250 & count < 20 ~ "rich_low",
    sqrt(GDPpc) < 150 & count > 45 ~ "poor_high",
    sqrt(GDPpc) > 150 & count > 45 ~ "rich_high",
    TRUE ~ "other"
  ))

Show code

gdp_medal_rel %>%
  ggplot(aes(x = sqrt(GDPpc), y = count)) +
  geom_point(size=2, shape=23, aes(color = type), show.legend = FALSE) +
  geom_text_repel(
    aes(label=country, color = type),
    max.overlaps = 10,
    show.legend = FALSE
  ) +
  theme_minimal(base_size = 10, base_family = "sans") +
  labs(
    x = "GDP bình quân đầu người (đã lấy căn bậc 2)",
    y = "Số huy chương"
  ) +
  theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text()
  ) +
  scale_color_manual(values = c(dark, teal, red, green))

Nếu xét chỉ số HDI

Show code

hdi <- fread("hdi.csv", header = TRUE, encoding = "UTF-8", fill = TRUE)

hdi <- hdi %>%
  select(-contains("V") & -contains("HDI"))

hdi$IOC <- countrycode(sourcevar = hdi$Country, origin = "country.name", destination = "ioc")

hdi$Continent <- countrycode(
  sourcevar = hdi$Country, origin = "country.name", destination = "continent"
)

hdi <- hdi %>%
  filter(!is.na(IOC))

hdi_long <- hdi %>% 
  pivot_longer(-c(Country, IOC, Continent), names_to = "Year", values_to = "HDI", names_transform = list(Year = as.integer)) %>% 
  filter(Year %in% OG_years & HDI != "..")

hdi_gdp_medal_rel <- gdp_medal_rel %>%
  left_join(
    hdi_long %>% select(IOC, Year, HDI),
    by = c("IOC" = "IOC", "Year" = "Year")
  ) %>%
  filter(!is.na(HDI))

Ta thấy rõ một sự phân hoá giữa các nước khi sử dụng HDI, các nước có số huy chương cao được phân thành 2 nhóm khá rõ là nhóm có HDI cao và HDI thấp

Như vậy nếu kết hợp cả 2 chiều là HDI và GDP bình quân thì có thể phân loại khá tốt các nước ở Olympic.

Show code

hdi_gdp_medal_rel %>%
  mutate(HDI = as.double(HDI)) %>%
  ggplot(aes(x = HDI, y = count)) +
  geom_point(size=2, shape=23, aes(color = type), show.legend = FALSE) +
  geom_text_repel(
    aes(label=country, color = type),
    max.overlaps = 10,
    show.legend = FALSE
  ) +
  theme_minimal(base_size = 10, base_family = "sans") +
  theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text()
  ) +
  labs(
    x = "Chỉ số phát triển con người HDI",
    y = "Số huy chương"
  ) +
  scale_color_manual(values = c(dark, teal, red, green))

Ta thử vẽ đồ thị với cả 2 chiều HDI và GDP bình quân đầu người:

Như vậy, có tương quan mạnh và đồng biến giữa GDP bình quân đầu người, HDI với số lượng huy chương quốc gia giành được. Bên cạnh đó ta cũng thấy được sự tương quan giữa GDP bình quân với HDI.

Show code

hdi_gdp_medal_rel %>%
  mutate(HDI10 = as.double(HDI) * 10) %>%
  ggplot(aes(x = HDI10, y = sqrt(GDPpc))) +
  geom_point(aes(size=count, color = count)) +
  geom_text_repel(
    aes(label=country),
    max.overlaps = 10
  ) +
  theme_minimal(base_size = 10, base_family = "sans") +
  theme(
      text=element_text(),
      plot.title = element_text(face = "bold", hjust = 0.5), # center title
      axis.title = element_text(),
      axis.text = element_text()
  ) +
  labs(
    x = "Chỉ số phát triển con người HDI (nhân 10)",
    y = "GDP bình quân đầu người (đã lấy căn bậc 2)",
    color = "Số huy chương",
    size = "Số huy chương"
  ) +
  scale_color_gradient(low=dark, high=red)