1 Bài tập trên lớp

2 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)
}

3 Hiển thị kết quả

  • Dataset được chọn là “rock” từ package “dataset”. “rock” là một khung dữ liệu về khảo sát các mẫu đá trong một mỏ dầu chứa 46 quan sát trên 3 biến:

    • [1] are: diện tích lỗ rỗng, tính bằng pixel trên 256 x 256
    • [2] peri: chu vi tính bằng pixel
    • [3] shape: tỉ số của chu vi và căn hai của diện tích
    • [4] perm: độ thấm perm tính bằng milli-Darcies
## 
## 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==