Princapal Component Analysis
Небожатко Екатерина
Данные
Описание признаков
(Уточнено у химиков)
residual sugar – остаточный сахар. Чем меньше, тем лучше, это означает, что скорее всего не добавляли сахарных сиропов и прочего, ведь такого в вине не должно быть в принципе
pH – показатель кислотности
total sulfur dioxide – полное содержание оксида серы (поступает из винограда и добавляют в качестве пищевой добавки-консерванта)
sulphates – содержание сульфатов (минеральная соль) – чем больше, тем лучше
volatile acidity – летучая кислотность (кислотность летучих кислот) – чем меньше, тем лучше, ибо повышенное содержание говорит о том, что вино скисало или имеет место быть наличие бактерий
quality - качество вина по шкале от 3 до 8
head(df1)## volatile.acidity residual.sugar total.sulfur.dioxide pH sulphates
## 1 0.70 1.9 34 3.51 0.56
## 2 0.88 2.6 67 3.20 0.68
## 3 0.76 2.3 54 3.26 0.65
## 4 0.28 1.9 60 3.16 0.58
## 5 0.70 1.9 34 3.51 0.56
## 6 0.66 1.8 40 3.51 0.56
## alcohol quality
## 1 9.4 5
## 2 9.8 5
## 3 9.8 5
## 4 9.8 6
## 5 9.4 5
## 6 9.4 5pairs.panels(df1, lm=TRUE)
Прологорифмируем некоторые признаки, чтобы распределения стали больше похожи на нормальные
df1$volatile.acidity <- log(df1$volatile.acidity)
df1$residual.sugar <- log(df1$residual.sugar)
df1$sulphates <- log(df1$sulphates)
df1$total.sulfur.dioxide <- log(df1$total.sulfur.dioxide)
df1$alcohol <- log(df1$alcohol)
pairs.panels(df1, lm=TRUE)
АГК до удаления выбросов
wine_q <- as.factor(df1[,7])
df_for_pca <- df1[,-7]
pca.df <- prcomp(df_for_pca, center=TRUE, scale. = TRUE)
sqrt_lambda <- pca.df$sdev
lambda <- sqrt_lambda^2
prop_var <- lambda/sum(lambda)
plot(prop_var, xlab = "Principal Component",ylab = "Proportion of Variance Explained", type = "b")
На этом scree plot не видно характерного изгиба, потому что процент объясненной доли у главных компонент не отличается очень существенно.
summary(pca.df)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.2341 1.1553 1.0396 0.9476 0.8164 0.70502
## Proportion of Variance 0.2538 0.2225 0.1801 0.1496 0.1111 0.08284
## Cumulative Proportion 0.2538 0.4763 0.6564 0.8061 0.9172 1.00000print(pca.df)## Standard deviations:
## [1] 1.2340789 1.1553356 1.0395977 0.9475522 0.8164432 0.7050183
##
## Rotation:
## PC1 PC2 PC3 PC4
## volatile.acidity -0.63935679 0.09574524 0.12177228 0.03283865
## residual.sugar 0.01367817 -0.28628280 0.75985672 0.48886131
## total.sulfur.dioxide -0.25616000 -0.51518194 0.33036764 -0.54848141
## pH -0.25001170 0.58299620 0.32894467 -0.47540861
## sulphates 0.52245703 -0.25596543 0.09279872 -0.48252396
## alcohol 0.43583328 0.48791363 0.42641565 0.01617638
## PC5 PC6
## volatile.acidity -0.62780184 -0.41474538
## residual.sugar -0.08707648 0.30643947
## total.sulfur.dioxide 0.41359606 -0.29653547
## pH 0.04470363 0.51126630
## sulphates -0.64113055 0.09503153
## alcohol 0.11905479 -0.61296298Главные компоненты довольно трудно поддаются интерпретации, потому что не очень хорошо представляю их значение с точки зрения химии.
Можно сказать, что первая главная компонента описывает качество вина. Знаки коэффициентов соответствуют описанию, которое я приводила выше. Не знаю как интерпретировать вторую.
g <- ggbiplot(pca.df, obs.scale = 1, var.scale = 1,
groups = wine_q, ellipse = TRUE,
circle = TRUE)
g <- g + scale_color_discrete(name = '')
g <- g + theme(legend.direction = 'horizontal',
legend.position = 'top')
print(g)
На этом графике собственно видно, что по оси первой главной компоненты вида разница по качеству. Так же можно отметить, что наблюдается рост качества с увеличением количества алкоголя и суфатов и уменьшением всего остального. Интерпретацию для второй главной компоненты мне придумать не удалось.
Найдем выбросы по Куку
АГК после удаления выбросов
wine_q <- as.factor(df2[,7])
df_for_pca <- df2[,-7]
pca.df <- prcomp(df_for_pca, center=TRUE, scale. = TRUE)
sqrt_lambda <- pca.df$sdev
lambda <- sqrt_lambda^2
prop_var <- lambda/sum(lambda)
plot(prop_var, xlab = "Principal Component",ylab = "Proportion of Variance Explained", type = "b")
summary(pca.df)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.266 1.1416 1.0486 0.9357 0.7944 0.69910
## Proportion of Variance 0.267 0.2172 0.1832 0.1459 0.1052 0.08146
## Cumulative Proportion 0.267 0.4842 0.6675 0.8134 0.9185 1.00000print(pca.df)## Standard deviations:
## [1] 1.2657445 1.1415614 1.0485604 0.9356755 0.7943706 0.6990968
##
## Rotation:
## PC1 PC2 PC3 PC4
## volatile.acidity -0.59131378 0.2223259 -0.1487614 0.0747024
## residual.sugar -0.06266161 -0.4147781 -0.6248458 0.5756172
## total.sulfur.dioxide -0.37432538 -0.4526777 -0.3390319 -0.5025034
## pH -0.08978832 0.5896769 -0.5094157 -0.3900545
## sulphates 0.47035202 -0.3646091 -0.1482844 -0.4825918
## alcohol 0.52631653 0.3048845 -0.4370383 0.1598042
## PC5 PC6
## volatile.acidity -0.68127254 0.3302673
## residual.sugar -0.03548371 -0.3178145
## total.sulfur.dioxide 0.37965946 0.3786422
## pH 0.11136172 -0.4692237
## sulphates -0.61134735 -0.1311504
## alcohol 0.06572909 0.6396688
g <- ggbiplot(pca.df, obs.scale = 1, var.scale = 1,
groups = wine_q, ellipse = TRUE,
circle = TRUE)
g <- g + scale_color_discrete(name = '')
g <- g + theme(legend.direction = 'horizontal',
legend.position = 'top')
print(g)
После удаления выбросов у нас совсем исчезло самое плохое по качеству вино и почти исчезло самое хорошее. Зато теперь более явно видено, что первая главная компонента отражает качество.