1) ÁP 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ó 2 biến đầu vào Lag1 và lag2 trong tập dữ liệu trước năm 2005
lda.fit = lda ( Direction~Lag1+ Lag2 , data=Smarket , subset
=train)
# Thông tin khác biệt tuyến tính
lda.fit
Kết quả hàm lda() chỉ ra rẳng 49.2% 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 những hệ số phân biệt Lag1= -0.6420190 và Lag2 = -0.5135293, nếu -0,642 x Lag1 -0,514 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
# Hiển 2 biểu đồ cột cho khác sự khác biệt tuyến tính giữa nhóm Direction = Down và Up
plot(lda.fit)
# 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(glm.pred,Direction.2005)
Tỉ lệ dự đoán đúng những ngày thị trường Up là 106/(106+76) = 58,2%
# dự đoán XU HƯỚNG thị trường với giá trị cụ thể của Lag1 = 1.2 Và 1.5, Lag 2= 1.1 và -0.8
predict(glm.fits,newdata=data.frame(Lag1=c(1.2,1.5),
Lag2=c(1.1,-0.8)),type="response")
# 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 2005 trở đi
lda.pred=predict(lda.fit, Smarket.2005)
# Tên các thuộc tính trong lda.pred
names(lda.pred)
class chứa dự đoán của LDA về khả năng di chuyển của thị trường cho 252 dòng dữ liệu từ năm 2005 trở đi
posterior là xác suất hậu nghiệm, xác suất dự đoán thị trường đi lên hay đi xuống cho 252 dòng dữ liệu từ năm 2005 trở đi
x là hệ số khác biệt tuyết tính (linear discriminants)
# Rút trích thông tin về class chỉ chứa những dự đoán Up và Down từ 252 dòng dữ liệu từ năm 2005 trở đi
lda.class=lda.pred$class
# 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(lda.class ,Direction.2005)
# Dự đoán %số ngày dự đoán đúng
mean(lda.class==Direction.2005)
# Tổng số lượng dòng có xác suất dự đoán > 0.5 trong tập dữ liệu từ năm 2005 trở đi
sum(lda.pred$posterior [ ,1]>=.5)
# Tổng số lượng dòng có xác suất dự đoán < 0.5 trong tập dữ liệu từ năm 2005 trở đi
sum(lda.pred$posterior [,1]<.5)
# Lấy 20 dòng xác suất hậu nghiệm đầu tiên
lda.pred$posterior[1:20,1]
Xác suất hậu nghiệm là xác suất tương ứng với thị trường sẽ giảm
# Lấy 20 dòng được dự đoán Up hoặc Down của dữ liệu từ năm 2005 trở đi
lda.class[1:20]
# Tổng số lượng dòng có xác suất dự đoán > 0.9 trong tập dữ liệu từ năm 2005 trở đi
sum(lda.pred$posterior [,1]>.9)
Chúng ta giả sử rằng chúng ta sẽ dự đoán thị trường giảm nếu chúng ta chắc chắn thị trường sẽ giảm sâu vào những ngày này. Nghĩa là xác suất hậu nghiệm phải ít nhất là 90%.
Tuy nhiên Không có ngày nào trong năm 2005 thỏa mãn điều kiện này.
2) Áp 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 2005
qda.fit = qda (Direction~Lag1+ Lag2 , data=Smarket , subset =train)
# Thông tin khác biệt bình phương
qda.fit
# Rút trích thông tin về class chỉ chứa những dự đoán Up và Down từ 252 dòng dữ liệu từ năm 2005 trở đi
qda.class= predict(qda.fit,Smarket.2005)$class
# 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(qda.class, Direction.2005)
# Dự đoán %số ngày dự đoán đúng
mean(qda.class==Direction.2005)
Sử dụng QDA chúng ta có được tỉ lệ dự đoán đúng cao hơn hẳn so với LDA.
LS0tDQp0aXRsZTogIkxEQSB2w6AgUURBIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KIyMjIFTDqm46IE1haSBIdXkNCiMjIyBNU1NWOiA0My4wMS4xMDQuMDY1DQojIyMgU+G7kSB0aOG7qSB04buxOiAwOA0KDQojIDEpIMOBUCBk4bulbmcgTERBDQoNCmBgYHtyfQ0KIyBMb2FkIHRoxrAgdmnhu4duIE1BU1MNCmxpYnJhcnkoTUFTUykNCmBgYA0KDQpgYGB7cn0NCiMgUGjDom4gdMOtY2gga2jDoWMgYmnhu4d0IHR1eeG6v24gdMOtbmggduG7m2kgY2jhu4kgY8OzIDIgYmnhur9uIMSR4bqndSB2w6BvIExhZzEgdsOgIGxhZzIgdHJvbmcgdOG6rXAgZOG7ryBsaeG7h3UgdHLGsOG7m2MgbsSDbSAyMDA1DQpsZGEuZml0ID0gbGRhICggRGlyZWN0aW9ufkxhZzErIExhZzIgLCBkYXRhPVNtYXJrZXQgLCBzdWJzZXQNCj10cmFpbikNCiMgVGjDtG5nIHRpbiBraMOhYyBiaeG7h3QgdHV54bq/biB0w61uaA0KbGRhLmZpdA0KYGBgDQoNCkvhur90IHF14bqjIGjDoG0gbGRhKCkgY2jhu4kgcmEgcuG6s25nIDQ5LjIlIGThu68gbGnhu4d1IGh14bqlbiBsdXnhu4duIGPDsyBkaXJlY3Rpb246IGRvd24NCg0KxJDhu5NuZyB0aOG7nWkgY2hvIGJp4bq/dCBnacOhIHRy4buLIHRydW5nIGLDrG5oIGPhu6dhIG3hu5dpIG5ow7NtIGJp4bq/biDEkeG6p3UgKExhZzEgdsOgIExhZzIpIHbDoG8gdMawxqFuZyDhu6luZyB24bubaSBt4buXaSBwaMOibiBsb+G6oWkgRG93biB2w6AgVXANCg0KSMOgbSBsZGEoKSBjxaluZyBjdW5nIGPhuqVwIG5o4buvbmcgaOG7hyBz4buRIHBow6JuIGJp4buHdCBMYWcxPSAtMC42NDIwMTkwIHbDoCBMYWcyID0gLTAuNTEzNTI5MywgbuG6v3UgLTAsNjQyIHggTGFnMSAtMCw1MTQgeCBMYWcyIGzhu5tuIHRow6wgTERBIHPhur0gZOG7sSDEkW/DoW4gcGjDom4gbG/huqFpIHRo4buLIHRyxrDhu51uZyB0xINuZy4gTuG6v3Ugbmjhu48gdGjDrCBz4bq9IGThu7EgxJFvw6FuIHRo4buLIHRyxrDhu51uZyBnaeG6o20NCg0KYGBge3J9DQojIEhp4buDbiAyIGJp4buDdSDEkeG7kyBj4buZdCBjaG8ga2jDoWMgc+G7sSBraMOhYyBiaeG7h3QgdHV54bq/biB0w61uaCBnaeG7r2EgbmjDs20gRGlyZWN0aW9uID0gRG93biB2w6AgVXANCnBsb3QobGRhLmZpdCkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBEw7luZyBow6BtIHRhYmxlKCkgxJHhu4MgdOG6oW8gcmEgbeG7mXQgbWEgdHLhuq1uIMSR4buDIHF1eeG6v3QgxJHhu4tuaCB4ZW0gY8OzIGJhbyBuaGnDqnUgcXVhbiBzw6F0IMSRxrDhu6NjIHBow6JuIGxv4bqhaSDEkcO6bmcsIGJhbyBuaGnDqnUgYuG7iyBwaMOibiBsb+G6oWkgc2FpDQp0YWJsZShnbG0ucHJlZCxEaXJlY3Rpb24uMjAwNSkNCmBgYA0KDQpU4buJIGzhu4cgZOG7sSDEkW/DoW4gxJHDum5nIG5o4buvbmcgbmfDoHkgdGjhu4sgdHLGsOG7nW5nIFVwIGzDoCAxMDYvKDEwNis3NikgPSA1OCwyJQ0KDQpgYGB7cn0NCiMgZOG7sSDEkW/DoW4gWFUgSMav4buaTkcgdGjhu4sgdHLGsOG7nW5nIHbhu5tpIGdpw6EgdHLhu4sgY+G7pSB0aOG7gyBj4bunYSBMYWcxID0gMS4yIFbDoCAxLjUsIExhZyAyPSAxLjEgdsOgIC0wLjgNCnByZWRpY3QoZ2xtLmZpdHMsbmV3ZGF0YT1kYXRhLmZyYW1lKExhZzE9YygxLjIsMS41KSwNCkxhZzI9YygxLjEsLTAuOCkpLHR5cGU9InJlc3BvbnNlIikNCmBgYA0KDQpgYGB7cn0NCiMgSMOgbSBwcmVkaWN0IGTDuW5nIMSR4buDIGThu7EgxJFvw6FuIHjDoWMgc3XhuqV0IHh1IGjGsOG7m25nIHRo4buLIHRyxrDhu51uZyBz4bq9IMSRaSBsw6puIChEaXJlY3Rpb24gPSBVcCkgduG7m2kgdOG6rXAgZGF0YSB04burIG7Eg20gMjAwNSB0cuG7nyDEkWkNCmxkYS5wcmVkPXByZWRpY3QobGRhLmZpdCwgU21hcmtldC4yMDA1KQ0KYGBgDQoNCg0KYGBge3J9DQojIFTDqm4gY8OhYyB0aHXhu5ljIHTDrW5oIHRyb25nIGxkYS5wcmVkDQpuYW1lcyhsZGEucHJlZCkNCmBgYA0KDQpjbGFzcyBjaOG7qWEgZOG7sSDEkW/DoW4gY+G7p2EgTERBIHbhu4Ega2jhuqMgbsSDbmcgZGkgY2h1eeG7g24gY+G7p2EgdGjhu4sgdHLGsOG7nW5nIGNobyAyNTIgZMOybmcgZOG7ryBsaeG7h3UgdOG7qyBuxINtIDIwMDUgdHLhu58gxJFpDQoNCnBvc3RlcmlvciBsw6AgeMOhYyBzdeG6pXQgaOG6rXUgbmdoaeG7h20sIHjDoWMgc3XhuqV0IGThu7EgxJFvw6FuIHRo4buLIHRyxrDhu51uZyDEkWkgbMOqbiBoYXkgxJFpIHh14buRbmcgY2hvIDI1MiBkw7JuZyBk4buvIGxp4buHdSB04burIG7Eg20gMjAwNSB0cuG7nyDEkWkNCg0KeCBsw6AgaOG7hyBz4buRIGtow6FjIGJp4buHdCB0dXnhur90IHTDrW5oIChsaW5lYXIgZGlzY3JpbWluYW50cykNCg0KYGBge3J9DQojIFLDunQgdHLDrWNoIHRow7RuZyB0aW4gduG7gSBjbGFzcyBjaOG7iSBjaOG7qWEgbmjhu69uZyBk4buxIMSRb8OhbiBVcCB2w6AgRG93biB04burIDI1MiBkw7JuZyBk4buvIGxp4buHdSB04burIG7Eg20gMjAwNSB0cuG7nyDEkWkNCmxkYS5jbGFzcz1sZGEucHJlZCRjbGFzcw0KYGBgDQoNCg0KYGBge3J9DQojIETDuW5nIGjDoG0gdGFibGUoKSDEkeG7gyB04bqhbyByYSBt4buZdCBtYSB0cuG6rW4gxJHhu4MgcXV54bq/dCDEkeG7i25oIHhlbSBjw7MgYmFvIG5oacOqdSBxdWFuIHPDoXQgxJHGsOG7o2MgcGjDom4gbG/huqFpIMSRw7puZywgYmFvIG5oacOqdSBi4buLIHBow6JuIGxv4bqhaSBzYWkNCnRhYmxlKGxkYS5jbGFzcyAsRGlyZWN0aW9uLjIwMDUpDQpgYGANCg0KYGBge3J9DQojIEThu7EgxJFvw6FuICVz4buRIG5nw6B5IGThu7EgxJFvw6FuIMSRw7puZw0KbWVhbihsZGEuY2xhc3M9PURpcmVjdGlvbi4yMDA1KQ0KYGBgDQoNCmBgYHtyfQ0KIyBU4buVbmcgc+G7kSBsxrDhu6NuZyBkw7JuZyBjw7MgeMOhYyBzdeG6pXQgZOG7sSDEkW/DoW4gPiAwLjUgdHJvbmcgdOG6rXAgZOG7ryBsaeG7h3UgdOG7qyBuxINtIDIwMDUgdHLhu58gxJFpDQpzdW0obGRhLnByZWQkcG9zdGVyaW9yIFsgLDFdPj0uNSkNCmBgYA0KDQpgYGB7cn0NCiMgVOG7lW5nIHPhu5EgbMaw4bujbmcgZMOybmcgY8OzIHjDoWMgc3XhuqV0IGThu7EgxJFvw6FuIDwgMC41IHRyb25nIHThuq1wIGThu68gbGnhu4d1IHThu6sgbsSDbSAyMDA1IHRy4bufIMSRaQ0Kc3VtKGxkYS5wcmVkJHBvc3RlcmlvciBbLDFdPC41KQ0KYGBgDQoNCg0KYGBge3J9DQojIEzhuqV5IDIwIGTDsm5nIHjDoWMgc3XhuqV0IGjhuq11IG5naGnhu4dtIMSR4bqndSB0acOqbg0KbGRhLnByZWQkcG9zdGVyaW9yWzE6MjAsMV0NCmBgYA0KDQpYw6FjIHN14bqldCBo4bqtdSBuZ2hp4buHbSBsw6AgeMOhYyBzdeG6pXQgdMawxqFuZyDhu6luZyB24bubaSB0aOG7iyB0csaw4budbmcgc+G6vSBnaeG6o20NCg0KYGBge3J9DQojIEzhuqV5IDIwIGTDsm5nIMSRxrDhu6NjIGThu7EgxJFvw6FuIFVwIGhv4bq3YyBEb3duIGPhu6dhIGThu68gbGnhu4d1IHThu6sgbsSDbSAyMDA1IHRy4bufIMSRaQ0KbGRhLmNsYXNzWzE6MjBdDQpgYGANCg0KYGBge3J9DQojIFThu5VuZyBz4buRIGzGsOG7o25nIGTDsm5nIGPDsyB4w6FjIHN14bqldCBk4buxIMSRb8OhbiA+IDAuOSB0cm9uZyB04bqtcCBk4buvIGxp4buHdSB04burIG7Eg20gMjAwNSB0cuG7nyDEkWkNCnN1bShsZGEucHJlZCRwb3N0ZXJpb3IgWywxXT4uOSkNCmBgYA0KDQpDaMO6bmcgdGEgZ2nhuqMgc+G7rSBy4bqxbmcgY2jDum5nIHRhIHPhur0gZOG7sSDEkW/DoW4gdGjhu4sgdHLGsOG7nW5nIGdp4bqjbSBu4bq/dSBjaMO6bmcgdGEgY2jhuq9jIGNo4bqvbiB0aOG7iyB0csaw4budbmcgc+G6vSBnaeG6o20gc8OidSB2w6BvIG5o4buvbmcgbmfDoHkgbsOgeS4gTmdoxKlhIGzDoCB4w6FjIHN14bqldCBo4bqtdSBuZ2hp4buHbSBwaOG6o2kgw610IG5o4bqldCBsw6AgOTAlLiANCg0KVHV5IG5oacOqbiBLaMO0bmcgY8OzIG5nw6B5IG7DoG8gdHJvbmcgbsSDbSAyMDA1IHRo4buPYSBtw6NuIMSRaeG7gXUga2nhu4duIG7DoHkuDQoNCiMgMikgw4FwIGThu6VuZyBRREENCg0KYGBge3J9DQojIFBow6JuIHTDrWNoIGtow6FjIGJp4buHdCBiw6xuaCBwaMawxqFuZyB24bubaSBjaOG7iSBjw7MgMiBiaeG6v24gxJHhuqd1IHbDoG8gTGFnMSB2w6AgbGFnMiB0cm9uZyB04bqtcCBk4buvIGxp4buHdSB0csaw4bubYyBuxINtIDIwMDUNCnFkYS5maXQgPSBxZGEgKERpcmVjdGlvbn5MYWcxKyBMYWcyICwgZGF0YT1TbWFya2V0ICwgc3Vic2V0ID10cmFpbikNCiMgVGjDtG5nIHRpbiBraMOhYyBiaeG7h3QgYsOsbmggcGjGsMahbmcNCnFkYS5maXQNCmBgYA0KDQpgYGB7cn0NCiMgUsO6dCB0csOtY2ggdGjDtG5nIHRpbiB24buBIGNsYXNzIGNo4buJIGNo4bupYSBuaOG7r25nIGThu7EgxJFvw6FuIFVwIHbDoCBEb3duIHThu6sgMjUyIGTDsm5nIGThu68gbGnhu4d1IHThu6sgbsSDbSAyMDA1IHRy4bufIMSRaQ0KcWRhLmNsYXNzPSBwcmVkaWN0KHFkYS5maXQsU21hcmtldC4yMDA1KSRjbGFzcw0KYGBgDQoNCg0KYGBge3J9DQojIETDuW5nIGjDoG0gdGFibGUoKSDEkeG7gyB04bqhbyByYSBt4buZdCBtYSB0cuG6rW4gxJHhu4MgcXV54bq/dCDEkeG7i25oIHhlbSBjw7MgYmFvIG5oacOqdSBxdWFuIHPDoXQgxJHGsOG7o2MgcGjDom4gbG/huqFpIMSRw7puZywgYmFvIG5oacOqdSBi4buLIHBow6JuIGxv4bqhaSBzYWkNCnRhYmxlKHFkYS5jbGFzcywgRGlyZWN0aW9uLjIwMDUpDQpgYGANCg0KYGBge3J9DQojIEThu7EgxJFvw6FuICVz4buRIG5nw6B5IGThu7EgxJFvw6FuIMSRw7puZw0KbWVhbihxZGEuY2xhc3M9PURpcmVjdGlvbi4yMDA1KQ0KYGBgDQoNClPhu60gZOG7pW5nIFFEQSBjaMO6bmcgdGEgY8OzIMSRxrDhu6NjIHThu4kgbOG7hyBk4buxIMSRb8OhbiDEkcO6bmcgY2FvIGjGoW4gaOG6s24gc28gduG7m2kgTERBLg0K