Список используемых packages для выполнения этой работы
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.0.3
## -- Attaching packages --------------- tidyverse 1.3.0 --
## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.2
## v tidyr 1.1.2 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.0
## Warning: package 'ggplot2' was built under R version 4.0.3
## Warning: package 'tidyr' was built under R version 4.0.3
## Warning: package 'readr' was built under R version 4.0.3
## Warning: package 'forcats' was built under R version 4.0.3
## -- Conflicts ------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.0.3
## corrplot 0.84 loaded
library(car)
## Warning: package 'car' was built under R version 4.0.3
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.0.3
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
## The following object is masked from 'package:purrr':
##
## some
library(caret)
## Warning: package 'caret' was built under R version 4.0.3
## Loading required package: lattice
##
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
##
## lift
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.0.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
Визуализируем наши данные, которые представляют из себя описание состава красных вин и их качество (от 0 до 10). Для этого мы построили график изображающий на диагонали распределение переменных и на пересечениях строит зависимости между переменными и регрессионную прямую.
df_red <- read.csv('red_wine.csv', header = TRUE, sep = ',') %>% na.omit()
head(df_red)
## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1 7.4 0.70 0.00 1.9 0.076
## 2 7.8 0.88 0.00 2.6 0.098
## 3 7.8 0.76 0.04 2.3 0.092
## 4 11.2 0.28 0.56 1.9 0.075
## 5 7.4 0.70 0.00 1.9 0.076
## 6 7.4 0.66 0.00 1.8 0.075
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1 11 34 0.9978 3.51 0.56 9.4
## 2 25 67 0.9968 3.20 0.68 9.8
## 3 15 54 0.9970 3.26 0.65 9.8
## 4 17 60 0.9980 3.16 0.58 9.8
## 5 11 34 0.9978 3.51 0.56 9.4
## 6 13 40 0.9978 3.51 0.56 9.4
## quality
## 1 5
## 2 5
## 3 5
## 4 6
## 5 5
## 6 5
scatterplotMatrix(df_red, cex.main = 1000)
Помимо этого для большей наглядности и подготовки для работы с линейной регрессией (в частности для проверки мультиколлинеарности считаем корреляцию между переменными).
M <- cor(df_red)
corrplot(M, method = "circle")
Теперь для полноценной работы с линейной регрессией и попыткой определить значимые переменные, влияющие на качество красного вина, разделим нашу выборку на train(80%) и test(20%). После этого пытаемся сделать линейную модель зависимости качества вина от всех остальных параметров (заранее отметив что на первых двух графиках выделяются зависимые между сабой переменные, которые в последствии надо убрать). После этого проверяем нашу модель на тестовой выборке. Отмечаем для себя RMSE и R2.
set.seed(06101998)
training.samples <- df_red$quality %>% createDataPartition(p = 0.8, list = FALSE)
train.data <- df_red[training.samples, ]
test.data <- df_red[-training.samples, ]
model1 <- lm(quality ~., data = train.data)
predictions_model1 <- model1 %>% predict(test.data)
summary(model1)
##
## Call:
## lm(formula = quality ~ ., data = train.data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.79745 -0.36668 -0.05426 0.43909 2.08489
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.704e+01 2.390e+01 0.713 0.476095
## fixed.acidity 3.367e-02 2.924e-02 1.152 0.249683
## volatile.acidity -1.096e+00 1.316e-01 -8.329 < 2e-16 ***
## citric.acid -1.558e-01 1.651e-01 -0.944 0.345456
## residual.sugar 8.877e-03 1.686e-02 0.527 0.598623
## chlorides -1.733e+00 4.729e-01 -3.664 0.000259 ***
## free.sulfur.dioxide 6.210e-03 2.449e-03 2.535 0.011355 *
## total.sulfur.dioxide -3.982e-03 8.455e-04 -4.710 2.75e-06 ***
## density -1.352e+01 2.438e+01 -0.555 0.579228
## pH -2.223e-01 2.129e-01 -1.044 0.296676
## sulphates 9.463e-01 1.258e-01 7.520 1.03e-13 ***
## alcohol 2.641e-01 3.005e-02 8.790 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6445 on 1269 degrees of freedom
## Multiple R-squared: 0.3681, Adjusted R-squared: 0.3626
## F-statistic: 67.2 on 11 and 1269 DF, p-value: < 2.2e-16
data.frame(
RMSE = RMSE(predictions_model1, test.data$quality),
R2 = R2(predictions_model1, test.data$quality)
)
## RMSE R2
## 1 0.6662178 0.3220679
Теперь мы хотим проверить наверняка и попытаться избавиться от зависимых независимых переменных). Для этого сначала воспользуемся коэффициентом вздутия.
vif(model1)
## fixed.acidity volatile.acidity citric.acid
## 7.796089 1.736642 3.121401
## residual.sugar chlorides free.sulfur.dioxide
## 1.744058 1.549066 2.015661
## total.sulfur.dioxide density pH
## 2.242904 6.536405 3.352275
## sulphates alcohol
## 1.447917 3.181133
Среди полученных значений явно выделяются 2 величины fixed.acidity и density, у которых значения самые большие (и в некоторых источниках предлагают отказываться от значений >5). Это мы и делаем. Для этого мы делаем новую модель, из которой мы убираем выбранные нами переменные. Проведя аналогичные действия как с первой моделью мы также отмечаем для себя RMSE и R2. При этом видно, что хоть и не значительно, но RMSE уменьшился, а R2 увеличился. Это говорит о том, что идем мы в верном направлении.
model2 <- lm(quality ~. -density - fixed.acidity, data = train.data)
predictions_model2 <- model2 %>% predict(test.data)
summary(model2)
##
## Call:
## lm(formula = quality ~ . - density - fixed.acidity, data = train.data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.74367 -0.37009 -0.04875 0.43969 2.08744
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.3033640 0.5131936 8.385 < 2e-16 ***
## volatile.acidity -1.0677823 0.1270737 -8.403 < 2e-16 ***
## citric.acid -0.0502360 0.1368241 -0.367 0.71356
## residual.sugar 0.0046681 0.0132739 0.352 0.72514
## chlorides -1.9122592 0.4510455 -4.240 2.40e-05 ***
## free.sulfur.dioxide 0.0065145 0.0024303 2.681 0.00744 **
## total.sulfur.dioxide -0.0042908 0.0008099 -5.298 1.38e-07 ***
## pH -0.3951199 0.1485622 -2.660 0.00792 **
## sulphates 0.9437973 0.1217132 7.754 1.81e-14 ***
## alcohol 0.2737183 0.0193343 14.157 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6444 on 1271 degrees of freedom
## Multiple R-squared: 0.3673, Adjusted R-squared: 0.3628
## F-statistic: 81.97 on 9 and 1271 DF, p-value: < 2.2e-16
data.frame(
RMSE = RMSE(predictions_model2, test.data$quality),
R2 = R2(predictions_model2, test.data$quality)
)
## RMSE R2
## 1 0.6649895 0.324596
Далее я решил проверить, можно ли явно зависимые величины (чисто из логических умозаключений и первых двух графиков) попыцтаться тоже убрать, не обращая внимание на их низкий коэффициент вздутия. Очевидно, что free.sulfur.dioxide и total.sulfur.dioxide зависимы (это видно и из графиков), также я посчитал, что количество кислот (помимо fixed.acidity) можно выразить и через pH (поэтому вообще поидеи можно отказаться от описания концентрации различных кислот потому что это физически отображается на pH). И еще мне показалось логичным отказаться от плотности (и без ее коэффициента вздутия), которая также зависит от количества алкоголя и концентраций кислот, которые зависят от pH. Таким образом дополнительно я решил убрать еще 2 независимые переменные: free.sulfur.dioxide, citric.acid. Проделав тот же набор действий, что и с первой моделью, снова выписываем RMSE и R2. Которые опять уменьшилось и увеличилось соответственно. Можно сделать вывод, что зависимость между независимыми переменными действительно влияют на качество линейной модели (хотя мне не повезло это увидеть во всей красе, видимо из-за нехватки признаков, которых очень много есть у вина для оценки его качества).
model3 <- lm(quality ~. -density - fixed.acidity - free.sulfur.dioxide - citric.acid, data = train.data)
predictions_model3 <- model3 %>% predict(test.data)
summary(model3)
##
## Call:
## lm(formula = quality ~ . - density - fixed.acidity - free.sulfur.dioxide -
## citric.acid, data = train.data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.63638 -0.36801 -0.05703 0.44142 1.99835
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.0307212 0.4480041 8.997 < 2e-16 ***
## volatile.acidity -1.0792712 0.1110950 -9.715 < 2e-16 ***
## residual.sugar 0.0086697 0.0130971 0.662 0.5081
## chlorides -1.9071384 0.4468489 -4.268 2.12e-05 ***
## total.sulfur.dioxide -0.0028446 0.0005949 -4.782 1.94e-06 ***
## pH -0.3098178 0.1298307 -2.386 0.0172 *
## sulphates 0.9366437 0.1215091 7.708 2.55e-14 ***
## alcohol 0.2749784 0.0189926 14.478 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6459 on 1273 degrees of freedom
## Multiple R-squared: 0.3634, Adjusted R-squared: 0.3599
## F-statistic: 103.8 on 7 and 1273 DF, p-value: < 2.2e-16
data.frame(
RMSE = RMSE(predictions_model3, test.data$quality),
R2 = R2(predictions_model3, test.data$quality)
)
## RMSE R2
## 1 0.6623937 0.3301312
Далее было интересно попробовать метод понижения размерности, хотя бы потому, что он мне понадобится для решения задач в моей курсовой. Для начала я посмотрел на то как у меня вообще распределена величина - качество вина. На графике ниже видно, что качество вин в основном равняется 5,6,7. Поэтому чтобы упростить работу с понижением размерности и улучшить визуальную составляющую моего последнего графика я решил посмотреть именно на те данные качество которых равнялось 5, 6 или 7. После этого, убрав из моих данных столбцы с выброшенными переменными, я запустил PCA. Дальше я построил стандартный для этого метода график отношения процентов объясненной дисперсии от числа dimention. На нем видно. После я построил график переменных. Положительно коррелированные переменные указывают на одну и ту же сторону графика. Отрицательные коррелированные переменные указывают на противоположные стороны графика. Окрашены они по вклады в компоненты. Ну и на последок было интересно как же легли мои точки на этот график. Собственно последний график и показывает расположение отдельных точек из 3 групп с разным качеством. При этом можно увидеть (в идеале конечно сделать кластеризацию), что ак минимум 5 и 7 качества неплохо разделяются, хотя и группа 6 впринципе похоже, что тоже имеет некоторую собственную область. Это говорит о том, что впринципе можно найти такие независимые переменные, которые могли бы приближенно различать несколько разных вин по качеству. нууууу, теперь и машинку можно ) (шучу).
p = ggplot(data = df_red, aes (quality, fill=quality))
p + geom_bar()
df_red_pca = df_red[df_red$quality == c(5,6,7), ]
c <- c(8, 1, 6, 3, 12)
res.pca <- prcomp(df_red_pca[-c], scale = TRUE, center = TRUE)
fviz_eig(res.pca)
groups <- as.factor(df_red_pca$quality)
fviz_pca_var(res.pca,
col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE
)
fviz_pca_ind(res.pca,
col.ind = groups,
addEllipses = TRUE,
ellipse.type = "confidence",
legend.title = "Groups",
repel = TRUE
)
## Warning: ggrepel: 449 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
