library(rmarkdown)
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5     ✓ purrr   0.3.4
## ✓ tibble  3.1.6     ✓ dplyr   1.0.7
## ✓ tidyr   1.1.4     ✓ stringr 1.4.0
## ✓ readr   2.1.1     ✓ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(VIM)
## Loading required package: colorspace
## Loading required package: grid
## VIM is ready to use.
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
## 
## Attaching package: 'VIM'
## The following object is masked from 'package:datasets':
## 
##     sleep
library(naniar)
library(mice)
## 
## Attaching package: 'mice'
## The following object is masked from 'package:stats':
## 
##     filter
## The following objects are masked from 'package:base':
## 
##     cbind, rbind
library(chorddiag)
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths

Phần 1: Dữ liệu

1.1. Import số liệu

dat1 <- read.csv("athlete_events.csv")
paged_table(head(dat1))

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

1.2. Missing Data

gg_miss_var(dat1)
## Warning: It is deprecated to specify `guide = FALSE` to remove a guide. Please
## use `guide = "none"` instead.

aggr(dat1, numbers = T)
## Warning in plot.aggr(res, ...): not enough horizontal space to display
## frequencies

mcar_test(dat1)
## # A tibble: 1 × 4
##   statistic    df p.value missing.patterns
##       <dbl> <dbl>   <dbl>            <int>
## 1   160993.   193       0               16

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.

dat2 <- read.csv("noc_regions.csv")

1.2. Merge 2 bộ số liệu

dat <- dat1 %>% left_join(dat2, by = "NOC")
input_missing <- dat %>% 
  select(Weight, Age) %>%
  mice(method = "sample", m = 1) %>%
  complete() %>%
  mutate(Height = dat$Height, .before = 1) %>%
  mice(method = "norm.nob", m = 1) %>%
  complete()
## 
##  iter imp variable
##   1   1  Weight  Age
##   2   1  Weight  Age
##   3   1  Weight  Age
##   4   1  Weight  Age
##   5   1  Weight  Age
## 
##  iter imp variable
##   1   1  Height
##   2   1  Height
##   3   1  Height
##   4   1  Height
##   5   1  Height
dat$Height <- input_missing$Height
dat$Weight <- input_missing$Weight
dat$Age <- input_missing$Age
write.csv(dat, file = "dat.csv")

dat <- read.csv("dat.csv")

cor(dat$Height, dat$Weight)
## [1] 0.7834591

#2. Bình đẳng giới tại Olympic

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.

dat %>% 
  filter(Season == "Summer") %>%
  mutate(Year_char = as.character(Year)) %>%
  group_by(Year_char, Sex) %>%
  summarise(athlete_counts = n()) %>%
  mutate(
    athlete_female = ifelse(Sex == "F", athlete_counts, F),
  ) %>%
  summarise(
    athlete_female = sum(athlete_female), 
    athlete_counts = sum(athlete_counts)
  ) %>%
  mutate(
    athlete_female_percent = paste(round(athlete_female/athlete_counts, 2) * 100, "%")
  ) %>%
  ggplot(aes(x = reorder(Year_char, desc(Year_char)), y = (athlete_counts), label = athlete_female_percent)) +
    geom_col(width = 1, colour = "white") + 
    geom_col(aes(y = athlete_counts / 2), width = 0.9, colour = "white", size = 0.2) +
    geom_col(
      aes(
        reorder(Year_char, desc(Year_char)), y = (athlete_female), 
        fill = "orange"
      ),
      width = 0.5,
      show.legend = F
    ) +
    geom_text(aes(y = athlete_female + 450), size = 2.5, colour = "orange") +
    coord_flip() + 
    theme_minimal(base_size = 9) +
    labs(
      x = "",
      y = "Tỷ lệ động viên nữ (màu cam) trên tổng số vận động viên (màu đen)",
      title = "Tỷ lệ nữ vận động viên theo thời gian"
    ) +
    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_blank()
    )
## `summarise()` has grouped output by 'Year_char'. You can override using the `.groups` argument.

3. Thành tích của các quốc gia

m <- dat %>%
  distinct(NOC, Medal, Event, Games) %>%
  group_by(NOC, 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(!NOC, names_to = "Medal", values_to = "count") %>%
  arrange(-count)
## `summarise()` has grouped output by 'NOC'. You can override using the `.groups` argument.
mat <- acast(m, NOC~Medal, value.var="count")

groupColors <- c("gold", "silver", "brown")
chorddiag(
  mat[order(rowSums(mat),decreasing=F),], 
  type = "bipartite", 
  palette2 = "Paired", 
  showTicks = FALSE, 
  width = 500, 
  height = 500,
  groupColors = groupColors
)
m2 <- dat %>%
  filter(Year >= 1988, Season == "Summer") %>%
  distinct(NOC, Medal, Event, Games) %>%
  group_by(NOC, 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(!NOC, names_to = "Medal", values_to = "count") %>%
  arrange(-count)
## `summarise()` has grouped output by 'NOC'. You can override using the `.groups` argument.
mat2 <- acast(m2, NOC~Medal, value.var="count")

groupColors <- c("silver",  "brown", "gold")
chorddiag(
  mat2[order(rowSums(mat2),decreasing=F),], 
  type = "bipartite", 
  palette2 = "RdYlBu", 
  showTicks = FALSE, 
  width = 500,
  height = 500,
  groupColors = groupColors
)