Bài tập 1_Tuần 5

Tên: Mai Huy

MSSV: 43.01.104.065

Số thứ tự: 08

Câu a)

# Load thư viện ISLR chứa tập dữ liệu Weekly
library(ISLR)
#
summary(Weekly)

      Year           Lag1               Lag2               Lag3               Lag4               Lag5              Volume       
 Min.   :1990   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950   Min.   :0.08747  
 1st Qu.:1995   1st Qu.: -1.1540   1st Qu.: -1.1540   1st Qu.: -1.1580   1st Qu.: -1.1580   1st Qu.: -1.1660   1st Qu.:0.33202  
 Median :2000   Median :  0.2410   Median :  0.2410   Median :  0.2410   Median :  0.2380   Median :  0.2340   Median :1.00268  
 Mean   :2000   Mean   :  0.1506   Mean   :  0.1511   Mean   :  0.1472   Mean   :  0.1458   Mean   :  0.1399   Mean   :1.57462  
 3rd Qu.:2005   3rd Qu.:  1.4050   3rd Qu.:  1.4090   3rd Qu.:  1.4090   3rd Qu.:  1.4090   3rd Qu.:  1.4050   3rd Qu.:2.05373  
 Max.   :2010   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260   Max.   :9.32821  
     Today          Direction 
 Min.   :-18.1950   Down:484  
 1st Qu.: -1.1540   Up  :605  
 Median :  0.2410             
 Mean   :  0.1499             
 3rd Qu.:  1.4050             
 Max.   : 12.0260             

Hàm summary() cho biết thông tin về giá trị cao nhất, thấp nhất, giá trị trung bình, trung vị, giá trị ở khoảng 25, 75 % của các biến trong dữ liệu Weekly.

# Ma trận tương quan giữa các biến khi bỏ đi biến định tính Direction
cor(Weekly[, -9])

              Year         Lag1        Lag2        Lag3         Lag4         Lag5      Volume        Today
Year    1.00000000 -0.032289274 -0.03339001 -0.03000649 -0.031127923 -0.030519101  0.84194162 -0.032459894
Lag1   -0.03228927  1.000000000 -0.07485305  0.05863568 -0.071273876 -0.008183096 -0.06495131 -0.075031842
Lag2   -0.03339001 -0.074853051  1.00000000 -0.07572091  0.058381535 -0.072499482 -0.08551314  0.059166717
Lag3   -0.03000649  0.058635682 -0.07572091  1.00000000 -0.075395865  0.060657175 -0.06928771 -0.071243639
Lag4   -0.03112792 -0.071273876  0.05838153 -0.07539587  1.000000000 -0.075675027 -0.06107462 -0.007825873
Lag5   -0.03051910 -0.008183096 -0.07249948  0.06065717 -0.075675027  1.000000000 -0.05851741  0.011012698
Volume  0.84194162 -0.064951313 -0.08551314 -0.06928771 -0.061074617 -0.058517414  1.00000000 -0.033077783
Today  -0.03245989 -0.075031842  0.05916672 -0.07124364 -0.007825873  0.011012698 -0.03307778  1.000000000

Mối tương quan giữa các biến Tag và biến TOday gần bằng 0. Mối tương quan đáng kể duy nhất là giữa biến Year và volume.

# attach dùng để khiến cho những biến feature trong dữ liệu có sẵn trong Rstudio theo tên
attach(Weekly)

plot(Volume)

Chúng ta thấy rằng giá trị Volume tăng theo thời gian do mối tương quan giữa Year và Volume là khá lớn

Câu b)

Chúng ta sẽ fit mô hình logistic Regression để dự đoán biến đầu ra Direction và sử dụng các biến đầu vào là Lag1 -> Lag5 và Volume. Hàm glm() và đưa vào biến family =binomial dùng để chạy 1 mô hình Logistic Regression.

# Fit mô hình Logistic Regresion để dự đoán biến đầu ra Direction trong dữ liệu Weekly
fit.glm <- glm(Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume, data = Weekly, family = binomial)

# Hàm summary() sẽ cho chúng ta biết thông tin p-values, Z-value, độ lệch chuẩn cho những hệ số của các biến đầu vào
summary(fit.glm)

Call:
glm(formula = Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + 
    Volume, family = binomial, data = Weekly)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.6949  -1.2565   0.9913   1.0849   1.4579  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)   
(Intercept)  0.26686    0.08593   3.106   0.0019 **
Lag1        -0.04127    0.02641  -1.563   0.1181   
Lag2         0.05844    0.02686   2.175   0.0296 * 
Lag3        -0.01606    0.02666  -0.602   0.5469   
Lag4        -0.02779    0.02646  -1.050   0.2937   
Lag5        -0.01447    0.02638  -0.549   0.5833   
Volume      -0.02274    0.03690  -0.616   0.5377   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1496.2  on 1088  degrees of freedom
Residual deviance: 1486.4  on 1082  degrees of freedom
AIC: 1500.4

Number of Fisher Scoring iterations: 4

Hàm summray cho biết thông tin về giá trị các hệ số của mô hình (B0->B6), thấy rằng Lag2 có hệ số nhỏ nhất = 0.0296, hệ số của Lag tương đối nhỏ vì thế có bằng chứng thống kê cho thấy rằng có mối quan hệ giữa Lag2 và biến đầu ra Direction.

Câu c)

# Có 1089 quan sát trong dữ liệu Weekly
dim(Weekly)

[1] 1089    9

# Hàm predict dùng để dự đoán xác suất xu hướng thị trường sẽ đi lên (Directtion = Up), type = "response" để xuất ra xác xuất theo dạng P(Y = 1|X)
probs <- predict(fit.glm, type = "response")
# Tạo một vecto gom 1089 thành phần down
pred.glm = rep ("Down", length(probs))
#Chuyển các thành phần sang Up khi xác suất lớn hơn 0.5
pred.glm[probs > 0.5] <- "Up"

# Dùng hàm table() để tạo ra một ma trận để quyết định xem có bao nhiêu quan sát được phân loại đúng, bao nhiêu bị phân loại sai
table(pred.glm, Direction)

        Direction
pred.glm Down  Up
    Down   54  48
    Up    430 557

Tỉ lệ số ngày dự đoán đúng = (54+557)/1089 = 0.56. Hàm logistic dự đoán đúng 56% số ngày, nói cách khác tỉ lệ dự đoán lỗi là khoảng 44%. Chúng ta cũng có thể nói rằng tính theo tuần, tỉ lệ dự đoán đúng thị trường đi lên là 557/(48+557) = 92%, tỉ lệ dự đoán đúng thị trường đi xuống là 54/(54+430) = 11.15%

Câu d)

#Vecto train gồm 1089 phần từ tương ướng với tập dữ liệu quan sát, dòng nào trong data có year <2009 sẽ trả về true, còn lại trả về false
train <- (Year < 2009)

# Tạo ra ma trận con của tập dữ liệu tương đương những giá trị từ năm 2009 đến 2010
Weekly.20092010 <- Weekly[!train, ]

# Bao gồm 104 số quan sát từ năm 2009 đến 2010
dim(Weekly.20092010)

[1] 104   9

# Tạo ra một vector gồm 104 giá trị Direction = Up hoặc Down từ năm 2009 đến 2010
Direction.20092010 <- Direction[!train]

# Thực hiện lại hồi qui logistic dựa trên tập huấn luyện (dữ liệu trước 2009) với subset =train (Year < 2009), chỉ bao gồm 1 giá trị đầu vào là Lag2
fit.glm2 <- glm(Direction ~ Lag2, data = Weekly, family = binomial, subset = train)

# Hàm predict dùng để dự đoán xác suất xu hướng thị trường sẽ đi lên (Directtion = Up), type = "response" để xuất ra xác xuất theo dạng P(Y = 1|X)
probs2 <- predict(fit.glm2, Weekly.20092010, type = "response")

# Tạo một vecto gom 104 thành phần down tương ứng với số quan sát từ năm 2009 đến 2010
pred.glm2 <- rep("Down", length(probs2))

#Chuyển các thành phần sang Up khi xác suất lớn hơn 0.5
pred.glm2[probs2 > 0.5] <- "Up"

# Dùng hàm table() để tạo ra một ma trận để quyết định xem có bao nhiêu quan sát được phân loại đúng, bao nhiêu bị phân loại sai
table(pred.glm2, Direction.20092010)

         Direction.20092010
pred.glm2 Down Up
     Down    9  5
     Up     34 56

Có 9 + 56 = 65 quan sát được phân loại đúng

Tỉ lệ số ngày dự đoán đúng = (9+56)/104 = 0.625, nói cách tỉ lệ dự đoán sai là 0.375

Câu e) Sử dụng LDA

# Load thư viện MASS
library(MASS)

# Phân tích khác biệt tuyến tính với chỉ có 1 biến đầu là lag2 trong tập dữ liệu trước năm 2009
fit.lda <- lda(Direction ~ Lag2, data = Weekly, subset = train)

# Thông tin khác biệt tuyến tính
fit.lda

Call:
lda(Direction ~ Lag2, data = Weekly, subset = train)

Prior probabilities of groups:
     Down        Up 
0.4477157 0.5522843 

Group means:
            Lag2
Down -0.03568254
Up    0.26036581

Coefficients of linear discriminants:
           LD1
Lag2 0.4414162

Kết quả hàm lda() chỉ ra rẳng 44.8% dữ liệu huấn luyện có direction: down

Đồng thời cho biết giá trị trung bình của mỗi nhóm biến đầu (Lag1 và Lag2) vào tương ứng với mỗi phân loại Down và Up

Hàm lda() cũng cung cấp hệ số phân biệt Lag2= 0.4414162, nếu 0.4414162 x Lag2 lớn thì LDA sẽ dự đoán phân loại thị trường tăng. Nếu nhỏ thì sẽ dự đoán thị trường giảm

# Hàm predict dùng để dự đoán xác suất xu hướng thị trường sẽ đi lên (Direction = Up) với tập data từ năm 2009 đến 2010
pred.lda <- predict(fit.lda, Weekly.20092010)

# Dùng hàm table() để tạo ra một ma trận để quyết định xem có bao nhiêu quan sát được phân loại đúng, bao nhiêu bị phân loại sai
table(pred.lda$class, Direction.20092010)

      Direction.20092010
       Down Up
  Down    9  5
  Up     34 56

Có 9 + 56 = 65 quan sát được phân loại đúng

Tỉ lệ số ngày dự đoán đúng = (9+56)/104 = 0.625, nói cách tỉ lệ dự đoán sai là 0.375. Kết quả đạt được rất giống với mô hình Logistic Regression.

Câu f) Sử dụng QDA

# Phân tích khác biệt bình phương với chỉ có 2 biến đầu vào Lag1 và lag2 trong tập dữ liệu trước năm 2009
fit.qda <- qda(Direction ~ Lag2, data = Weekly, subset = train)

# Thông tin khác biệt bình phương
fit.qda

Call:
qda(Direction ~ Lag2, data = Weekly, subset = train)

Prior probabilities of groups:
     Down        Up 
0.4477157 0.5522843 

Group means:
            Lag2
Down -0.03568254
Up    0.26036581

# Hàm predict dùng để dự đoán xác suất xu hướng thị trường sẽ đi lên (Direction = Up) với tập data từ năm 2009 đến 2010
pred.qda <- predict(fit.qda, Weekly.20092010)

# Dùng hàm table() để tạo ra một ma trận để quyết định xem có bao nhiêu quan sát được phân loại đúng, bao nhiêu bị phân loại sai
table(pred.qda$class, Direction.20092010)

      Direction.20092010
       Down Up
  Down    0  0
  Up     43 61

Có 0 + 61 = 61 quan sát được phân loại đúng

Tỉ lệ số ngày dự đoán đúng = (0+61)/104 = 0.5865, nói cách tỉ lệ dự đoán sai là 0.4134. Tỉ lệ dự đoán đúng thị trường tăng là 100 % và 0 % cho thị trường giảm. QDA đạt được độ chính xác 58.65% mặc dù mô hình dự đoán “Up” toàn bộ các dòng.