Tên: Mai Huy
MSSV: 43.01.104.065
Số thứ tự: 08
Câu a) Fit mô hình logistic regression
# Load thư viện ISLR
library(ISLR)
# attach dùng để khiến cho những biến feature trong dữ liệu có sẵn trong Rstudio theo tên
attach(Default)
# set.seed dùng để tái tạo những vector random giống nhau theo tương ứng với giá trị được đưa vào hàm seed
set.seed(1)
# Fit mô hình logistic Regression để dự đoán default sử dụng 2 giá trị đầu vào là income và balance
fit.glm <- glm(default ~ income + balance, data = Default, family = "binomial")
Câu b) Validation set approach
i) Chia bộ train và bộ validation
# CHia bộ train và validation làm 2 phần bằng nhau
train <- sample(dim(Default)[1], dim(Default)[1] / 2)
ii) Fit mô hình logistic regression chỉ sử dụng bộ train
# Fit mô hình hồi quy đơn giản để dự đoán biến đầu ra default trong tập train
fit.glm <- glm(default ~ income + balance, data = Default, family = "binomial", subset = train)
iii) Dự đoán tập validation
# Hàm predict dùng để dự đoán xác suất vỡ nợ của các khách hàng trong tập validation
probs <- predict(fit.glm, newdata = Default[-train, ], type = "response")
# Tạo một vecto gom 5000 thành phần No tương ứng kích thước tập validation
pred.glm <- rep("No", length(probs))
#Chuyển các thành phần sang Yes khi xác suất lớn hơn 0.5
pred.glm[probs > 0.5] <- "Yes"
iv) Tính sai số bộ validation
# Trung bình tỉ lệ phân loại sai trong tập validation
mean(pred.glm != Default[-train, ]$default)
[1] 0.0254
Sử dụng phương pháp validation set approach, chúng ta có tỉ lệ phân loại sai (test set error) là khoảng 2.54%
Câu c) Lặp lại câu b 3 lần
Sử dụng phương pháp validation set approach, mỗi lần tập training và validation sẽ được lấy ngẫu nghiên khác nhau, nên sai số trong validation cũng sẽ khác nhau
Lần 1
train <- sample(dim(Default)[1], dim(Default)[1] / 2)
fit.glm <- glm(default ~ income + balance, data = Default, family = "binomial", subset = train)
probs <- predict(fit.glm, newdata = Default[-train, ], type = "response")
pred.glm <- rep("No", length(probs))
pred.glm[probs > 0.5] <- "Yes"
mean(pred.glm != Default[-train, ]$default)
[1] 0.0274
Lần 2
train <- sample(dim(Default)[1], dim(Default)[1] / 2)
fit.glm <- glm(default ~ income + balance, data = Default, family = "binomial", subset = train)
probs <- predict(fit.glm, newdata = Default[-train, ], type = "response")
pred.glm <- rep("No", length(probs))
pred.glm[probs > 0.5] <- "Yes"
mean(pred.glm != Default[-train, ]$default)
[1] 0.0244
Lần 3
train <- sample(dim(Default)[1], dim(Default)[1] / 2)
fit.glm <- glm(default ~ income + balance, data = Default, family = "binomial", subset = train)
probs <- predict(fit.glm, newdata = Default[-train, ], type = "response")
pred.glm <- rep("No", length(probs))
pred.glm[probs > 0.5] <- "Yes"
mean(pred.glm != Default[-train, ]$default)
[1] 0.027
Chúng ta thấy rằng sai số validation thay đổi tuỳ thuộc vào các loại quan sát tồn tại trong tập training và validation.
Câu d) Thêm 1 biến giả student vào mô hình logistic regression
Lặp lại tương tự các bước ở trên, chúng ta hãy thử thêm 1 biến giả để xem sai số trong validation thay đổi như nào
train <- sample(dim(Default)[1], dim(Default)[1] / 2)
fit.glm <- glm(default ~ income + balance + student, data = Default, family = "binomial", subset = train)
pred.glm <- rep("No", length(probs))
probs <- predict(fit.glm, newdata = Default[-train, ], type = "response")
pred.glm[probs > 0.5] <- "Yes"
mean(pred.glm != Default[-train, ]$default)
[1] 0.0264
Chúng ta thấy dường như khi thêm 1 biến giả student thì sai số trong tập validation không giảm đi quá đáng kể và gần như là không thay đổi.
LS0tDQp0aXRsZTogIkLDoGkgdOG6rXAgMV8gVHXhuqduIDYiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIyMgVMOqbjogTWFpIEh1eQ0KIyMjIE1TU1Y6IDQzLjAxLjEwNC4wNjUNCiMjIyBT4buRIHRo4bupIHThu7E6IDA4DQoNCiMjIEPDonUgYSkgRml0IG3DtCBow6xuaCBsb2dpc3RpYyByZWdyZXNzaW9uDQoNCg0KDQpgYGB7cn0NCiMgTG9hZCB0aMawIHZp4buHbiBJU0xSDQpsaWJyYXJ5KElTTFIpDQpgYGANCg0KYGBge3J9DQojIGF0dGFjaCBkw7luZyDEkeG7gyBraGnhur9uIGNobyBuaOG7r25nIGJp4bq/biBmZWF0dXJlIHRyb25nIGThu68gbGnhu4d1IGPDsyBz4bq1biB0cm9uZyBSc3R1ZGlvIHRoZW8gdMOqbg0KYXR0YWNoKERlZmF1bHQpDQpgYGANCg0KYGBge3J9DQojIHNldC5zZWVkIGTDuW5nIMSR4buDIHTDoWkgdOG6oW8gbmjhu69uZyB2ZWN0b3IgcmFuZG9tIGdp4buRbmcgbmhhdSB0aGVvIHTGsMahbmcg4bupbmcgduG7m2kgZ2nDoSB0cuG7iyDEkcaw4bujYyDEkcawYSB2w6BvIGjDoG0gc2VlZA0Kc2V0LnNlZWQoMSkNCiMgRml0IG3DtCBow6xuaCBsb2dpc3RpYyBSZWdyZXNzaW9uIMSR4buDIGThu7EgxJFvw6FuIGRlZmF1bHQgc+G7rSBk4bulbmcgMiBnacOhIHRy4buLIMSR4bqndSB2w6BvIGzDoCBpbmNvbWUgdsOgIGJhbGFuY2UNCmZpdC5nbG0gPC0gZ2xtKGRlZmF1bHQgfiBpbmNvbWUgKyBiYWxhbmNlLCBkYXRhID0gRGVmYXVsdCwgZmFtaWx5ID0gImJpbm9taWFsIikNCmBgYA0KDQojIyBDw6J1IGIpIFZhbGlkYXRpb24gc2V0IGFwcHJvYWNoDQoNCiMjIyBpKSBDaGlhIGLhu5kgdHJhaW4gdsOgIGLhu5kgdmFsaWRhdGlvbg0KDQoNCmBgYHtyfQ0KIyBDSGlhIGLhu5kgdHJhaW4gdsOgIHZhbGlkYXRpb24gbMOgbSAyIHBo4bqnbiBi4bqxbmcgbmhhdQ0KdHJhaW4gPC0gc2FtcGxlKGRpbShEZWZhdWx0KVsxXSwgZGltKERlZmF1bHQpWzFdIC8gMikNCmBgYA0KDQojIyMgaWkpIEZpdCBtw7QgaMOsbmggbG9naXN0aWMgcmVncmVzc2lvbiBjaOG7iSBz4butIGThu6VuZyBi4buZIHRyYWluDQoNCmBgYHtyfQ0KIyBGaXQgbcO0IGjDrG5oIGjhu5NpIHF1eSDEkcahbiBnaeG6o24gxJHhu4MgZOG7sSDEkW/DoW4gYmnhur9uIMSR4bqndSByYSBkZWZhdWx0IHRyb25nIHThuq1wIHRyYWluDQpmaXQuZ2xtIDwtIGdsbShkZWZhdWx0IH4gaW5jb21lICsgYmFsYW5jZSwgZGF0YSA9IERlZmF1bHQsIGZhbWlseSA9ICJiaW5vbWlhbCIsIHN1YnNldCA9IHRyYWluKQ0KDQpgYGANCg0KIyMjIGlpaSkgROG7sSDEkW/DoW4gdOG6rXAgdmFsaWRhdGlvbg0KDQpgYGB7cn0NCiMgSMOgbSBwcmVkaWN0IGTDuW5nIMSR4buDIGThu7EgxJFvw6FuIHjDoWMgc3XhuqV0IHbhu6EgbuG7oyBj4bunYSBjw6FjIGtow6FjaCBow6BuZyB0cm9uZyB04bqtcCB2YWxpZGF0aW9uDQpwcm9icyA8LSBwcmVkaWN0KGZpdC5nbG0sIG5ld2RhdGEgPSBEZWZhdWx0Wy10cmFpbiwgXSwgdHlwZSA9ICJyZXNwb25zZSIpDQpgYGANCg0KYGBge3J9DQojIFThuqFvIG3hu5l0IHZlY3RvIGdvbSA1MDAwIHRow6BuaCBwaOG6p24gTm8gdMawxqFuZyDhu6luZyBrw61jaCB0aMaw4bubYyB04bqtcCB2YWxpZGF0aW9uDQpwcmVkLmdsbSA8LSByZXAoIk5vIiwgbGVuZ3RoKHByb2JzKSkNCmBgYA0KDQpgYGB7cn0NCiNDaHV54buDbiBjw6FjIHRow6BuaCBwaOG6p24gc2FuZyBZZXMga2hpIHjDoWMgc3XhuqV0IGzhu5tuIGjGoW4gMC41DQpwcmVkLmdsbVtwcm9icyA+IDAuNV0gPC0gIlllcyINCmBgYA0KDQoNCiMjIyBpdikgVMOtbmggc2FpIHPhu5EgYuG7mSB2YWxpZGF0aW9uDQoNCmBgYHtyfQ0KIyBUcnVuZyBiw6xuaCB04buJIGzhu4cgcGjDom4gbG/huqFpIHNhaSB0cm9uZyB04bqtcCB2YWxpZGF0aW9uDQptZWFuKHByZWQuZ2xtICE9IERlZmF1bHRbLXRyYWluLCBdJGRlZmF1bHQpDQpgYGANCg0KU+G7rSBk4bulbmcgcGjGsMahbmcgcGjDoXAgdmFsaWRhdGlvbiBzZXQgYXBwcm9hY2gsIGNow7puZyB0YSBjw7MgdOG7iSBs4buHIHBow6JuIGxv4bqhaSBzYWkgKHRlc3Qgc2V0IGVycm9yKSBsw6Aga2hv4bqjbmcgMi41NCUNCg0KIyMgQ8OidSBjKSBM4bq3cCBs4bqhaSBjw6J1IGIgMyBs4bqnbg0KDQpT4butIGThu6VuZyBwaMawxqFuZyBwaMOhcCB2YWxpZGF0aW9uIHNldCBhcHByb2FjaCwgbeG7l2kgbOG6p24gdOG6rXAgdHJhaW5pbmcgdsOgIHZhbGlkYXRpb24gc+G6vSDEkcaw4bujYyBs4bqleSBuZ+G6q3UgbmdoacOqbiBraMOhYyBuaGF1LCBuw6puIHNhaSBz4buRIHRyb25nIHZhbGlkYXRpb24gY8Wpbmcgc+G6vSBraMOhYyBuaGF1IA0KDQojIyMgTOG6p24gMQ0KDQpgYGB7cn0NCnRyYWluIDwtIHNhbXBsZShkaW0oRGVmYXVsdClbMV0sIGRpbShEZWZhdWx0KVsxXSAvIDIpDQpmaXQuZ2xtIDwtIGdsbShkZWZhdWx0IH4gaW5jb21lICsgYmFsYW5jZSwgZGF0YSA9IERlZmF1bHQsIGZhbWlseSA9ICJiaW5vbWlhbCIsIHN1YnNldCA9IHRyYWluKQ0KcHJvYnMgPC0gcHJlZGljdChmaXQuZ2xtLCBuZXdkYXRhID0gRGVmYXVsdFstdHJhaW4sIF0sIHR5cGUgPSAicmVzcG9uc2UiKQ0KcHJlZC5nbG0gPC0gcmVwKCJObyIsIGxlbmd0aChwcm9icykpDQpwcmVkLmdsbVtwcm9icyA+IDAuNV0gPC0gIlllcyINCm1lYW4ocHJlZC5nbG0gIT0gRGVmYXVsdFstdHJhaW4sIF0kZGVmYXVsdCkNCmBgYA0KDQojIyMgTOG6p24gMg0KDQpgYGB7cn0NCnRyYWluIDwtIHNhbXBsZShkaW0oRGVmYXVsdClbMV0sIGRpbShEZWZhdWx0KVsxXSAvIDIpDQpmaXQuZ2xtIDwtIGdsbShkZWZhdWx0IH4gaW5jb21lICsgYmFsYW5jZSwgZGF0YSA9IERlZmF1bHQsIGZhbWlseSA9ICJiaW5vbWlhbCIsIHN1YnNldCA9IHRyYWluKQ0KcHJvYnMgPC0gcHJlZGljdChmaXQuZ2xtLCBuZXdkYXRhID0gRGVmYXVsdFstdHJhaW4sIF0sIHR5cGUgPSAicmVzcG9uc2UiKQ0KcHJlZC5nbG0gPC0gcmVwKCJObyIsIGxlbmd0aChwcm9icykpDQpwcmVkLmdsbVtwcm9icyA+IDAuNV0gPC0gIlllcyINCm1lYW4ocHJlZC5nbG0gIT0gRGVmYXVsdFstdHJhaW4sIF0kZGVmYXVsdCkNCmBgYA0KDQojIyMgTOG6p24gMw0KDQpgYGB7cn0NCnRyYWluIDwtIHNhbXBsZShkaW0oRGVmYXVsdClbMV0sIGRpbShEZWZhdWx0KVsxXSAvIDIpDQpmaXQuZ2xtIDwtIGdsbShkZWZhdWx0IH4gaW5jb21lICsgYmFsYW5jZSwgZGF0YSA9IERlZmF1bHQsIGZhbWlseSA9ICJiaW5vbWlhbCIsIHN1YnNldCA9IHRyYWluKQ0KcHJvYnMgPC0gcHJlZGljdChmaXQuZ2xtLCBuZXdkYXRhID0gRGVmYXVsdFstdHJhaW4sIF0sIHR5cGUgPSAicmVzcG9uc2UiKQ0KcHJlZC5nbG0gPC0gcmVwKCJObyIsIGxlbmd0aChwcm9icykpDQpwcmVkLmdsbVtwcm9icyA+IDAuNV0gPC0gIlllcyINCm1lYW4ocHJlZC5nbG0gIT0gRGVmYXVsdFstdHJhaW4sIF0kZGVmYXVsdCkNCmBgYA0KDQpDaMO6bmcgdGEgdGjhuqV5IHLhurFuZyBzYWkgc+G7kSB2YWxpZGF0aW9uIHRoYXkgxJHhu5VpIHR14buzIHRodeG7mWMgdsOgbyBjw6FjIGxv4bqhaSBxdWFuIHPDoXQgdOG7k24gdOG6oWkgdHJvbmcgdOG6rXAgdHJhaW5pbmcgdsOgIHZhbGlkYXRpb24uDQoNCiMjIEPDonUgZCkgVGjDqm0gMSBiaeG6v24gZ2nhuqMgc3R1ZGVudCB2w6BvIG3DtCBow6xuaCBsb2dpc3RpYyByZWdyZXNzaW9uDQoNCkzhurdwIGzhuqFpIHTGsMahbmcgdOG7sSBjw6FjIGLGsOG7m2Mg4bufIHRyw6puLCBjaMO6bmcgdGEgaMOjeSB0aOG7rSB0aMOqbSAxIGJp4bq/biBnaeG6oyDEkeG7gyB4ZW0gc2FpIHPhu5EgdHJvbmcgdmFsaWRhdGlvbiB0aGF5IMSR4buVaSBuaMawIG7DoG8NCg0KYGBge3J9DQp0cmFpbiA8LSBzYW1wbGUoZGltKERlZmF1bHQpWzFdLCBkaW0oRGVmYXVsdClbMV0gLyAyKQ0KZml0LmdsbSA8LSBnbG0oZGVmYXVsdCB+IGluY29tZSArIGJhbGFuY2UgKyBzdHVkZW50LCBkYXRhID0gRGVmYXVsdCwgZmFtaWx5ID0gImJpbm9taWFsIiwgc3Vic2V0ID0gdHJhaW4pDQpwcmVkLmdsbSA8LSByZXAoIk5vIiwgbGVuZ3RoKHByb2JzKSkNCnByb2JzIDwtIHByZWRpY3QoZml0LmdsbSwgbmV3ZGF0YSA9IERlZmF1bHRbLXRyYWluLCBdLCB0eXBlID0gInJlc3BvbnNlIikNCnByZWQuZ2xtW3Byb2JzID4gMC41XSA8LSAiWWVzIg0KbWVhbihwcmVkLmdsbSAhPSBEZWZhdWx0Wy10cmFpbiwgXSRkZWZhdWx0KQ0KYGBgDQoNCkNow7puZyB0YSB0aOG6pXkgZMaw4budbmcgbmjGsCBraGkgdGjDqm0gMSBiaeG6v24gZ2nhuqMgc3R1ZGVudCB0aMOsICBzYWkgc+G7kSB0cm9uZyB04bqtcCB2YWxpZGF0aW9uIGtow7RuZyBnaeG6o20gxJFpIHF1w6EgxJHDoW5nIGvhu4MgdsOgIGfhuqduIG5oxrAgbMOgIGtow7RuZyB0aGF5IMSR4buVaS4gDQo=