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.

# Chuẩn bị data
library(dplyr)

data(airquality)

colSums(is.na(airquality))
##   Ozone Solar.R    Wind    Temp   Month     Day 
##      37       7       0       0       0       0
aq <- airquality %>%
      select(Temp, Wind, Solar.R) %>%
      mutate(across(where(is.numeric),
                    ~ ifelse(is.na(.), mean(., na.rm = TRUE), .)))

str(aq)
## 'data.frame':    153 obs. of  3 variables:
##  $ Temp   : int  67 72 74 62 56 66 65 59 61 69 ...
##  $ Wind   : num  7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ...
##  $ Solar.R: num  190 118 149 313 186 ...
# Mô hình
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 
## -23.2219  -4.9771   0.9642   5.1825  18.3727 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 85.021389   2.490338  34.141  < 2e-16 ***
## Wind        -1.195154   0.188201  -6.350 2.42e-09 ***
## Solar.R      0.025610   0.007538   3.398 0.000871 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 8.162 on 150 degrees of freedom
## Multiple R-squared:  0.2662, Adjusted R-squared:  0.2564 
## F-statistic: 27.21 on 2 and 150 DF,  p-value: 8.268e-11
# Kiểm tra
res <- residuals(model_lm)
shapiro.test(res)
## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.98436, p-value = 0.08112
# Biểu đồ
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")

df <- titanic_train[, c("Survived","Pclass","Sex","Age","SibSp","Parch","Fare")]
str(df)
## 'data.frame':    891 obs. of  7 variables:
##  $ Survived: int  0 1 1 1 0 0 0 0 1 1 ...
##  $ Pclass  : int  3 1 3 1 3 3 1 3 3 2 ...
##  $ Sex     : chr  "male" "female" "female" "female" ...
##  $ Age     : num  22 38 26 35 35 NA 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 ...
##  $ Fare    : num  7.25 71.28 7.92 53.1 8.05 ...
colSums(is.na(df))
## Survived   Pclass      Sex      Age    SibSp    Parch     Fare 
##        0        0        0      177        0        0        0
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 dữ liệu train/test 70/30
set.seed(123)
index <- sample(1:nrow(df), 0.7*nrow(df))

train <- df[index, ]
test <- df[-index, ]

# 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
prob <- predict(model_logit, newdata=test, type="response")

pred <- ifelse(prob > 0.5, 1, 0)
pred <- as.factor(pred)

# Độ chính xác
accuracy <- mean(pred == test$Survived)
accuracy
## [1] 0.7873134