PHÂN TÍCH DỮ LIỆU ĐỊNH TÍNH: BÀI THỰC HÀNH

1. GIỚI THIỆU ĐỀ TÀI

1.1. Tai nạn chìm tàu Titanic

Cách đây 112 năm (năm 1912), tàu Titanic đã chìm xuống Đại Tây Dương trong chuyến đi đầu tiên của nó và khiến hàng nghìn người thiệt mạng.

Tàu Titanic, tên gọi đầy đủ là Royal Mail Ship Titanic được xem là con tàu lớn, hiện đại bậc nhất trong đầu thế kỷ 20 và được xem là “kiến trúc hàng hải” vĩ đại. Thậm chí, với những tiến bộ công nghệ được áp dụng vào tàu RMS Titanic, lúc bấy giờ con tàu này được cho là không thể chìm.

Titanic bắt đầu hành trình từ cảng Southampton, phía Đông Nam nước Anh vào ngày 10 tháng 4 năm 1912. Tuy nhiên, chỉ sau năm ngày ra khơi, tàu va chạm với một tảng băng trôi và chìm trong lòng Đại Tây Dương, khiến hơn 1.500 người thiệt mạng.

Cho đến nay, sự kiện Titanic vẫn luôn được nhớ đến như một thảm họa bi thảm trong lịch sử hàng hải.

1.2. Ý tưởng của bài thực hành

Trong sự kiện thảm họa Titanic, có khoảng 700 người sống sót khỏi tai họa chìm tàu. Trong đó, phần lớn những người đàn ông đã nhường “xuất” lên xuồng cứu sinh cho nhiều phụ nữ và trẻ em. Do đó, kết quả thống kê số người sống sót thuộc giới tính nữ và trẻ em cao hơn rất nhiều so với phần còn lại.

Như vậy, nhằm xác định “tỷ lệ/ khả năng” sống sót theo giới tính và theo độ tuổi, tôi tiến hành thực hiện bài thực hành này.

2. DỮ LIỆU THỰC HÀNH

Dữ liệu về thông tin về tình trạng sống sót, giới tính, tuổi và hạng ghế của 1309 hành khách trong thảm họa Titanic năm 1912.

Bộ dữ liệu gồm 1309 quan sát với 4 biến sau:

- survived (tình trạng sống sót): yes (sống)/ no (chết).

- Sex (giới tính): male (nam)/ female (nữ)

- Age (độ tuổi):tính bằng năm (và đối với một số trẻ em, phân số của một năm); dữ liệu trống đối với 263 hành khách.

- PassengerClass (hạng ghế): hạng nhất, nhì, ba

Trong bài thực hành này, biến được giải thích là Tình trạng sống sót với các biến giải thích là Giới tính và Độ tuổi.

3. PHƯƠNG PHÁP THỰC HÀNH

Bài thực hành được dựa trên bài giảng Phân tích dữ liệu định tính với đường link sau: https://rpubs.com/tmt/1186442.

Dữ liệu thực hành:

data <- read_excel("C:/Users/84896/Desktop/Thầy Tường/TitanicSurvival.xlsx")
DATA <- data
datatable(DATA)

4. Kết quả thực hành

4.1. Bảng tần số (Frequency Table)

4.1.1. Biến: Tình trạng sống sót

Tình trạng Số hành khách
Sống sót 500
Thiệt mạng 809
Sum 1309

4.1.2. Biến: Giới tính

Giới tính Số hành khách
Nam 843
Nữ 466
Sum 1309

4.1.3. Biến: Khoảng độ tuổi

Khoảng độ tuổi Số hành khách
DƯới 10 tuổi 74
Từ 10 đến 20 tuổi 162
Từ 20 đến 35 tuổi 476
Từ 35 đến 55 tuổi 263
Từ 55 tuổi trở lên 59
Sum 1034

4.2. Bảng ngẫu nhiên (Contingency Table)

kable(addmargins2(table(DATA$`Giới tính`, DATA$`Tình trạng`)))
Sống sót Thiệt mạng Tổng cộng
Nam 161 682 843
Nữ 339 127 466
Tổng cộng 500 809 1309

Nhận xét:

  • Trong tổng số 1309 hành khách, có 466 hành khách nữ và 843 hành khách nam. Số hành khách thiệt mạng là 809, nhiều hơn số hành khách sống sót khoảng 62%.

  • Số hành khách nữ sống sót là 339, cao hơn 212 so với số hành khách nữ thiệt mạng. Trong khi đó, số hành khách nam sống sót là 161 người, thấp hơn rất nhiều (521 người) so với số hành khách nam thiệt mạng.

DATA$`Già & Trẻ` <- cut(DATA$`Độ tuổi`, breaks = c(1, 16, 100), labels = c('Trẻ em', 'Người lớn'), include.lowest = TRUE)
kable(addmargins2(table(DATA$`Già & Trẻ`,DATA$`Tình trạng`)))
Sống sót Thiệt mạng Tổng cộng
Trẻ em 64 58 122
Người lớn 353 559 912
Tổng cộng 417 617 1034

Nhận xét:

  • Trong tổng số 1309 hành khách, có 122 hành khách là trẻ em và 912 hành khách là người lớn. Số hành khác thiệt mạng là 617, nhiều hơn số hành khách sống sót khoảng 48%. Nguyên nhân số quan sát giảm từ 1309 xuống còn 1034 do dự thiếu hụt thông tin về độ tuổi đối với một số hành khách.

  • Số hành khách là trẻ em mà sống sót là 64 cao hơn 8 hành khách so với số hành khách là trẻ em mà thiệt mạng (khoảng 10%). Trong khi đó, số hành khách là người lớn sống sót là 353 người, thấp hơn 206 hành khách so với số hành là người lớn thiệt mạng (khoảng 58%).

4.3. Ước lượng Relative Risk

kable(matrix(data=c('Relative Risk', table(DATA$`Giới tính`, DATA$`Tình trạng`) %>% RelRisk())))
Relative Risk
0.262533373924424
kable(matrix(data=c('Relative Risk',table(DATA$`Già & Trẻ`, DATA$`Tình trạng`) %>% RelRisk())))
Relative Risk
1.35531509775693

4.4. Ước lượng Odds Ratio

kable(matrix(data=c('Odds Ratio', table(DATA$`Giới tính`, DATA$`Tình trạng`) %>% OddsRatio())))
Odds Ratio
0.0884393463611277
kable(matrix(data=c('Odds Ratio', table(DATA$`Giới tính`, DATA$`Già & Trẻ`) %>% OddsRatio())))
Odds Ratio
0.56938775510204

4.5. Khoảng ước lượng cho tỷ lệ

a <- c(843, 466)
b <- c(161, 339)
prop.test(b,a)
## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  b out of a
## X-squared = 363.62, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.5865065 -0.4864599
## sample estimates:
##    prop 1    prop 2 
## 0.1909846 0.7274678

4.6. Kiểm định tính độc lập

4.6.1. Tình trạng sống sót & Giới tính

table(DATA$`Giới tính`, DATA$`Tình trạng`) %>% chisq.test
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  .
## X-squared = 363.62, df = 1, p-value < 2.2e-16

4.6.2. Tình trạng sống sót & Già, Trẻ

table(DATA$`Giới tính`, DATA$`Già & Trẻ`) %>% chisq.test
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  .
## X-squared = 8.0182, df = 1, p-value = 0.004631

4.7. Mô hình xác suất tuyến tính

tmp <- DATA %>% mutate(`Tình trạng` = ifelse(`Tình trạng` == "Sống sót", 1, 0))
lm(`Tình trạng` ~ `Độ tuổi`, data = tmp)
## 
## Call:
## lm(formula = `Tình trạng` ~ `Độ tuổi`, data = tmp)
## 
## Coefficients:
## (Intercept)    `Độ tuổi`  
##    0.464814    -0.001894

4.8. Mô hình Logit

glm(`Tình trạng` ~ `Độ tuổi`, data = tmp, family = binomial(link = 'logit'))
## 
## Call:  glm(formula = `Tình trạng` ~ `Độ tuổi`, family = binomial(link = "logit"), 
##     data = tmp)
## 
## Coefficients:
## (Intercept)    `Độ tuổi`  
##   -0.136531    -0.007899  
## 
## Degrees of Freedom: 1045 Total (i.e. Null);  1044 Residual
##   (263 observations deleted due to missingness)
## Null Deviance:       1415 
## Residual Deviance: 1411  AIC: 1415

4.9. Mô hình Probit

glm(`Tình trạng` ~ `Độ tuổi`, data = tmp, family = binomial(link = 'probit'))
## 
## Call:  glm(formula = `Tình trạng` ~ `Độ tuổi`, family = binomial(link = "probit"), 
##     data = tmp)
## 
## Coefficients:
## (Intercept)    `Độ tuổi`  
##   -0.087036    -0.004872  
## 
## Degrees of Freedom: 1045 Total (i.e. Null);  1044 Residual
##   (263 observations deleted due to missingness)
## Null Deviance:       1415 
## Residual Deviance: 1411  AIC: 1415