O conjunto de dados possui 4.898 observações com 12 variáveis sobre as propriedades físicas e químicas do vinho branco. Os 5 especialistas em vinhos avaliaram a qualidade de cada vinho, fornecendo uma classificação entre 0 e 10. A seguir apresentam-se as 12 variáveis:

Além disso, o objetivo do projeto é construir um modelo de classificação que preveja sua qualidade com base nas características físicas e químicas do vinho (a qualidade do vinho foi avaliada com base em seu sabor).

library("tidyverse")
glimpse(dados)
## Observations: 4,898
## Variables: 12
## $ fixed.acidity        <fct> 7, 6.3, 8.1, 7.2, 7.2, 8.1, 6.2, 7, 6.3, ...
## $ volatile.acidity     <fct> 0.27, 0.3, 0.28, 0.23, 0.23, 0.28, 0.32, ...
## $ citric.acid          <fct> 0.36, 0.34, 0.4, 0.32, 0.32, 0.4, 0.16, 0...
## $ residual.sugar       <fct> 20.7, 1.6, 6.9, 8.5, 8.5, 6.9, 7, 20.7, 1...
## $ chlorides            <fct> 0.045, 0.049, 0.05, 0.058, 0.058, 0.05, 0...
## $ free.sulfur.dioxide  <fct> 45, 14, 30, 47, 47, 30, 30, 45, 14, 28, 1...
## $ total.sulfur.dioxide <fct> 170, 132, 97, 186, 186, 97, 136, 170, 132...
## $ density              <fct> 1.001, 0.994, 0.9951, 0.9956, 0.9956, 0.9...
## $ pH                   <fct> 3, 3.3, 3.26, 3.19, 3.19, 3.26, 3.18, 3, ...
## $ sulphates            <fct> 0.45, 0.49, 0.44, 0.4, 0.4, 0.44, 0.47, 0...
## $ alcohol              <fct> 8.8, 9.5, 10.1, 9.9, 9.9, 10.1, 9.6, 8.8,...
## $ quality              <int> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 7,...

Nota-se que todas as variáveis presentes no conjunto de dados são atribuídas como fator, exceto a qualidade.

No gráfico de barras tem-se o número de vinhos observados em cada nível de qualidade. Verifica-se que a maior concentração de vinhos apresenta qualidade 6.

dados$quality <- factor(dados$quality)
ggplot(data=dados, aes(x=quality)) +
  geom_bar(stat="count", position=position_dodge(), fill = "#FF6666")+
  theme_classic()+ scale_x_discrete("Qualidade")+scale_y_continuous("N")

De modo a analisar as variáveis disponíveis, construiu-se os componentes principais de modo a reduzir a dimensionalidade dos dados e selecionar as variáveis com maior poder de explicação da variabilidade.

Como os dois primeiros componentes principais explicam aproximadamente 88% da variabilidade do conjunto de dados, tomou-se as variáveis que mais contribuíram para a construção de cada componente, sendo elas: densidade e açúcar residual.

library("FactoMineR");library("factoextra")
d = as.tibble((dados[,-12])) # removendo a resposta
## Warning: `as.tibble()` is deprecated, use `as_tibble()` (but mind the new semantics).
## This warning is displayed once per session.
d =  mutate_if(d, is.factor, as.numeric)
b1 = prcomp(d)
summary(b1)
## Importance of components:
##                             PC1      PC2      PC3     PC4      PC5
## Standard deviation     227.5329 103.7589 75.80338 33.3209 24.46295
## Proportion of Variance   0.7276   0.1513  0.08075  0.0156  0.00841
## Cumulative Proportion    0.7276   0.8789  0.95963  0.9752  0.98364
##                             PC6     PC7      PC8      PC9     PC10    PC11
## Standard deviation     18.41412 16.6505 15.74536 11.64635 10.45860 7.38269
## Proportion of Variance  0.00477  0.0039  0.00348  0.00191  0.00154 0.00077
## Cumulative Proportion   0.98841  0.9923  0.99579  0.99770  0.99923 1.00000
var = get_pca_var(b1)
fviz_contrib(b1, choice = "var", axes = 1, title = "")

fviz_contrib(b1, choice = "var", axes = 2, title = "")

Dessa forma, construiu-se um modelo de árvores aleatórias para analisar a taxa de acerto do modelo a partir das duas variáveis. Para isso, criou-se um conjunto com 90% de dados para treino e 10% para teste.

library("randomForest")
library("caret")

dados$density = as.numeric(dados$density)
dados$residual.sugar= as.numeric(dados$residual.sugar)
ind <- sample(2, nrow(dados), replace= T, prob=c(0.9, 0.1))
treino <- as.tibble(dados[ind==1,c(4,8, 12)])
teste <- dados[ind==2,c(4,8, 12)]
modelo_random <- randomForest(quality ~ density + residual.sugar, data =  treino,ntree = 500,  mtry = 2)
predicao <- predict(modelo_random, newdata = teste)
confusionMatrix(predicao, teste$quality)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   3   4   5   6   7   8   9
##          3   0   0   0   0   0   0   0
##          4   1   5   2   5   0   1   0
##          5   0   2  87  39   8   1   0
##          6   1   7  42 147  20   8   0
##          7   0   4   4  28  44   3   0
##          8   0   0   1   3   0   4   0
##          9   0   0   0   0   0   0   0
## 
## Overall Statistics
##                                           
##                Accuracy : 0.6146          
##                  95% CI : (0.5687, 0.6589)
##     No Information Rate : 0.4754          
##     P-Value [Acc > NIR] : 1.065e-09       
##                                           
##                   Kappa : 0.4128          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity          0.000000  0.27778   0.6397   0.6622  0.61111 0.235294
## Specificity          1.000000  0.97996   0.8489   0.6816  0.90127 0.991111
## Pos Pred Value            NaN  0.35714   0.6350   0.6533  0.53012 0.500000
## Neg Pred Value       0.995717  0.97130   0.8515   0.6901  0.92708 0.971678
## Prevalence           0.004283  0.03854   0.2912   0.4754  0.15418 0.036403
## Detection Rate       0.000000  0.01071   0.1863   0.3148  0.09422 0.008565
## Detection Prevalence 0.000000  0.02998   0.2934   0.4818  0.17773 0.017131
## Balanced Accuracy    0.500000  0.62887   0.7443   0.6719  0.75619 0.613203
##                      Class: 9
## Sensitivity                NA
## Specificity                 1
## Pos Pred Value             NA
## Neg Pred Value             NA
## Prevalence                  0
## Detection Rate              0
## Detection Prevalence        0
## Balanced Accuracy          NA

Observa-se que o modelo apresentou uma acúracia baixa (61,46%) e além disso, o valor do índice kappa foi igual a 0,4128.

Entretanto, pode-se notar na matriz que o método apresentou dificuldade em classificar qualidades do tipo 5, 6 e 7, com maior sensitividade para vinhos com qualidade 6 de 66,22\(\%\). Além do mais, pode-se considerar outros modelos a fim de melhorar a acurácia.