concrete_data <- read.csv("C:/Users/Windows 10 Pro/Downloads/concrete.csv")
head(concrete_data,10)
## cement slag ash water superplastic coarseagg fineagg age strength
## 1 141.3 212.0 0.0 203.5 0.0 971.8 748.5 28 29.89
## 2 168.9 42.2 124.3 158.3 10.8 1080.8 796.2 14 23.51
## 3 250.0 0.0 95.7 187.4 5.5 956.9 861.2 28 29.22
## 4 266.0 114.0 0.0 228.0 0.0 932.0 670.0 28 45.85
## 5 154.8 183.4 0.0 193.3 9.1 1047.4 696.7 28 18.29
## 6 255.0 0.0 0.0 192.0 0.0 889.8 945.0 90 21.86
## 7 166.8 250.2 0.0 203.5 0.0 975.6 692.6 7 15.75
## 8 251.4 0.0 118.3 188.5 6.4 1028.4 757.7 56 36.64
## 9 296.0 0.0 0.0 192.0 0.0 1085.0 765.0 28 21.65
## 10 155.0 184.0 143.0 194.0 9.0 880.0 699.0 28 28.99
apply(is.na(concrete_data),2,which)
## integer(0)
mean<-apply(concrete_data,2,mean)
sd<-apply(concrete_data,2,sd)
min<-apply(concrete_data,2,min)
max<-apply(concrete_data,2,max)
med<-apply(concrete_data,2,median)
Q1<-apply(concrete_data,2,quantile,probs=0.25)
Q3<-apply(concrete_data,2,quantile,probs=0.75)
t(data.frame(mean, sd,min, max, med, Q1, Q3))
## cement slag ash water superplastic coarseagg fineagg
## mean 281.1679 73.89583 54.18835 181.56728 6.204660 972.91893 773.58049
## sd 104.5064 86.27934 63.99700 21.35422 5.973841 77.75395 80.17598
## min 102.0000 0.00000 0.00000 121.80000 0.000000 801.00000 594.00000
## max 540.0000 359.40000 200.10000 247.00000 32.200000 1145.00000 992.60000
## med 272.9000 22.00000 0.00000 185.00000 6.400000 968.00000 779.50000
## Q1 192.3750 0.00000 0.00000 164.90000 0.000000 932.00000 730.95000
## Q3 350.0000 142.95000 118.30000 192.00000 10.200000 1029.40000 824.00000
## age strength
## mean 45.66214 35.81796
## sd 63.16991 16.70574
## min 1.00000 2.33000
## max 365.00000 82.60000
## med 28.00000 34.44500
## Q1 7.00000 23.71000
## Q3 56.00000 46.13500
Vẽ ma trận tương quan(ma trận thể hiện hệ số hồi quy ứng với từng cặp biến) -> Mục tiêu xét có hiện tượng đa cộng tuyến hay không(vì nếu xảy ra hiện tượng đa cộng tuyến,không tìm được hệ số hồi quy ứng với biến đó ) -> Là hiện tượng các biến độc lập có quan hệ với nhau
IV.Mô HÌNH HỒI QUY ĐA BIẾN
Chia dữ liệu với 1030 obs thành 2 phần theo tỉ lệ 8:2 Phần lớn chiếm 80% (824 obs) thành biến train_data để xây dựng phương trình hồi quy
Phần nhỏ chiếm 20% (206 obs) thành biến test_data để thực hiện đánh giá lại mô hình và dự báo
set.seed (10)
train.rows <- sample( rownames ( concrete_data ) , dim ( concrete_data ) [1] * 0.8)
train_data <- concrete_data [ train.rows , ]
test.rows <- setdiff( rownames ( concrete_data ) , train.rows )
test_data <- concrete_data [ test.rows , ]
model_1<-lm(strength~cement + slag+ash+water + superplastic+ coarseagg + fineagg + age
,train_data)
summary(model_1)
##
## Call:
## lm(formula = strength ~ cement + slag + ash + water + superplastic +
## coarseagg + fineagg + age, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.865 -6.150 0.664 6.535 32.970
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.439204 29.526134 -0.015 0.9881
## cement 0.114715 0.009327 12.299 < 2e-16 ***
## slag 0.098213 0.011164 8.797 < 2e-16 ***
## ash 0.085492 0.013711 6.235 7.23e-10 ***
## water -0.182503 0.044658 -4.087 4.81e-05 ***
## superplastic 0.238134 0.102825 2.316 0.0208 *
## coarseagg 0.009170 0.010507 0.873 0.3831
## fineagg 0.012617 0.011813 1.068 0.2858
## age 0.111079 0.005869 18.925 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.35 on 815 degrees of freedom
## Multiple R-squared: 0.6204, Adjusted R-squared: 0.6166
## F-statistic: 166.5 on 8 and 815 DF, p-value: < 2.2e-16
LỰA CHỌN MÔ HÌNH TỐT NHẤT
#Xây dựng mô hình thứ hai loại đi hai biến coarseagg và fineagg có ảnh hưởng đến biến strength
#Cách 1: loại lần lượt từng biến model_2 loại biến fineagg (P_value lớn hơn vì P càng lớn càng không có ý nghĩa ) model_3 loại biến coarseagg và biến fineagg
model_2<-lm(strength~.-fineagg,data = train_data)
summary(model_2)
##
## Call:
## lm(formula = strength ~ . - fineagg, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.188 -6.382 0.581 6.649 32.678
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 29.3021369 9.8143346 2.986 0.00291 **
## cement 0.1062197 0.0048711 21.806 < 2e-16 ***
## slag 0.0880244 0.0058003 15.176 < 2e-16 ***
## ash 0.0741636 0.0086886 8.536 < 2e-16 ***
## water -0.2210131 0.0263492 -8.388 < 2e-16 ***
## superplastic 0.2177658 0.1010494 2.155 0.03145 *
## coarseagg -0.0001685 0.0058272 -0.029 0.97694
## age 0.1105371 0.0058479 18.902 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.35 on 816 degrees of freedom
## Multiple R-squared: 0.6198, Adjusted R-squared: 0.6166
## F-statistic: 190.1 on 7 and 816 DF, p-value: < 2.2e-16
#So sánh mô hình 1 và 2 sử dụng lệnh Anova dùng để chọn mô hình phù hợp chứ không phải phân tích phương sai
anova(model_1,model_2)
## Analysis of Variance Table
##
## Model 1: strength ~ cement + slag + ash + water + superplastic + coarseagg +
## fineagg + age
## Model 2: strength ~ (cement + slag + ash + water + superplastic + coarseagg +
## fineagg + age) - fineagg
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 815 87329
## 2 816 87451 -1 -122.22 1.1406 0.2858
H0: Mô hình 2 hiệu quả hơn
H1: Mô hình 1 hiệu quả hơn
pvalue=0.05949 > mức ý nghĩa 5% -> Chưa bác bỏ H0 -> mô hình 2 hiệu quả hơn
Nhưng trong mô hình 2 vẫn có biến coroarseagg không có nghĩa -> loại tiếp biến coarseagg
-> xây dựng mô hình 3
model_3<-lm(strength~.-fineagg - coarseagg,data = train_data)
summary(model_3)
##
## Call:
## lm(formula = strength ~ . - fineagg - coarseagg, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.191 -6.381 0.587 6.655 32.668
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 29.051637 4.604987 6.309 4.61e-10 ***
## cement 0.106253 0.004729 22.467 < 2e-16 ***
## slag 0.088076 0.005519 15.957 < 2e-16 ***
## ash 0.074200 0.008592 8.636 < 2e-16 ***
## water -0.220659 0.023310 -9.466 < 2e-16 ***
## superplastic 0.218934 0.092560 2.365 0.0182 *
## age 0.110534 0.005843 18.917 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.35 on 817 degrees of freedom
## Multiple R-squared: 0.6198, Adjusted R-squared: 0.6171
## F-statistic: 222 on 6 and 817 DF, p-value: < 2.2e-16
anova(model_2,model_3)
## Analysis of Variance Table
##
## Model 1: strength ~ (cement + slag + ash + water + superplastic + coarseagg +
## fineagg + age) - fineagg
## Model 2: strength ~ (cement + slag + ash + water + superplastic + coarseagg +
## fineagg + age) - fineagg - coarseagg
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 816 87451
## 2 817 87451 -1 -0.08956 8e-04 0.9769
H0: Mô hình 3 hiệu quả hơn
H1: Mô hình 2 hiệu quả hơn
pvalue=0.519 > mức ý nghĩa 5% -> Chưa bác bỏ H0 -> mô hình 3 hiệu quả hơn
-> Mô hình 3 là mô hình hiệu quả nhất
-> Nhận thấy mô hình loại cả hai biến phù hợp hơn:
#Cách 2:Loại cả hai biến cùng lúc trong model_2
model_2<-lm(strength~cement + slag+ash+water + superplastic+age,data = train_data)
summary(model_2)
##
## Call:
## lm(formula = strength ~ cement + slag + ash + water + superplastic +
## age, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.191 -6.381 0.587 6.655 32.668
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 29.051637 4.604987 6.309 4.61e-10 ***
## cement 0.106253 0.004729 22.467 < 2e-16 ***
## slag 0.088076 0.005519 15.957 < 2e-16 ***
## ash 0.074200 0.008592 8.636 < 2e-16 ***
## water -0.220659 0.023310 -9.466 < 2e-16 ***
## superplastic 0.218934 0.092560 2.365 0.0182 *
## age 0.110534 0.005843 18.917 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.35 on 817 degrees of freedom
## Multiple R-squared: 0.6198, Adjusted R-squared: 0.6171
## F-statistic: 222 on 6 and 817 DF, p-value: < 2.2e-16
anova(model_1,model_2)
## Analysis of Variance Table
##
## Model 1: strength ~ cement + slag + ash + water + superplastic + coarseagg +
## fineagg + age
## Model 2: strength ~ cement + slag + ash + water + superplastic + age
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 815 87329
## 2 817 87451 -2 -122.31 0.5707 0.5653
H0: Mô hình 2 hiệu quả hơn(mô hình loại đi hai biến)
H1: Mô hình 1 hiệu quả hơn(mô hình đầy đủ)
pvalue = 0.1375 > mức ý nghĩa 5% -> chưa bác bỏ H0 -> Mô hình hai hiệu quả hơn
KIỂm TRA ĐÁNH GIÁ CÁC MÔ HÌNH
Điều kiện của mô hình hổi quy 1. Y và các biến độc lập X phải có quan hệ tuyến tính 2. Các sai số dộc lập nhau 3. Các sai số có phân hối chuẩn với kỳ vọng=0 và phương sai là hằng số
#Để kiểm tra mô hình hồi quy Có hai phương pháp:vẽ đồ thị(plot) và phương pháp kiểm định
plot(model_2,which=1)
plot(model_2,which=2)
plot(model_2,which=3)
plot(model_2,which=5)
#Dự báo
test_data$predicted <- predict ( model_2 , test_data )
head ( test_data ,10)
## cement slag ash water superplastic coarseagg fineagg age strength
## 2 168.9 42.2 124.3 158.3 10.8 1080.8 796.2 14 23.51
## 3 250.0 0.0 95.7 187.4 5.5 956.9 861.2 28 29.22
## 14 237.5 237.5 0.0 228.0 0.0 932.0 594.0 7 26.26
## 15 167.0 187.0 195.0 185.0 7.0 898.0 636.0 28 23.89
## 21 229.7 0.0 118.2 195.2 6.1 1028.1 757.6 3 13.36
## 24 132.0 207.0 161.0 179.0 5.0 867.0 736.0 28 33.30
## 28 425.0 106.3 0.0 153.5 16.5 852.1 887.1 91 65.20
## 30 255.0 99.0 77.0 189.0 6.0 919.0 749.0 28 33.80
## 37 165.0 0.0 143.6 163.8 0.0 1005.6 900.9 14 16.88
## 38 277.2 97.8 24.5 160.7 11.2 1061.7 782.5 14 47.71
## predicted
## 2 28.91930
## 3 25.66347
## 14 25.66826
## 15 41.54064
## 21 20.82291
## 24 37.94658
## 28 63.37149
## 30 33.28310
## 37 22.64207
## 38 37.47636
# Vẽ đồ thị so sánh giá trị thực tế và giá trị dự báo xem có phù hợp hay không
library ( ggplot2 )
ggplot(test_data, aes(x = strength, y = predicted)) +
geom_point() +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
labs(title = "Actual vs Predicted",
x = "Actual Values",
y = "Predicted Values") +
theme_minimal()