Bài tập trên lớp
Viết hàm hồi quy đa
biến, kiểm định mô hình
name <- function(dulieu,y,x, dubao){
# Viết hàm hồi quy
bphuthuoc <- paste(y, "~")
bdoclap <- paste(x,collapse = "+")
pt <- paste(bphuthuoc, bdoclap)
lm(pt, data = dulieu)
hoiquy<-lm(pt, data = dulieu)
print(hoiquy)
# Lập bảng thống kê mô tả
a <- summary(hoiquy)
# Ma trận tương quan
c <- cor(dulieu)
# Vẽ biểu đồ thể hiện sự tương quan giữa y với biến x1 (có thể tùy chọn thứ tự biến độc lập trong hàm)
dothi <-ggplot(dulieu, aes_string(x = x[1], y = y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "red") +
ggtitle(paste("Hồi quy cho", x, "and", y)) +
xlab(x) +
ylab(y)
# Kiểm định đa cộng tuyến
b <- ols_vif_tol(hoiquy)
# Kiểm định tự tương quan - Đurbin Watson
d <- lmtest::dwtest(hoiquy)
# Dự báo kết quả
p <- predict(hoiquy, newdata= dubao)
# In kết quả
print(dothi)
print("Thống kê mô tả")
print(a)
print("Kiểm định khuyết tật mô hình")
print(c)
print("Kiểm định đa cộng tuyến")
print(b)
print("Kiểm định sự tự tương quan")
print(d)
print("Dự báo")
print(p)
}
Hiển thị kết quả
##
## Call:
## lm(formula = pt, data = dulieu)
##
## Coefficients:
## (Intercept) peri perm
## 144.558 2.185 2.847

## [1] "Thống kê mô tả"
##
## Call:
## lm(formula = pt, data = dulieu)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3503.5 -860.2 -85.2 569.3 4676.5
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 144.5578 771.0387 0.187 0.852
## peri 2.1850 0.1969 11.097 1.81e-14 ***
## perm 2.8466 0.6438 4.421 6.14e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1303 on 45 degrees of freedom
## Multiple R-squared: 0.7745, Adjusted R-squared: 0.7645
## F-statistic: 77.27 on 2 and 45 DF, p-value: 2.797e-15
##
## [1] "Kiểm định khuyết tật mô hình"
## area peri shape perm
## area 1.0000000 0.8225064 -0.1821611 -0.3966370
## peri 0.8225064 1.0000000 -0.4331255 -0.7387158
## shape -0.1821611 -0.4331255 1.0000000 0.5567208
## perm -0.3966370 -0.7387158 0.5567208 1.0000000
## [1] "Kiểm định đa cộng tuyến"
## Variables Tolerance VIF
## 1 peri 0.454299 2.201193
## 2 perm 0.454299 2.201193
## [1] "Kiểm định sự tự tương quan"
##
## Durbin-Watson test
##
## data: hoiquy
## DW = 1.0575, p-value = 0.0001014
## alternative hypothesis: true autocorrelation is greater than 0
##
## [1] "Dự báo"
## 1
## 8904.366
Kết quả:
Hàm hồi quy có dạng Y = 144,56 + 2,185 peri + 2,847 perm
Ta có P-value(peri)= 1.81e-14, p_value(perm)= 6.14e-05 đều nhỏ
hơn mức ý nghĩa 0,05 nghĩa là khi biến peri thay đổi có ảnh hưởng đến
biến perm và ngược lại khi biến perm thay đổi cũng sẽ ảnh hưởng đến biến
peri.
Multiple R-squared: 0.7745 >0 => mô hình phù hợp
Adjusted R-squared: 0.7645 > 0 => các biến độc lập có sự
phù hợp trong mô hình
Ma trận tương quan, các hệ số tương quan giữa các cặp biến: ta
thấy cặp biến peri-area có hệ số tương quan là 0,82 lớn hơn 0,8 nghĩa là
2 biến này có sự tương quan với nhau, trong khi đó các cặp biến còn lại
đều có hệ số tương quan nhỏ hơn 0,8 nên các cặp biến đó không cớ sự
tương quan với nhau.
VIF < 10 nên không có hiện tượng đa cộng tuyến cao (1 phương
pháp chính xác hơn ma trận tương quan)
KIểm định Durbin-Watson test: p-value= 0,0001014< 0,05 cho ta
biết mô hình không xảy ra hiện tượng tự tương quan
Dự báo hàm hồi quy: Y = 144,56 + 2,185 peri + 2,847 perm khi
peri=4000 và perm=7 sẽ cho kết quả dự báo là 8904,366
LS0tDQp0aXRsZTogInB0aWVubmUiDQphdXRob3I6ICJscHRwdCINCmRhdGU6ICIyMDIzLTA3LTI1Ig0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IHRydWUNCiAgICB0b2NfZGVwdGg6IDUNCiAgICB0b2NfZmxvYXQ6IHRydWUNCiAgICBudW1iZXJfc2VjdGlvbjogdHJ1ZQ0KICAgIHRoZW1lOiBsdW1lbg0KICAgIGNvZGVfZm9sZGluZzogaGlkZQ0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCmVkaXRvcl9vcHRpb25zOiANCiAgbWFya2Rvd246IA0KICAgIHdyYXA6IDcyDQogICAgDQoNCi0tLQ0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkNCmBgYA0KDQojIELDoGkgdOG6rXAgdHLDqm4gbOG7m3AgDQoNCmBgYHtyLCAsIGVjaG89RkFMU0UsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9DQpsaWJyYXJ5KCJkcGx5ciIpDQpsaWJyYXJ5KCJ0aWR5dmVyc2UiKQ0KbGlicmFyeSgib2xzcnIiKQ0KbGlicmFyeSgicHJlZGljdDNkIikNCmxpYnJhcnkoImdncGxvdDIiKQ0KYGBgDQoNCiMgVmnhur90IGjDoG0gaOG7k2kgcXV5IMSRYSBiaeG6v24sIGtp4buDbSDEkeG7i25oIG3DtCBow6xuaCANCg0KYGBge3J9DQpuYW1lIDwtIGZ1bmN0aW9uKGR1bGlldSx5LHgsIGR1YmFvKXsNCg0KIyBWaeG6v3QgaMOgbSBo4buTaSBxdXkNCiAgYnBodXRodW9jIDwtIHBhc3RlKHksICJ+IikNCiAgYmRvY2xhcCA8LSBwYXN0ZSh4LGNvbGxhcHNlID0gIisiKQ0KICBwdCA8LSBwYXN0ZShicGh1dGh1b2MsIGJkb2NsYXApIA0KICBsbShwdCwgZGF0YSA9IGR1bGlldSkNCiAgaG9pcXV5PC1sbShwdCwgZGF0YSA9IGR1bGlldSkNCiAgcHJpbnQoaG9pcXV5KQ0KDQojIEzhuq1wIGLhuqNuZyB0aOG7kW5nIGvDqiBtw7QgdOG6ow0KICBhIDwtIHN1bW1hcnkoaG9pcXV5KQ0KIyBNYSB0cuG6rW4gdMawxqFuZyBxdWFuDQogIGMgPC0gY29yKGR1bGlldSkNCiMgVuG6vSBiaeG7g3UgxJHhu5MgdGjhu4MgaGnhu4duIHPhu7EgdMawxqFuZyBxdWFuIGdp4buvYSB5IHbhu5tpIGJp4bq/biB4MSAoY8OzIHRo4buDIHTDuXkgY2jhu41uIHRo4bupIHThu7EgYmnhur9uIMSR4buZYyBs4bqtcCB0cm9uZyBow6BtKQ0KICBkb3RoaSA8LWdncGxvdChkdWxpZXUsIGFlc19zdHJpbmcoeCA9IHhbMV0sIHkgPSB5KSkgKw0KICAgIGdlb21fcG9pbnQoKSArDQogICAgZ2VvbV9zbW9vdGgobWV0aG9kID0gImxtIiwgc2UgPSBGQUxTRSwgY29sb3IgPSAicmVkIikgKw0KICAgIGdndGl0bGUocGFzdGUoIkjhu5NpIHF1eSBjaG8iLCB4LCAiYW5kIiwgeSkpICsNCiAgICB4bGFiKHgpICsNCiAgICB5bGFiKHkpDQojIEtp4buDbSDEkeG7i25oIMSRYSBj4buZbmcgdHV54bq/bg0KICBiIDwtIG9sc192aWZfdG9sKGhvaXF1eSkNCiMgS2nhu4NtIMSR4buLbmggdOG7sSB0xrDGoW5nIHF1YW4gLSDEkHVyYmluIFdhdHNvbg0KICBkIDwtIGxtdGVzdDo6ZHd0ZXN0KGhvaXF1eSkNCiMgROG7sSBiw6FvIGvhur90IHF14bqjDQogIHAgPC0gcHJlZGljdChob2lxdXksIG5ld2RhdGE9IGR1YmFvKQ0KIyBJbiBr4bq/dCBxdeG6ow0KICBwcmludChkb3RoaSkNCiAgcHJpbnQoIlRo4buRbmcga8OqIG3DtCB04bqjIikgDQogIHByaW50KGEpDQogIHByaW50KCJLaeG7g20gxJHhu4tuaCBraHV54bq/dCB04bqtdCBtw7QgaMOsbmgiKQ0KICBwcmludChjKQ0KICBwcmludCgiS2nhu4NtIMSR4buLbmggxJFhIGPhu5luZyB0dXnhur9uIikNCiAgcHJpbnQoYikNCiAgcHJpbnQoIktp4buDbSDEkeG7i25oIHPhu7EgdOG7sSB0xrDGoW5nIHF1YW4iKQ0KICBwcmludChkKQ0KICBwcmludCgiROG7sSBiw6FvIikNCiAgcHJpbnQocCkNCn0NCg0KYGBgDQoNCg0KIyBIaeG7g24gdGjhu4sga+G6v3QgcXXhuqMgDQoNCi0gICBEYXRhc2V0IMSRxrDhu6NjIGNo4buNbiBsw6AgInJvY2siIHThu6sgcGFja2FnZSAiZGF0YXNldCIuICJyb2NrIiBsw6AgbeG7mXQga2h1bmcgZOG7ryBsaeG7h3UgduG7gSBraOG6o28gc8OhdCBjw6FjIG3huqt1IMSRw6EgdHJvbmcgbeG7mXQgbeG7jyBk4bqndSBjaOG7qWEgNDYgcXVhbiBzw6F0IHRyw6puIDMgYmnhur9uOg0KDQogICAgLSAgIFsxXSBhcmU6IGRp4buHbiB0w61jaCBs4buXIHLhu5duZywgdMOtbmggYuG6sW5nIHBpeGVsIHRyw6puIDI1NiB4IDI1Ng0KICAgIC0gICBbMl0gcGVyaTogY2h1IHZpIHTDrW5oIGLhurFuZyBwaXhlbA0KICAgIC0gICBbM10gc2hhcGU6IHThu4kgc+G7kSBj4bunYSBjaHUgdmkgdsOgIGPEg24gaGFpIGPhu6dhIGRp4buHbiB0w61jaA0KICAgIC0gICBbNF0gcGVybTogxJHhu5kgdGjhuqVtIHBlcm0gdMOtbmggYuG6sW5nIG1pbGxpLURhcmNpZXMNCg0KYGBge3IsZWNobz1GQUxTRSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmR1YmFvIDwtIGRhdGEuZnJhbWUocGVyaT0gNDAwMCwgcGVybT0gNykNCm5hbWUocm9jaywgImFyZWEiLCBjKCJwZXJpIiwgInBlcm0iKSwgZHViYW8pDQpgYGANCg0KLSBL4bq/dCBxdeG6ozoNCg0KICArIEjDoG0gaOG7k2kgcXV5IGPDsyBk4bqhbmcNCiAgWSA9IDE0NCw1NiArIDIsMTg1IHBlcmkgKyAyLDg0NyBwZXJtIA0KICArIFRhIGPDsyBQLXZhbHVlKHBlcmkpPSAxLjgxZS0xNCwgcF92YWx1ZShwZXJtKT0gNi4xNGUtMDUgxJHhu4F1IG5o4buPIGjGoW4gbeG7qWMgw70gbmdoxKlhIDAsMDUgbmdoxKlhIGzDoCBraGkgYmnhur9uIHBlcmkgdGhheSDEkeG7lWkgY8OzIOG6o25oIGjGsOG7n25nIMSR4bq/biBiaeG6v24gcGVybSB2w6AgbmfGsOG7o2MgbOG6oWkga2hpIGJp4bq/biBwZXJtIHRoYXkgxJHhu5VpIGPFqW5nIHPhur0g4bqjbmggaMaw4bufbmcgxJHhur9uIGJp4bq/biBwZXJpLg0KICArIE11bHRpcGxlIFItc3F1YXJlZDogIDAuNzc0NSA+MCA9PiBtw7QgaMOsbmggcGjDuSBo4bujcA0KICArIEFkanVzdGVkIFItc3F1YXJlZDogIDAuNzY0NSA+IDAgPT4gY8OhYyBiaeG6v24gxJHhu5ljIGzhuq1wIGPDsyBz4buxIHBow7kgaOG7o3AgdHJvbmcgbcO0IGjDrG5oDQogIA0KICArIE1hIHRy4bqtbiB0xrDGoW5nIHF1YW4sIGPDoWMgaOG7hyBz4buRIHTGsMahbmcgcXVhbiBnaeG7r2EgY8OhYyBj4bq3cCBiaeG6v246IHRhIHRo4bqleSBj4bq3cCBiaeG6v24gcGVyaS1hcmVhIGPDsyBo4buHIHPhu5EgdMawxqFuZyBxdWFuIGzDoCAwLDgyIGzhu5tuIGjGoW4gMCw4IG5naMSpYSBsw6AgMiBiaeG6v24gbsOgeSBjw7Mgc+G7sSB0xrDGoW5nIHF1YW4gduG7m2kgbmhhdSwgdHJvbmcga2hpIMSRw7MgY8OhYyBj4bq3cCBiaeG6v24gY8OybiBs4bqhaSDEkeG7gXUgY8OzIGjhu4cgc+G7kSB0xrDGoW5nIHF1YW4gbmjhu48gaMahbiAwLDggbsOqbiBjw6FjIGPhurdwIGJp4bq/biDEkcOzIGtow7RuZyBj4bubIHPhu7EgdMawxqFuZyBxdWFuIHbhu5tpIG5oYXUuDQogIA0KICArIFZJRiA8IDEwIG7Dqm4ga2jDtG5nIGPDsyBoaeG7h24gdMaw4bujbmcgxJFhIGPhu5luZyB0dXnhur9uIGNhbyAoMSBwaMawxqFuZyBwaMOhcCBjaMOtbmggeMOhYyBoxqFuIG1hIHRy4bqtbiB0xrDGoW5nIHF1YW4pDQogIA0KICArIEtJ4buDbSDEkeG7i25oIER1cmJpbi1XYXRzb24gdGVzdDogcC12YWx1ZT0gMCwwMDAxMDE0PCAwLDA1IGNobyB0YSBiaeG6v3QgbcO0IGjDrG5oIGtow7RuZyB44bqjeSByYSBoaeG7h24gdMaw4bujbmcgdOG7sSB0xrDGoW5nIHF1YW4NCiAgDQogICsgROG7sSBiw6FvIGjDoG0gaOG7k2kgcXV5OiBZID0gMTQ0LDU2ICsgMiwxODUgcGVyaSArIDIsODQ3IHBlcm0ga2hpIHBlcmk9NDAwMCB2w6AgcGVybT03DQpz4bq9IGNobyBr4bq/dCBxdeG6oyBk4buxIGLDoW8gbMOgIDg5MDQsMzY2DQoNCg==