Câu 1 Xây dựng mô hình hồi quy tuyến tính
trên tập airquality, dự đoán Temp dựa vào wind và Solar.R.
Kiểm tra giả định phân phối chuẩn của residuals bằng Shapiro-Wilk
test.
data(airquality)
str(airquality)
## 'data.frame': 153 obs. of 6 variables:
## $ Ozone : int 41 36 12 18 NA 28 23 19 8 NA ...
## $ Solar.R: int 190 118 149 313 NA NA 299 99 19 194 ...
## $ Wind : num 7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ...
## $ Temp : int 67 72 74 62 56 66 65 59 61 69 ...
## $ Month : int 5 5 5 5 5 5 5 5 5 5 ...
## $ Day : int 1 2 3 4 5 6 7 8 9 10 ...
aq <- na.omit(airquality)
model_lm <- lm(Temp ~ Wind + Solar.R, data = aq)
summary(model_lm)
##
## Call:
## lm(formula = Temp ~ Wind + Solar.R, data = aq)
##
## Residuals:
## Min 1Q Median 3Q Max
## -17.2714 -5.0237 0.5837 5.2545 18.4608
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 85.702275 2.925445 29.295 < 2e-16 ***
## Wind -1.251870 0.217207 -5.763 7.89e-08 ***
## Solar.R 0.024533 0.008478 2.894 0.00461 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.039 on 108 degrees of freedom
## Multiple R-squared: 0.3014, Adjusted R-squared: 0.2884
## F-statistic: 23.29 on 2 and 108 DF, p-value: 3.886e-09
res <- residuals(model_lm)
shapiro.test(res)
##
## Shapiro-Wilk normality test
##
## data: res
## W = 0.979, p-value = 0.07734
hist(res, main="Histogram of Residuals", col="lightblue")
qqnorm(res)
qqline(res, col="red")
Câu 2 Dự đoán Survived trên tập Titanic
bằng hồi quy logistic.
Tính độ chính xác của mô hình trên tập kiểm tra. code trên R
markdown
library(titanic)
library(dplyr)
data("titanic_train")
# Chọn biến
df <- titanic_train[, c("Survived","Pclass","Sex","Age","SibSp","Parch","Fare")]
df$Age[is.na(df$Age)] <- mean(df$Age, na.rm=TRUE)
# Chuyển sang factor
df$Survived <- as.factor(df$Survived)
df$Sex <- as.factor(df$Sex)
# Chia train/test 70/30
set.seed(123)
index <- sample(1:nrow(df), 0.7*nrow(df))
train <- df[index, ]
test <- df[-index, ]
# Xây dựng mô hình logistic
model_logit <- glm(Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare,
data = train,
family = binomial)
summary(model_logit)
##
## Call:
## glm(formula = Survived ~ Pclass + Sex + Age + SibSp + Parch +
## Fare, family = binomial, data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 5.233483 0.639246 8.187 2.68e-16 ***
## Pclass -1.071498 0.162801 -6.582 4.65e-11 ***
## Sexmale -2.838489 0.242154 -11.722 < 2e-16 ***
## Age -0.046497 0.009538 -4.875 1.09e-06 ***
## SibSp -0.350254 0.135151 -2.592 0.00955 **
## Parch -0.147780 0.135196 -1.093 0.27436
## Fare 0.003084 0.002687 1.148 0.25113
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 832.39 on 622 degrees of freedom
## Residual deviance: 552.28 on 616 degrees of freedom
## AIC: 566.28
##
## Number of Fisher Scoring iterations: 5
# Dự đoán trên tập test
prob <- predict(model_logit, newdata=test, type="response")
pred <- ifelse(prob > 0.5, 1, 0)
accuracy <- mean(pred == test$Survived)
accuracy
## [1] 0.7873134