macttt
Trần Thị Thu Cẩm
12/06/2023
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'tidyr' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'purrr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'stringr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(tidyselect)## Warning: package 'tidyselect' was built under R version 3.6.3library(epitools)## Warning: package 'epitools' was built under R version 3.6.3library(DescTools)## Warning: package 'DescTools' was built under R version 3.6.3library(dplyr)
library(ggplot2)
library(caTools)## Warning: package 'caTools' was built under R version 3.6.3library(caret)## Warning: package 'caret' was built under R version 3.6.3## Loading required package: lattice##
## Attaching package: 'caret'## The following objects are masked from 'package:DescTools':
##
## MAE, RMSE## The following object is masked from 'package:purrr':
##
## liftlibrary(fBasics)## Warning: package 'fBasics' was built under R version 3.6.3## Loading required package: timeDate## Loading required package: timeSerieslibrary(lmtest)## Warning: package 'lmtest' was built under R version 3.6.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 3.6.3##
## Attaching package: 'zoo'## The following object is masked from 'package:timeSeries':
##
## time<-## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericFile dữ liệu: <>
da<-file.choose()
da1<-file.choose()
train<-read.csv(da, header = T)
test<-read.csv(da1, header = T)mac<-train %>%
mutate(Pclass = factor(Pclass), Sex = factor(Sex), Survived = factor(Survived)) %>%
select(-c("Ticket", "Cabin", "Name", "PassengerId"))1 Nhiệm vụ tuần 6
Chạy mô hình hồi quy cho biến định lượng trong câu 2, thức hiện các bài toán liên quan
PHÂN TÍCH CÁC YẾU TỐ ẢNH HƯỞNG ĐẾN GIá VÉ KHÁCH HÀNG TRẢ
1.1 Mô hình hồi quy
mac1<-mac%>% select(-c("Survived"))
lm.fit<-lm(formula = Fare ~., data = mac1)
summary(lm.fit)##
## Call:
## lm(formula = Fare ~ ., data = mac1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -72.06 -11.16 -0.08 5.53 427.81
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 95.5862 5.2674 18.147 < 2e-16 ***
## Pclass2 -60.4349 3.9995 -15.111 < 2e-16 ***
## Pclass3 -69.5676 3.4991 -19.881 < 2e-16 ***
## Sexmale -5.3558 2.7981 -1.914 0.0559 .
## Age -0.1632 0.1068 -1.528 0.1268
## SibSp 5.4925 1.2814 4.286 2.02e-05 ***
## Parch 9.7900 1.7740 5.519 4.49e-08 ***
## EmbarkedQ -11.4845 5.4534 -2.106 0.0355 *
## EmbarkedS -13.7248 3.4176 -4.016 6.42e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 37.57 on 882 degrees of freedom
## Multiple R-squared: 0.4336, Adjusted R-squared: 0.4285
## F-statistic: 84.42 on 8 and 882 DF, p-value: < 2.2e-16Hệ số R-squared = 0,4336 cho biết các biến độc lập trong mô hình giải thích được 43,36% sự biến thiên của biến giá vé khách hàng trả.
Các biến có ý nghĩa thống kê bao gồm: Pclass, Pclass3, Sexmale, Sibsp, EmbarkedQ, EmbarkedS. Độ tuổi không có tác động đáng kể đến giá vé khách hàng trả.
1.2 Kiểm định khuyết tật của mô hình
1.2.1 Kiểm định hiện tượng đa cộng tuyến
VIF(lm.fit)## GVIF Df GVIF^(1/(2*Df))
## Pclass 1.374361 2 1.082743
## Sex 1.128114 1 1.062127
## Age 1.219717 1 1.104408
## SibSp 1.259139 1 1.122114
## Parch 1.289534 1 1.135576
## Embarked 1.214149 2 1.049707Kết quả tính toán cho thấy hệ số VIF của các biến đểu nhỏ hơn 10. Do đó, mh không bị đa cộng tuyến cao
1.2.2 Kiểm định phương sai sai số thay đổi
bptest(lm.fit)##
## studentized Breusch-Pagan test
##
## data: lm.fit
## BP = 49.653, df = 8, p-value = 4.765e-08Giả thuyết H0: "MH không có PSSS thay đổi"
P-value < 5%, bác bỏ giả tuyết H0 do đó MH có phương sai sai số thay đổi.
1.2.3 Kiểm định tự tương quan
Box.test(lm.fit$residuals, lag = 2, type = "Ljung-Box")##
## Box-Ljung test
##
## data: lm.fit$residuals
## X-squared = 0.89769, df = 2, p-value = 0.6384Giả thuyết H0: "MH không có tự tương quan bậc 2"
P-value > 5%, chưa đủ cơ sở bác bỏ giả tuyết H0 do đó MH không có tự tương quan bậc 2
1.2.4 Kiểm định phần dư tuân theo phân phối chuẩn
normalTest(lm.fit$residuals)##
## Title:
## Shapiro - Wilk Normality Test
##
## Test Results:
## STATISTIC:
## W: 0.563
## P VALUE:
## < 2.2e-16
##
## Description:
## Wed Aug 23 07:06:27 2023 by user: AdministratorGiả thuyết H0: Phần dư của mô hình có phân phối chuẩn
Với pvalue < 1% , bác bỏ H0 nên phần dư của mô hình không có phân phối chuẩn.
2 Nhiệm vụ tuần 5
Chạy mô hình hồi quy cho biến định tính trong câu 2, thức hiện các bài toán liên quan
2.1 Ma trận hệ số tương quan
# Chọn các biến số liên tục trong mô hình
continuous_vars <- mac[, sapply(mac, is.numeric)]
# Tính ma trận tương quan
cor_matrix <- cor(continuous_vars)
cor_matrix## Age SibSp Parch Fare
## Age 1.00000000 -0.2332963 -0.1724820 0.09668842
## SibSp -0.23329633 1.0000000 0.4148377 0.15965104
## Parch -0.17248195 0.4148377 1.0000000 0.21622494
## Fare 0.09668842 0.1596510 0.2162249 1.000000002.2 Mô hình hồi quy
2.2.1 Mô hình logit
Mô hình có biến phụ thuộc: survived và các biến độc lập bao gồm 3 biến định tính: Pclass, Sex, Embarked và 4 biến định lượng bao gồm: Age, Sibsp, Parch, Fare.
mh1 <- glm(Survived ~., family = binomial(link = 'logit'), data = mac)
summary(mh1)##
## Call:
## glm(formula = Survived ~ ., family = binomial(link = "logit"),
## data = mac)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.6169 -0.6089 -0.4172 0.6077 2.4526
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.070966 0.472692 8.612 < 2e-16 ***
## Pclass2 -0.914816 0.297481 -3.075 0.00210 **
## Pclass3 -2.147100 0.297781 -7.210 5.58e-13 ***
## Sexmale -2.716589 0.201048 -13.512 < 2e-16 ***
## Age -0.038573 0.007859 -4.908 9.19e-07 ***
## SibSp -0.320902 0.109163 -2.940 0.00329 **
## Parch -0.092618 0.118881 -0.779 0.43593
## Fare 0.002312 0.002468 0.937 0.34876
## EmbarkedQ -0.065598 0.380949 -0.172 0.86328
## EmbarkedS -0.447119 0.239171 -1.869 0.06156 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1186.66 on 890 degrees of freedom
## Residual deviance: 784.83 on 881 degrees of freedom
## AIC: 804.83
##
## Number of Fisher Scoring iterations: 5# Kiểm định sự phù hợp của mô hình bằng cách tính giá trị Prob(LR statistic)
lr_test <- anova(mh1, test = "Chisq")
# Lấy giá trị Prob(LR statistic)
p_value <- lr_test$Pr[2]
p_value## [1] 3.273615e-23Kiểm định sự phù hơp của mô hình
Giả thuyết H0: mô hình không phù hợp Với P-value = Prob(LR) < 0 bác bỏ giả thuyết H0 nên mô hình phù hợp với dữ liệu.
2.2.2 Mô hình Probit
Các biến trong mô hình 2 là các biến trong mô hình 1 đã loại bỏ đi biến Parch (do biến này không có ý nghĩa thống kê)
mh2 <- glm(Survived ~., family = binomial(link = 'probit'), data = mac)
summary(mh2)##
## Call:
## glm(formula = Survived ~ ., family = binomial(link = "probit"),
## data = mac)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7275 -0.6211 -0.4169 0.6179 2.4829
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.368483 0.266165 8.899 < 2e-16 ***
## Pclass2 -0.526840 0.173499 -3.037 0.00239 **
## Pclass3 -1.203571 0.169609 -7.096 1.28e-12 ***
## Sexmale -1.607835 0.112394 -14.305 < 2e-16 ***
## Age -0.022014 0.004457 -4.939 7.83e-07 ***
## SibSp -0.189313 0.061177 -3.095 0.00197 **
## Parch -0.063797 0.070036 -0.911 0.36234
## Fare 0.001522 0.001436 1.060 0.28932
## EmbarkedQ -0.076019 0.216703 -0.351 0.72574
## EmbarkedS -0.265159 0.136619 -1.941 0.05227 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1186.66 on 890 degrees of freedom
## Residual deviance: 786.05 on 881 degrees of freedom
## AIC: 806.05
##
## Number of Fisher Scoring iterations: 5# Kiểm định sự phù hợp của mô hình bằng cách tính giá trị Prob(LR statistic)
lr_test <- anova(mh2, test = "Chisq")
# Lấy giá trị Prob(LR statistic)
p_value <- lr_test$Pr[2]
p_value## [1] 3.273615e-23Kiểm định sự phù hơp của mô hình
Giả thuyết H0: mô hình không phù hợp Với P-value = Prob(LR) = 0, 0000 < 5% bác bỏ giả thuyết H0 nên mô hình phù hợp với dữ liệu.
2.2.3 Mô hình cloglog
Do biến Fare không có ý nghĩa thống kê nên tiếp tục loại bỏ biến này và chạy lại mô hình(MH3)
mh3 <- glm(Survived ~., family = binomial(link = 'cloglog'), data = mac)
summary(mh3)##
## Call:
## glm(formula = Survived ~ ., family = binomial(link = "cloglog"),
## data = mac)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.2381 -0.6618 -0.4522 0.5306 2.3060
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.3131943 0.3070927 7.533 4.98e-14 ***
## Pclass2 -0.5145602 0.2028800 -2.536 0.0112 *
## Pclass3 -1.5652794 0.2100747 -7.451 9.26e-14 ***
## Sexmale -1.9892230 0.1347215 -14.765 < 2e-16 ***
## Age -0.0228365 0.0053914 -4.236 2.28e-05 ***
## SibSp -0.1983802 0.0791471 -2.506 0.0122 *
## Parch -0.0777190 0.0839388 -0.926 0.3545
## Fare 0.0006759 0.0014975 0.451 0.6517
## EmbarkedQ 0.0411503 0.2549513 0.161 0.8718
## EmbarkedS -0.3593093 0.1619217 -2.219 0.0265 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1186.66 on 890 degrees of freedom
## Residual deviance: 775.19 on 881 degrees of freedom
## AIC: 795.19
##
## Number of Fisher Scoring iterations: 7# Kiểm định sự phù hợp của mô hình bằng cách tính giá trị Prob(LR statistic)
lr_test <- anova(mh3, test = "Chisq")
# Lấy giá trị Prob(LR statistic)
p_value <- lr_test$Pr[2]
p_value## [1] 3.273615e-23Kiểm định sự phù hơp của mô hình
Giả thuyết H0: mô hình không phù hợp Với P-value = Prob(LR) = 0, 0000 < 5% bác bỏ giả thuyết H0 nên mô hình phù hợp với dữ liệu.
2.2.4 Lựa chọn mô hình phù hợp
2.2.4.1 Tiêu chỉ AIC
AIC(MH logit) = 804,83
AIC(MH probit) = 806,05
AIC(MH cloglog) = 795,19
Mô hình cloglog có AIC nhỏ nhất nên ta chọn MH cloglog
2.2.4.2 Deviance
Deviance(MH logit) = 784,83
Deviance(MH probit) = 786,05
Deviance(MH cloglog) = 775,19
Mô hình cloglog deviance nhỏ nhất nên ta chọn MH cloglog
2.2.4.3 Brier Score
BrierScore(mh1)## [1] 0.1392707BrierScore(mh2)## [1] 0.1397801BrierScore(mh3)## [1] 0.1371204Dựa vào tiêu chí Brier score ta thấy MH cloglog có giá trị nhỏ nhất nên ta chọn MH cloglog
2.2.4.4 Ma trận nhầm lẫn
Mô hình logit
predictions <- predict(mh1, newdata = mac, type = "response")
predicted_classes <- ifelse(predictions > 0.5, "1", "0") # Chỉnh ngưỡng phân loại
predictions1<-factor(predicted_classes, levels = c("0","1"))
actual<- factor(mac$Survived, labels = c("0","1"))
confusionMatrix(table(predictions1, actual))## Confusion Matrix and Statistics
##
## actual
## predictions1 0 1
## 0 477 102
## 1 72 240
##
## Accuracy : 0.8047
## 95% CI : (0.7771, 0.8303)
## No Information Rate : 0.6162
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.5802
##
## Mcnemar's Test P-Value : 0.02791
##
## Sensitivity : 0.8689
## Specificity : 0.7018
## Pos Pred Value : 0.8238
## Neg Pred Value : 0.7692
## Prevalence : 0.6162
## Detection Rate : 0.5354
## Detection Prevalence : 0.6498
## Balanced Accuracy : 0.7853
##
## 'Positive' Class : 0
## MH logit có độ chính xác toàn thể là 80,47%, độ nhạy là 86,89% và độ hiệu quả là 70,18%
Mô hình probit
predictions <- predict(mh2, newdata = mac, type = "response")
predicted_classes <- ifelse(predictions > 0.5, "1", "0") # Chỉnh ngưỡng phân loại
predictions1<-factor(predicted_classes, levels = c("0","1"))
actual<- factor(mac$Survived, labels = c("0","1"))
confusionMatrix(table(predictions1, actual))## Confusion Matrix and Statistics
##
## actual
## predictions1 0 1
## 0 474 102
## 1 75 240
##
## Accuracy : 0.8013
## 95% CI : (0.7736, 0.8271)
## No Information Rate : 0.6162
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.5737
##
## Mcnemar's Test P-Value : 0.05067
##
## Sensitivity : 0.8634
## Specificity : 0.7018
## Pos Pred Value : 0.8229
## Neg Pred Value : 0.7619
## Prevalence : 0.6162
## Detection Rate : 0.5320
## Detection Prevalence : 0.6465
## Balanced Accuracy : 0.7826
##
## 'Positive' Class : 0
## MH probit có độ chính xác toàn thể là 80,13%, độ nhạy là 86,34% và độ hiệu quả là 70,18%
Mô hình cloglog
predictions <- predict(mh3, newdata = mac, type = "response")
predicted_classes <- ifelse(predictions > 0.5, "1", "0") # Chỉnh ngưỡng phân loại
predictions1<-factor(predicted_classes, levels = c("0","1"))
actual<- factor(mac$Survived, labels = c("0","1"))
confusionMatrix(table(predictions1, actual))## Confusion Matrix and Statistics
##
## actual
## predictions1 0 1
## 0 492 110
## 1 57 232
##
## Accuracy : 0.8126
## 95% CI : (0.7854, 0.8377)
## No Information Rate : 0.6162
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.5918
##
## Mcnemar's Test P-Value : 5.725e-05
##
## Sensitivity : 0.8962
## Specificity : 0.6784
## Pos Pred Value : 0.8173
## Neg Pred Value : 0.8028
## Prevalence : 0.6162
## Detection Rate : 0.5522
## Detection Prevalence : 0.6756
## Balanced Accuracy : 0.7873
##
## 'Positive' Class : 0
## MH cloglog có độ chính xác toàn thể là 81,26%, độ nhạy là 89,62% và độ hiệu quả là 67,84%
MH cloglog có độ chính xác, độ nhạy cao nhất trong 3 MH do đó chọn mô hình cloglog
Kết luận: Dựa vào 4 tiêu chuẩn trên ta thấy MH cloglog là mô hình được chọn nhiều nhất (4 tiêu chí) do đó thực hiện dự báo hành khách sống sót ta chọn MH cloglog
2.3 Kết quả của mô hình cloglog
summary(mh3)##
## Call:
## glm(formula = Survived ~ ., family = binomial(link = "cloglog"),
## data = mac)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.2381 -0.6618 -0.4522 0.5306 2.3060
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.3131943 0.3070927 7.533 4.98e-14 ***
## Pclass2 -0.5145602 0.2028800 -2.536 0.0112 *
## Pclass3 -1.5652794 0.2100747 -7.451 9.26e-14 ***
## Sexmale -1.9892230 0.1347215 -14.765 < 2e-16 ***
## Age -0.0228365 0.0053914 -4.236 2.28e-05 ***
## SibSp -0.1983802 0.0791471 -2.506 0.0122 *
## Parch -0.0777190 0.0839388 -0.926 0.3545
## Fare 0.0006759 0.0014975 0.451 0.6517
## EmbarkedQ 0.0411503 0.2549513 0.161 0.8718
## EmbarkedS -0.3593093 0.1619217 -2.219 0.0265 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1186.66 on 890 degrees of freedom
## Residual deviance: 775.19 on 881 degrees of freedom
## AIC: 795.19
##
## Number of Fisher Scoring iterations: 72.3.1 Giải thích kết quả
Kết quả phân tích hồi quy cloglog cho thấy, 9 biến đưa vào mô hình hồi quy để phân tích nhưng kết quả phân tích chỉ có 6 biến độc lập có ý nghĩa thống kê bao gồm:
- Pclass2: Hạng vé Middle
- Pclass3: Hạng vé Lower
- Sexmale: giới tính nam
- Age: tuổi
- SibSp: Số anh chị em/ vợ chồng trên tàu
- EmbarkedS: cảng lên tàu: Southampton
Với giả thuyết các yếu tố khác không đổi, ảnh hưởng của từng biến đến được diễn giải như sau:
Hạng vé khác nhau sẽ có tác động đáng kể đến khả năng sống sót của hành khách. Ở mức ý nghĩa 5% thì hành khách có hạng vé Middle sẽ có xác suất sống sót cao hơn 44,996 % so với hạng vé Upper. Ở mức ý nghĩa 1% hạng vé Lower sẽ có xác suất sống sót cao hơn 18,86% so với hạng vé Upper.
Giới tính của hành khách có tác động đáng kể đến khả năng sống sót sau vụ chìm tàu. Ở mức ý nghĩa 1% hành khách nam sẽ có xác suất sống sót cao hơn 12,79% so với hành khách nữ.
Ở mức ý nghĩa 1%, Độ tuổi có tác động tiêu cực lên khả năng sống sot của hành khách.
- Ở mức ý nghĩa 5%, Số anh chị em/ vợ chồng trên tàu có tác động tiêu cực lên khả năng sống sót của hành khách.
Vị trí cảng lên tàu khác nhau sẽ có tác động đáng kể đến khả năng sống sót của hành khách. Ở mức ý nghĩa 5% thì hành khách lên tàu từ cảng S sẽ có xác suất sống sót cao hơn 50,25 % so với hành khách lên tàu từ cảng C.
2.3.2 Dự báo
test<-test %>%
mutate(Pclass = factor(Pclass), Sex = factor(Sex))
predictions <- predict(mh3, newdata = test, type = "response")
head(round(predictions,4),10)## 1 2 3 4 5 6 7 8 9 10
## 0.1286 0.3400 0.1897 0.1038 0.4948 0.1371 0.6722 0.2185 0.7552 0.08183 Nhiệm vụ tuần 3,4
Làm thống kê mô tả cho ít nhất 7 biến (vừa định tính định lượng và có 2 biến đã chọn ở câu 2) nhận xét về kết quả phân tích này.
3.1 Thống kê mô tả cho 1 biến
3.1.1 Biến Survied
table(mac$Survived)##
## 0 1
## 549 342table(mac$Survived)/sum(table(mac$Survived))##
## 0 1
## 0.6161616 0.3838384Có 549 hành khách mất sau vụ chìm tàu Titanic chiếm tỷ lệ 61,62% (tổng số hành khách) và 34 hành khách còn sống chiếm tỷ lệ 38,38% (tổng số hành khách)
ggplot(mac,aes(Survived))+
geom_bar(color = "blue", fill = "green")+
geom_text(aes(label = scales :: percent(after_stat(count/sum(count)))), stat= 'count', color = 'black', vjust = -.5)+
ylab("Number of Passenger")+ xlab("Survival")
3.1.2 Biến Pclass
table(mac$Pclass)##
## 1 2 3
## 216 184 491Có 216 hành khách mua hạng vé Upper, 184 hành khách mua hạng vé Middle, 491 hành khách mua hạng vé Lower.
ggplot(mac,aes(Pclass))+
geom_bar(color = "blue", fill = "green")+
geom_text(aes(label = scales :: percent(after_stat(count/sum(count)))), stat= 'count', color = 'black', vjust = -.5)+
ylab("Number of passenger")+ xlab("Ticket Class")
3.1.3 Biến Sex
table(mac$Sex)##
## female male
## 314 577Có 314 hành khách nữ và 577 hành khách nam.
ggplot(mac,aes(Sex))+
geom_bar(color = "blue", fill = "green")+
geom_text(aes(label = scales :: percent(after_stat(count/sum(count)))), stat= 'count', color = 'black', vjust = -.5)+
ylab("Number of passenger")+ xlab("Sex")
3.1.4 Biến Embarked
summary(mac$Embarked)## C Q S
## 170 77 644- 170 hành khách lên cảng Cherbourg
- 77 hành khách lên cảng Queenstown
- 644 hành khách lên cảng Southampton
ggplot(mac,aes(Embarked))+
geom_bar(color = "blue", fill = "green")+
geom_text(aes(label = scales :: percent(after_stat(count/sum(count)))), stat= 'count', color = 'black', vjust = -.5)+
ylab("Number of passenger")+ xlab("Embarked")
3.1.5 Biến định lượng
Thống kê mô tả
mac1<-data.frame(mac$Age, mac$SibSp, mac$Parch, mac$Fare)
summary(mac1)## mac.Age mac.SibSp mac.Parch mac.Fare
## Min. : 0.42 Min. :0.000 Min. :0.0000 Min. : 0.00
## 1st Qu.:22.00 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.: 7.91
## Median :28.00 Median :0.000 Median :0.0000 Median : 14.45
## Mean :29.36 Mean :0.523 Mean :0.3816 Mean : 32.20
## 3rd Qu.:35.00 3rd Qu.:1.000 3rd Qu.:0.0000 3rd Qu.: 31.00
## Max. :80.00 Max. :8.000 Max. :6.0000 Max. :512.33Từ kết quả thống kê mô tả cho thấy:
Tuổi của hành khách nhỏ nhất là 0,42 ; giá trị lớn nhất là 80; giá trị trung bình là 29,36; 25% dữ liệu nhỏ hơn 22 (giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 28 (giá trị trung vị); 75% dữ liệu nhỏ hơn 35 (giá trị tứ phân vị thứ ba)
Số anh chị em/ vợ chồng trên tàu của hành khách (Sibsp): giá trị nhỏ nhất của dữ liệu 0; giá trị lớn nhất là 8; giá trị trung bình là 0,523; 25% dữ liệu nhỏ hơn 0 (giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 0 (giá trị trung vị); 75% dữ liệu nhỏ hơn 1 (giá trị tứ phân vị thứ ba)
số ba mẹ/ con trên tàu của hành khách (Parch): giá trị nhỏ nhất của dữ liệu 0; giá trị lớn nhất là 6; giá trị trung bình là 0,3816; 25% dữ liệu nhỏ hơn 0(giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 0 (giá trị trung vị); 75% dữ liệu nhỏ hơn 0 (giá trị tứ phân vị thứ ba)
Giá vé hành khách (FARE): giá trị nhỏ nhất của dữ liệu 0; giá trị lớn nhất là 512,33; giá trị trung bình là 32,2; 25% dữ liệu nhỏ hơn 7,91 (giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 14,45 (giá trị trung vị); 75% dữ liệu nhỏ hơn 31 (giá trị tứ phân vị thứ ba)
Biểu đồ Histogram
hist(mac$Age)
Độ tuổi của hành khách nằm trong phạm vi 20 đến 30 là nhiều nhất.
hist(mac$SibSp)
Đa số số anh chị em/ vợ chống trên tàu của hành khách là 1
hist(mac$Parch)
Đa số số ba mẹ/ con trên tàu của hành khách là 1
hist(mac$Fare)
Giá vé khách hàng trả đa số nằm trong phạm vi 0 - 50
3.2 Thống kê mô tả 2 biến
3.2.1 Phân tích khách hàng sống sót theo giới tính
3.2.1.1 Lập bảng tần suất
rm<-table(mac$Sex,mac$Survived)
addmargins(rm)##
## 0 1 Sum
## female 81 233 314
## male 468 109 577
## Sum 549 342 891Trong tổng số 314 hành khách nữ có 233 hành khách được giải cứu và sống sót, số còn lại đã tử vong. Trong tổng số 577 hành khách nam có 109 người sống sót và 468 người đã mất.
ggplot(mac, aes(Sex, fill = Survived)) + geom_bar(position = 'dodge')
Nhìn vào biểu đồ ta thấy tỷ lệ sống sót của phụ nữ cao hơn nhiều so với nam.
3.2.1.2 Rủi ro tương đối
Relative risk
RelRisk(rm)## [1] 0.3180426Tỷ lệ khách hàng nữ mất sau vụ chìm tàu Titanic bằng 31,8043 % tỷ lệ khách hàng nam mất sau vụ chìm tàu Titanic.
Risk ratio
epitab(rm,method='riskratio',rev='c')## $tab
##
## 1 p0 0 p1 riskratio lower upper p.value
## female 233 0.7420382 81 0.2579618 1.000000 NA NA NA
## male 109 0.1889081 468 0.8110919 3.144233 2.595782 3.808564 6.463922e-60
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Tỷ lệ hành khách nam còn sống sót sau vụ chìm tàu gấp 3,14 lần tỷ lệ hành khách nữ còn sống sau vụ chìm tàu.
3.2.1.3 Odd ratio
epitab(rm, method = 'oddsratio', rev='c') ## $tab
##
## 1 p0 0 p1 oddsratio lower upper p.value
## female 233 0.6812865 81 0.147541 1.00000 NA NA NA
## male 109 0.3187135 468 0.852459 12.35066 8.899955 17.13928 6.463922e-60
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Tỷ lệ sống sót so với tỷ lệ mất của hành khách nam gấp 12,35066 lần tỷ lệ sống sót so với tỷ lệ mất của hành khách nữ
3.2.2 Phân tích khách hàng sống sót theo cảng lên tàu
3.2.2.1 Bảng tần suất
rm1<-table(mac$Embarked,mac$Survived)
rm1##
## 0 1
## C 75 95
## Q 47 30
## S 427 217- Trong số hành khách lên tàu từ cảng C có 75 người mất và 95 người sống sót.
- Trong số hành khách lên tàu từ cảng Q có 47 người mất và 30 người sống sót.
- Trong số hành khách lên tàu từ cảng S có 427 người mất và 217 người sống sót.
ggplot(mac, aes(Embarked, fill = Survived)) + geom_bar(position = 'dodge') 
Tỷ lệ sống sót của hành khách lên tàu từ cảng S là cao nhất.
3.2.3 Phân tích hành khách sống sót theo độ tuổi
ggplot(mac, aes(x = Age, fill = Survived)) + theme_bw()+ geom_histogram(binwidth = 8)+ labs(y = "Passenger count", x = "Age", title = "Titanic survival rates by age")
3.2.4 Phân tích hành khách sống sót theo hạng vé và giới tính
3.2.4.1 Bảng tần suất
rm2<-ftable(mac$Pclass, mac$Sex ,mac$Survived)
rm2## 0 1
##
## 1 female 3 91
## male 77 45
## 2 female 6 70
## male 91 17
## 3 female 72 72
## male 300 47Đối với hạng vé Upper:
- 91 hành khách nữ sống sót và 45 hành khách nam còn sống
Đối với hạng vé Middle:
- 70 hành khách nữ sống sót và 17 hành khách nam còn sống
Đối với hạng vé Lower:
- 72 hành khách nữ sống sót và 47 hành khách nam còn sống
ggplot(mac, aes(x = Sex, fill = Survived)) +
theme_bw()+
facet_wrap(~ Pclass)+
geom_bar()+
labs(y = "Passenger count",
title = "Titanic survival rates by Pclass and sex")
Nhìn vào biểu đồ ta thấy: * Đối với cả 3 hạng vé Upper, Midle, Lower: tỷ lệ sống sót của hành khách nữ đều cao hơn so với hành khách nam. Và tỷ lệ sống sót của hành khách nữ ở hạng vé Upper là cao nhất.
3.3 Thống kê suy diễn cho dữ liệu định tính
3.3.1 Kiểm định tính độc lập cho 2 biến định tính
Kiểm định tính độc lập cho 2 biến Survived và Pclass
chisq.test(table(mac$Survived,mac$Pclass))##
## Pearson's Chi-squared test
##
## data: table(mac$Survived, mac$Pclass)
## X-squared = 102.89, df = 2, p-value < 2.2e-16Với p_value < 5%, bác bỏ giả thuyết H0 do đó kết luận việc hành khách sống sỏt có liên quan tới hạng vé
Kiểm định tính độc lập cho 2 biến Survived và Sex
chisq.test(table(mac$Survived,mac$Sex))##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(mac$Survived, mac$Sex)
## X-squared = 260.72, df = 1, p-value < 2.2e-16Qua kết quả kiểm định cho thấy việc hành khách sống sỏt có liên quan tới giới tính của hành khách (p_value<5%)
Kiểm định tính độc lập cho 2 biến Survived và Embarked
chisq.test(table(mac$Survived,mac$Embarked))##
## Pearson's Chi-squared test
##
## data: table(mac$Survived, mac$Embarked)
## X-squared = 28.005, df = 2, p-value = 8.294e-07Qua kết quả kiểm định cho thấy việc hành khách sống sỏt có liên quan tới cảng lên tàu của hành khách (p_value<5%)
3.3.2 Khoảng ước lượng cho tỷ lệ
- Ước lượng tỷ lệ hành khách nam sống sót đồng thời kiểm định xem tỷ lệ (%) hành khách nam sống sót có bằng 40% không?
rm<- mac[mac$Survived == "1",]
rm1<-rm[rm$Sex == "male",]
prop.test(length(rm1$Sex), length(rm$Sex), p = 0.4)##
## 1-sample proportions test with continuity correction
##
## data: length(rm1$Sex) out of length(rm$Sex), null probability 0.4
## X-squared = 9.08, df = 1, p-value = 0.002584
## alternative hypothesis: true p is not equal to 0.4
## 95 percent confidence interval:
## 0.2701891 0.3713836
## sample estimates:
## p
## 0.3187135Với khoảng tin cậy 95% ước lượng tỷ lệ hành khách nam sống sót nằm trong khoảng từ 0,2702 đến 0,37138
p-value < 0, bác bỏ giả thuyết H0. Do đó tỷ lệ (%) hành khách nam sống sót không bằng 40% với mức ý nghĩa 5%.
- Ước lượng tỷ lệ hành khách nữ sống sót đồng thời kiểm định xem tỷ lệ (%) hành khách nữ sống sót có bằng 60% không?
rf<- mac[mac$Survived == "1",]
rf1<-rm[rm$Sex == "female",]
prop.test(length(rf1$Sex), length(rf$Sex), p = 0.6)##
## 1-sample proportions test with continuity correction
##
## data: length(rf1$Sex) out of length(rf$Sex), null probability 0.6
## X-squared = 9.08, df = 1, p-value = 0.002584
## alternative hypothesis: true p is not equal to 0.6
## 95 percent confidence interval:
## 0.6286164 0.7298109
## sample estimates:
## p
## 0.6812865Với khoảng tin cậy 95% ước lượng tỷ lệ hành khách nữ sống sót nằm trong khoảng từ 0,6286 đến 0,7298
p-value < 0, bác bỏ giả thuyết H0. Do đó tỷ lệ (%) hành khách nữ sống sót không bằng 60% với mức ý nghĩa 5%.
- Ước lượng sự chênh lệch về tỷ lệ sống sót giữa hành khách nam và nữ. Đồng thời thực hiện bài toán kiển định sự chênh lệch này
a <- c(nrow(rm), nrow(rf))
b <- c(nrow(rm1), nrow(rf1))
prop.test(b,a)##
## 2-sample test for equality of proportions with continuity correction
##
## data: b out of a
## X-squared = 88.474, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.4353388 -0.2898074
## sample estimates:
## prop 1 prop 2
## 0.3187135 0.6812865P_value > 0, bác bỏ giả thuyết H0, do đó không có sự chênh lệnh về tỷ lệ hành khách có độ tuổi lớn hơn 30 giữa hành khách nam và nữ
Khoảng tin cậy 95% cho chênh lệch tỷ lệ nằm trong khoảng từ -0,06984 đến 0,06984
4 Nhiệm vụ tuần 2
Chọn 1 biến định tính và 1 biến định lượng làm biến phụ thuộc để phân tích, giải thích lý do
4.1 Về bộ dataset
Bộ dứ liệu training có 12 biến quan sát gôm 891 quan sát.
str(train)## 'data.frame': 891 obs. of 12 variables:
## $ PassengerId: int 1 2 3 4 5 6 7 8 9 10 ...
## $ Survived : int 0 1 1 1 0 0 0 0 1 1 ...
## $ Pclass : int 3 1 3 1 3 3 1 3 3 2 ...
## $ Name : Factor w/ 891 levels "Abbing, Mr. Anthony",..: 109 179 358 277 16 559 520 629 417 581 ...
## $ Sex : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...
## $ Age : num 22 38 26 35 35 28 54 2 27 14 ...
## $ SibSp : int 1 1 0 1 0 0 0 3 0 1 ...
## $ Parch : int 0 0 0 0 0 0 0 1 2 0 ...
## $ Ticket : Factor w/ 681 levels "110152","110413",..: 524 597 670 50 473 276 86 396 345 133 ...
## $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...
## $ Cabin : Factor w/ 148 levels "","A10","A14",..: 1 83 1 57 1 1 131 1 1 1 ...
## $ Embarked : Factor w/ 3 levels "C","Q","S": 3 1 3 3 3 2 3 3 3 1 ...- PassengerID: mã hành khách
- Survived: tình trạng sống sót.0 = còn sống, 1 = đã mất
- Pclass: Hạng vé (1 = Upper,2 = Middle,3 = Lower)
- Name: tên hành khách
- Sex: giới tính (male, female)
- Age: tuổi (tính theo năm).
- SibSp: Số anh chị em/ vợ chồng trên tàu
- Parch: số ba mẹ/ con trên tàu
- Ticket number: số lượng vé
- Fare: Giá vé hành khách
- Carbin: Số khoang ()
- Embarked: điểm đến cảng(C = Cherbourg, Q = Queenstown, S = Southampton)
4.2 Chọn biến định tính làm biến phụ thuộc
Dự báo khách hàng sống sót sau vụ chìm tàu Titanic
Vụ chìm tàu Titanic là một trong những vụ đắm tàu khét tiếng nhất trong lịch sử. Vào ngày 15 tháng 4 năm 1912, trong chuyến hành trình đầu tiên của mình, con tàu RMS Titanic được nhiều người coi là “không thể chìm” đã chìm sau khi va chạm với một tảng băng trôi. Thật không may, không có đủ xuồng cứu sinh cho mọi người trên tàu, dẫn đến cái chết của 1502 trong số 2224 hành khách và thủy thủ đoàn. Mặc dù có một số yếu tố may mắn liên quan đến việc sống sót, nhưng có vẻ như một số nhóm người có nhiều khả năng sống sót hơn những nhóm khác.
Trong bài tiểu luận này tôi sẽ thực hiện xây dựng một mô hình dự báo hành khách sống sót sau vụ chìm tàu sử dụng dữ liệu hành khách bao gồm:
- PassengerID: mã hành khách
- Survived: tình trạng sống sót.0 = còn sống, 1 = đã mất
- Pclass: Hạng vé (1 = Upper,2 = Middle,3 = Lower)
- Sex: giới tính (male, female)
- Age: tuổi (tính theo năm).
- SibSp: Số anh chị em/ vợ chồng trên tàu
- Parch: số ba mẹ/ con trên tàu
- Fare: Giá vé hành khách trả.
- Embarked: cảng lên tàu(C = Cherbourg, Q = Queenstown, S = Southampton)
4.3 Chọn biến định lượng làm biến phụ thuộc
Phân tích các yếu tố ảnh hưởng đến giá vé hành khách trả
5 Nhiệm vụ tuần 1
Tìm một dataset có dữ liệu định tính, dữ liệu định lượng, có trên 5 biến và nhiều hơn 150 quan sát.
5.1 Về bộ dataset
Bộ dữ liệu này bao gồm số lượng xe đạp cho thuê hàng giờ và hàng ngày trong khoảng thời gian từ năm 2011 đến 2012 trong hệ thống chia sẻ xe đạp Capital vơi thông tin thời tiết và mùa tương ứng.
Hệ thống chia sẻ xe đạp là thế hệ mới của dịch vụ cho thuê xe đạp truyền thống, trong đó toàn bộ quá trình từ tư cách thành viên, cho thuê và trả lại đều trở nên tự động. Thông qua các hệ thống này, người dùng có thể dễ dàng thuê một chiếc xe đạp từ một vị trí cụ thể và quay trở lại ở một vị trí khá. Ngày nay, có rất nhiều mối quan tâm đến các hệ thống này do vai trò quan trọng của chúng đối với các vấn đề về giao thông, môi trường và sức khỏe. Ngoài các ứng dụng thú vị trong thế giới thực của hệ thống chia sẻ xe đạp, các đặc điểm của dữ liệu do các hệ thống này tạo ra khiến chúng trở nên hấp dẫn đối với nghiên cứu. Đối lập với các dịch vụ vận tải khác như xe buýt hoặc tàu điện ngầm, thời gian di chuyển, điểm khởi hành và điểm đến được ghi lại rõ ràng trong các hệ thống này. Tính năng này biến hệ thống chia sẻ xe đạp thành một mạng cảm biến ảo có thể được sử dụng để cảm nhận tính di động trong thành phố. Do đó, người ta hy vọng rằng hầu hết các sự kiện quan trọng trong thành phố có thể được phát hiện thông qua giám sát các dữ liệu này.library(ISLR2)
data(Bikeshare)
Bikesharestr(Bikeshare)## 'data.frame': 8645 obs. of 15 variables:
## $ season : num 1 1 1 1 1 1 1 1 1 1 ...
## $ mnth : Factor w/ 12 levels "Jan","Feb","March",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ day : num 1 1 1 1 1 1 1 1 1 1 ...
## $ hr : Factor w/ 24 levels "0","1","2","3",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ holiday : num 0 0 0 0 0 0 0 0 0 0 ...
## $ weekday : num 6 6 6 6 6 6 6 6 6 6 ...
## $ workingday: num 0 0 0 0 0 0 0 0 0 0 ...
## $ weathersit: Factor w/ 4 levels "clear","cloudy/misty",..: 1 1 1 1 1 2 1 1 1 1 ...
## $ temp : num 0.24 0.22 0.22 0.24 0.24 0.24 0.22 0.2 0.24 0.32 ...
## $ atemp : num 0.288 0.273 0.273 0.288 0.288 ...
## $ hum : num 0.81 0.8 0.8 0.75 0.75 0.75 0.8 0.86 0.75 0.76 ...
## $ windspeed : num 0 0 0 0 0 0.0896 0 0 0 0 ...
## $ casual : num 3 8 5 3 0 0 2 1 1 8 ...
## $ registered: num 13 32 27 10 1 1 0 2 7 6 ...
## $ bikers : num 16 40 32 13 1 1 2 3 8 14 ...Bộ data có 15 biến với 8645 quan sát:
- season: mùa (1: mùa xuân, 2: mùa hè, 3: mùa thu, 4: mùa đông)
- mnth: month (1 to 12)
- day: ngày (1 to 365)
- hr: hour (0 to 23)
- holiday: ngày lễ
- weekday: ngày trong tuần (0 tới 6 tương ứng từ thứ 2 đến chủ nhật)
- workingday: nhận giá trị 1 nếu không phải là ngày cuối tuần hay ngày lễ, ngược lại là 0
- weathersit:
- Clear
- Cloudy/ Misty
- Light rain/snow
- Heavy rain/snow
- temp: Nhiệt độ chuẩn hóa tính bằng độ C. Các giá trị được lấy thông qua(t-t_min)/(t_max-t_min),t_min=-8, t_max=+39 (chỉ tính theo giờ)
- atemp: Nhiệt độ cảm giác bình thường hóa tính bằng độ C. Các giá trị lấy thông qua (t-t_min)/(t_max-t_min), t_min=-16, t_max=+50 (chỉ tính theo giờ).
- hum: độ ẩm bình thướng hóa. Các giá trị được chia cho 100
- windspeed: tốc độ gió chuẩn hóa. Các giá trị được chia cho 67
- casual: số lượng người dùng bình thường
- registered: số lượng người đăng ký
- bikers: tổng số lượng xe đạp cho thuê bao gồm cả xe đạp thông thường và đã đăng ký