1 Tổng quan

1.1 Về tập dữ liệu

Dataset Titanic trên Kaggle là một trong những bộ dữ liệu học máy nổi tiếng và được sử dụng phổ biến để thực hành các kỹ thuật phân tích dữ liệu và học máy, đặc biệt là phân loại (classification). Dưới đây là phần sơ lược về dataset này:

Cột	Kiểu dữ liệu	Mô tả
`PassengerId`	`int`	Mã hành khách (duy nhất)
`Survived`	`int` (0 hoặc 1)	Sống sót (1) hoặc tử vong (0)
`Pclass`	`int` (1, 2, 3)	Hạng vé (1 = cao nhất, 3 = thấp nhất)
`Name`	`character`	Tên hành khách
`Sex`	`character`	Giới tính
`Age`	`numeric`	Tuổi
`SibSp`	`int`	Số anh/chị/em hoặc vợ/chồng đi cùng
`Parch`	`int`	Số cha/mẹ hoặc con đi cùng
`Ticket`	`character`	Mã vé
`Fare`	`numeric`	Giá vé
`Cabin`	`character`	Số phòng (thường bị thiếu nhiều)
`Embarked`	`character` (C, Q, S)	Cảng lên tàu: C = Cherbourg, Q = Queenstown, S = Southampton

1.2 Mục tiêu

Khám phá dữ liệu, trực quan hoá bằng các thư viện trong R.
Sử dụng các mô hình học máy để phân loại tình trạng sống sót (Survived).

1.3 Chuẩn bị

Gói lệnh

if (!require("pacman")) install.packages("pacman")
pacman::p_load("readr", "dplyr", "ggplot2", "corrplot",
              "skimr", "FNN", "randomForest")

Dữ liệu

df <- read.csv("Titanic_Dataset.csv", header = TRUE)
df <- df %>% select(- PassengerId)

2 Khám phá và trực quan hoá

2.1 Dữ liệu thiếu

skim_without_charts(df)

Data summary
Name	df
Number of rows	891
Number of columns	11
_______________________
Column type frequency:
character	5
numeric	6
________________________
Group variables	None

Variable type: character

skim_variable	complete_rate	min	max	empty	n_unique
Name	1	12	82	0	891
Sex	1	4	6	0	2
Ticket	1	3	18	0	681
Cabin	1	0	15	687	148
Embarked	1	0	1	2	4

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100
Survived	0	1.0	0.38	0.49	0.00	0.00	0.00	1	1.00
Pclass	0	1.0	2.31	0.84	1.00	2.00	3.00	3	3.00
Age	177	0.8	29.70	14.53	0.42	20.12	28.00	38	80.00
SibSp	0	1.0	0.52	1.10	0.00	0.00	0.00	1	8.00
Parch	0	1.0	0.38	0.81	0.00	0.00	0.00	0	6.00
Fare	0	1.0	32.20	49.69	0.00	7.91	14.45	31	512.33

Có thể thấy: - Bộ dữ liệu có 891 hàng và 11 cột (tức biến). Bao gồm 5 biến ký tự và 6 biến dạng số. - Toàn bộ dữ liệu bị thiếu đều nằm ở biến Age. - Có 177 ô chứa dữ liệu thiếu trong biến Age, chiếm 19.9% của biến Age. - Trên tổng thể quan sát ([số hàng \(\times\) số cột]) số lượng dữ liệu thiếu chiếm 1.8% tổng số quan sát.

paste("Missing data rate:", paste0(round(177/891*100,2), "%"))

## [1] "Missing data rate: 19.87%"

2.2 Biểu đồ trực quan

2.2.1 Tỷ lệ sống sót

df %>% select("Survived") %>% 
  group_by(Survived) %>% 
  count() %>% mutate(r = n/nrow(df)) %>% 
  ggplot(aes(x = 2, y = r, fill = factor(Survived))) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar("y") +
  theme_void() +
  labs(title = "Ratio Survived", fill = "Survived") +
  geom_text(aes(label = paste0(round(r*100,2), "%")),
            position = position_stack(vjust = 0.5))

Nhận xét: 38.38% (chiếm 341) khách hàng sống sót sau tai nạn và 61.62% (chiếm 549) khách hàng tử vong sau tai nạn.

2.2.2 Hạng vé

df %>% 
  ggplot(mapping = aes(x = Pclass, fill = factor(Pclass))) + 
  geom_bar(position = "dodge") + 
  geom_text(stat = 'count', aes(label = ..count..), vjust = 0)+
  facet_wrap(~Survived) +
  labs(fill = "Pclass")

Nhận xét: Khách hàng mua vé hạn nhất (Pclass=1) có số lượng sống sót cao nhất. Vé hạn ba (Pclass=3) có số lượng tử vong nhiều nhất.

2.2.3 Giới tính

df %>%  
  ggplot(mapping = aes(x = Sex, fill = factor(Sex))) + 
  geom_bar(position = "dodge") + 
  geom_text(stat = 'count', aes(label = ..count..), vjust = 0)+
  facet_wrap(~Survived) +
  labs(fill = "Sex")

Nhận xét: Nữ giới có số lượng sống sót cao hơn, đối với nam giới thì ngược lại.

2.2.4 Tuổi

df %>%
  mutate(AgeGroup = case_when(
    Age < 12 ~ "~12",
    Age >= 12 & Age < 18 ~ "13-18",
    Age >= 18 & Age < 40 ~ "19-40",
    Age >= 40 & Age < 60 ~ "41-60",
    Age >= 60 ~ "60~",
    TRUE ~ NA_character_
  )) %>% ggplot(aes(AgeGroup, fill = AgeGroup)) + 
  geom_bar() + 
  geom_text(stat = 'count', aes(label = ..count..), vjust = "bottom") + 
  # theme(legend.title = element_blank(), legend.position = "none") +
  facet_wrap(~ Survived) + 
  labs(fill = "AgeGroup")

Nhận xét: Đổ tuổi của hành khách chủ yếu là khoản 29 đến 40 tuổi. Theo sau đó là nhóm khách hàng không rõ độ tuổi.

2.2.5 Số người thân đi cùng

Bao gồm 2 biến SibSp và Parch

df %>% 
  mutate(FamilySize = SibSp + Parch) %>% 
  ggplot(aes(FamilySize, fill = factor(FamilySize))) + 
  geom_bar() + 
  geom_text(stat = 'count', aes(label = ..count..), vjust = "bottom") + 
  facet_wrap(~ Survived) + 
  labs(fill = "Family Size")

Nhận xét: Đa phần hành khách không đi cùng người thân.

2.2.6 Cảng lên tàu

df %>% mutate(Emd_NA = case_when(
  Embarked == "S" ~ "S",
  Embarked == "C" ~ "C",
  Embarked == "Q" ~ "Q",
  Embarked == "" ~ NA_character_
  )) %>% 
  ggplot(mapping = aes(x = Emd_NA, fill = factor(Emd_NA))) + 
  geom_bar() + 
  geom_text(stat = 'count', aes(label = ..count..), vjust = "bottom") + 
  facet_wrap(~ Survived) + 
  labs(fill = "Embarked")

Nhận xét: Phần lớn hành khác đến từ cảng S-Southampton, nhưng tỷ lệ tử vong lại cao hơn các cảng khác.

2.2.7 Histograms

Trực quan tần số cho biến liến tục:

df %>% ggplot(aes(x = Fare, fill = factor(Survived))) + 
  geom_histogram() + 
  theme(legend.title = element_blank(), legend.position = "none") +
  facet_wrap(~ Survived)

Nhận xét: Phần lớn hành khách chọn giá vé dưới 100 Bảng Anh.

2.2.8 Q-Q plot

Biểu đồ Q-Q (Quantile-Quantile) vị là một cách để hình dung độ lệch khỏi một phân phối xác suất cụ thể. Sau khi phân tích các biểu đồ này, việc áp dụng phép biến đổi toán học (như logarit) cho các mô hình như hồi quy tuyến tính thường có lợi.

df %>% 
  ggplot(aes(sample = Age, colour = factor(Survived))) + 
  stat_qq() + stat_qq_line() + 
  labs(colour = "Survived")

df %>% 
  ggplot(aes(sample = Fare, colour = factor(Survived))) + 
  stat_qq() + stat_qq_line() + 
  labs(colour = "Survived")

Nhận xét:

Biến Age theo cả 2 tình trạng sống sót hay tử vong của biến Survived đều xấp xỉ dường chéo cho thấy biến xấp xỉ phân phối chuẩn.
Biến Fare có các điểm có khoản cách rất xa so với đường chéo chỉ ra độ phân tán của biến rất cao, vậy nên biến không có phân phối chuẩn.

3 Phân tích tương quan

Các biến Age và Fare là các biến có giá trị liên tục. Hai biến SibSp và Parch đều chỉ số lượng người thân cùng đi tàu nên có thể xem là biến liên tục, đồng thời có thể gộp làm một.

Còn các biến Pclass, Sex, SibSp, Parch và Embarked đều là các biến rời rạc nên ta sẽ tạo các biến mã hoá nhị phân cho từng biến.

dfpca <- df %>% 
  mutate(FamilySize = SibSp + Parch,
         Sex_female = as.numeric(Sex=="female"),
         Embarked_S = as.numeric(Embarked=="S"),
         Embarked_Q = as.numeric(Embarked=="Q"),
         Embarked_C = as.numeric(Embarked=="C")
         ) %>% 
  select(c(Survived, Age, Fare, FamilySize, Sex_female, Pclass,
           Embarked_S, Embarked_Q, Embarked_C)) %>% 
  na.omit()

M <- cor(dfpca)
corrplot(M, method = 'color',addCoef.col = 'black')

Trong phân tích bài này ta xoay quanh biến Survived. Từ biểu đồ trên có thể thấy rằng:

Biến Age và FamilySize có hệ số tương quan xấp xỉ 0 cho thấy tuổi và số thành viên trong gia đình của hàng khách không có ảnh hưởng đến tình trạng sống sót hay tử vong.
Biến Fare có hệ số tương quan dương ở mức yếu. Tức là có ảnh hưởng rất thấp với việc sống sót của hành khách. Nếu hành khác mua vé tàu đắt tiền thì có nhiều cở hội sống sót hơn.
Biến Sex_female có hệ số tương quan dương ở mức trung bình (0.54). Tức là nếu người này là nữ giới (Sex_femle=1) thì người này có tỷ lệ sống sot cao hơn.
Biến Pclass có hệ số tương quan âm ở mức trung bình (-0.36). Tức là nếu người này mua vé hạng ba (Pclass=3) thì người này có tỷ lệ tử vong cao hơn. Ngược lại nếu người này mau vé hạng nhất thì tỷ lệ sống sót sẽ tăng lên.
Các biến Embared_ đều có hệ số tương quan rất thấp. Nghĩa là cảng lên của hành khác không có ảnh hưởng đến việc sống sót của khách hàng sau khi tai nạn xảy ra.

4 Xây dựng thuật toán phân loại

4.1 Xây dựng ma trận nhầm lẫn

Trong thực tế ta có thể sử dụng hàm confusionMatrix từ thư viện caret. Nhưng kết quả chứa nhiều kết quả cần có các kiến thức thống kê nâng cao và không cần cho phân tích.

install.packages("caret")
library(caret)

confusionMatrix(as.factor(predicted_class), as.factor(actual_label))

ConfusionMatrix <- function(Predicted = predicted_class, Actual = test_label){
  confusion_matrix <- table(Predicted, Actual)
  TN <- confusion_matrix[1, 1]
  FP <- confusion_matrix[2, 1]
  FN <- confusion_matrix[1, 2]
  TP <- confusion_matrix[2, 2]
  
  accuracy <- round((TP + TN) / sum(confusion_matrix) * 100, 2)
  precision <- round(TP / (TP + FP) * 100, 2)
  recall <- round(TP / (TP + FN) * 100, 2)
  f1_score <- round(2 * (precision * recall) / (precision + recall), 2)
  evaluate <- data.frame(accuracy = accuracy,
                         precision = precision,
                         recall = recall,
                         f1_score = f1_score)
  return(list(
    confusion_matrix = confusion_matrix,
    evaluate = evaluate
  ))
}

Tạo các tập train và test

set.seed(1806)
n <- nrow(dfpca)
index <- sort(sample(1:n, 0.25*n))
train_df <- dfpca[-index,]
test_df <- dfpca[index,2:9]
test_label <- dfpca[index,1]

4.2 Mô hình Logistic

glm_md <- glm(Survived ~ ., data = train_df, family = binomial)
summary(glm_md)

## 
## Call:
## glm(formula = Survived ~ ., family = binomial, data = train_df)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  14.789138 611.909221   0.024  0.98072    
## Age          -0.037087   0.009440  -3.929 8.54e-05 ***
## Fare          0.001475   0.002640   0.559  0.57630    
## FamilySize   -0.292688   0.094824  -3.087  0.00202 ** 
## Sex_female    2.811239   0.266929  10.532  < 2e-16 ***
## Pclass       -1.241811   0.185449  -6.696 2.14e-11 ***
## Embarked_S  -12.229955 611.908910  -0.020  0.98405    
## Embarked_Q  -13.153180 611.909366  -0.021  0.98285    
## Embarked_C  -11.995057 611.908940  -0.020  0.98436    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 723.52  on 535  degrees of freedom
## Residual deviance: 474.21  on 527  degrees of freedom
## AIC: 492.21
## 
## Number of Fisher Scoring iterations: 13

pred_prob <- predict.glm(glm_md, newdata = test_df, 
                              type = "response")
pred_class <- ifelse(pred_prob > 0.5, 1, 0)
ConfusionMatrix(Predicted = pred_class, Actual = test_label)

## $confusion_matrix
##          Actual
## Predicted  0  1
##         0 93 18
##         1 12 55
## 
## $evaluate
##   accuracy precision recall f1_score
## 1    83.15     82.09  75.34    78.57

Chỉ số	Giá trị	Đánh giá
Accuracy	83.15%	Tốt, mô hình phân loại đúng khá cao
Precision	82.09%	Mô hình ít nhầm lẫn dương tính giả
Recall	75.34%	Mô hình bỏ sót khoảng 25% dương tính
F1-score	78.57%	Cân bằng tốt giữa precision và recall

4.3 Mô hình KNN

knn_md <- knn(train_df[2:9], test_df, cl = train_df[,1], k = 20)
pred_class <- knn_md[1:nrow(test_df)]
ConfusionMatrix(Predicted = pred_class, Actual = test_label)

## $confusion_matrix
##          Actual
## Predicted  0  1
##         0 99 35
##         1  6 38
## 
## $evaluate
##   accuracy precision recall f1_score
## 1    76.97     86.36  52.05    64.95

Chỉ số	Giá trị	Đánh giá
Accuracy	76.97%	Tốt, mô hình phân loại tương đối cao
Precision	86.36%	Mô hình ít nhầm lẫn dương tính giả
Recall	52.05%	Mô hình bỏ sót khoảng 48% hành khách sống sót
F1-score	64.95%	Hệ số chưa tốt với bài toán phân loại tình trạng sống sót

4.4 Mô hình Random Forest

set.seed(18)
rf_md <- randomForest(factor(Survived) ~., data = train_df, ntree = 100)
print(rf_md)

## 
## Call:
##  randomForest(formula = factor(Survived) ~ ., data = train_df,      ntree = 100) 
##                Type of random forest: classification
##                      Number of trees: 100
## No. of variables tried at each split: 2
## 
##         OOB estimate of  error rate: 19.4%
## Confusion matrix:
##     0   1 class.error
## 0 300  19  0.05956113
## 1  85 132  0.39170507

pred_class <- predict(rf_md, test_df)
ConfusionMatrix(Predicted = pred_class, Actual = test_label)

## $confusion_matrix
##          Actual
## Predicted  0  1
##         0 99 26
##         1  6 47
## 
## $evaluate
##   accuracy precision recall f1_score
## 1    82.02     88.68  64.38     74.6

Chỉ số	Giá trị	Đánh giá
Accuracy	82.02%	Tốt, mô hình phân loại đúng khá cao
Precision	88.68%	Mô hình ít nhầm lẫn dương tính giả
Recall	64.38%	Mô hình bỏ sót khoảng 36% dương tính
F1-score	74.60%	Cân bằng tốt giữa precision và recall

Explore Data, Visualize, and Build Predictive Models with the Titanic Dataset in R

Vietnamese version

Tran Trong Phuc

August 1, 2025