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=