library(randomForest)
library(caret)
library(dplyr)
library(GGally)
library(ggplot2)
library(plotly)
library(corrplot)

data(wine, package = "rattle")
data.wine <- wine

Завантажимо дані по вину із пакета rattle:

glimpse(data.wine)
Observations: 178
Variables: 14
$ Type            (fctr) 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
$ Alcohol         (dbl) 14.23, 13.20, 13.16, 14.37, 13.24, 14.20, 14.3...
$ Malic           (dbl) 1.71, 1.78, 2.36, 1.95, 2.59, 1.76, 1.87, 2.15...
$ Ash             (dbl) 2.43, 2.14, 2.67, 2.50, 2.87, 2.45, 2.45, 2.61...
$ Alcalinity      (dbl) 15.6, 11.2, 18.6, 16.8, 21.0, 15.2, 14.6, 17.6...
$ Magnesium       (int) 127, 100, 101, 113, 118, 112, 96, 121, 97, 98,...
$ Phenols         (dbl) 2.80, 2.65, 2.80, 3.85, 2.80, 3.27, 2.50, 2.60...
$ Flavanoids      (dbl) 3.06, 2.76, 3.24, 3.49, 2.69, 3.39, 2.52, 2.51...
$ Nonflavanoids   (dbl) 0.28, 0.26, 0.30, 0.24, 0.39, 0.34, 0.30, 0.31...
$ Proanthocyanins (dbl) 2.29, 1.28, 2.81, 2.18, 1.82, 1.97, 1.98, 1.25...
$ Color           (dbl) 5.64, 4.38, 5.68, 7.80, 4.32, 6.75, 5.25, 5.05...
$ Hue             (dbl) 1.04, 1.05, 1.03, 0.86, 1.04, 1.05, 1.02, 1.06...
$ Dilution        (dbl) 3.92, 3.40, 3.17, 3.45, 2.93, 2.85, 3.58, 3.58...
$ Proline         (int) 1065, 1050, 1185, 1480, 735, 1450, 1290, 1295,...
dt <- table(data.wine$Type)
dt

 1  2  3 
59 71 48 
round(prop.table(dt), digits = 2)

   1    2    3 
0.33 0.40 0.27 
#summary(data.wine)
ggpairs(data.wine, 
    upper = list(continuous = wrap("density", alpha = 0.5), 
                 combo = "box"), # у верхньому трикутнику буде густина розподілу двох змінних, а у випадку, якщо одна із змінних факторна, то боксплот
    lower = list(continuous = wrap("points", alpha = 0.5),  
                 combo = wrap("dot", alpha = 0.5)), # у нижньому трикутнику буде діаграма розсіювання двох змінних, а у випадку, якщо одна із змінних факторна, то також розсіювання у розрізі факторів із певним випадковим зміщенням
    diag  = list(continuous = "densityDiag"),  # на діагоналі - діаграми розсіювання у розрізі факторів
    mapping = ggplot2::aes(color = Type), # кожному фактору свій колір
    axisLabels = "show") 

Проаналізуємо зміні на предмет: околонульової дисперсії та мультиколінеарності.

name <- nearZeroVar(x = data.wine)
name # не має змінних із околонульовою дисперсією
## integer(0)
correl <- findCorrelation(x = cor(data.wine[, -1]),  # задається матриця парних кореляції
                          cutoff = 0.8)  # задається відсічення для значення кореляції
colnames(data.wine[, -1])[correl]  #список змінних, які сильно корелюють із іншими змінними
## [1] "Flavanoids"

Зобразимо теплову діаграму парних коефіцієнтів кореляції. Як бачимо вказана зміннадійсно сильно кореляює із іншими змінними.

corrplot.mixed(corr = cor(data.wine[, -1]),
               lower = 'square',
               upper = 'number',
               tl.pos = "lt",
               tl.cex = 1)

Побудова моделі. Відберемо для навчання 70% основної вибірки.

set.seed(123)
index.for.train <- createDataPartition(y = data.wine$Type, # відбір пропорційний до вказаної змінної
                                       p = 0.7,  # частина вибірки, яка буде відбиратися
                                       list = FALSE)  # не будемо отимувати список

wine.train <- slice(data.wine, index.for.train)  # відберемо необхідні індекси для навчання
wine.test <- slice(data.wine, -index.for.train)  # відберемо необхідні індекси для тестування

# у навчальній та тестовій вибірці зберігаються пропорції по змінній Type
round(prop.table(table(wine.train$Type)),
      digits = 2)
## 
##    1    2    3 
## 0.33 0.40 0.27
round(prop.table(table(wine.test$Type)),
      digits = 2)
## 
##    1    2    3 
## 0.33 0.40 0.27

Додатково зобразимо трьохвимірну діаграму по змінних Color, Proline, Dilution. Як бачимо, типи вин досить добре кластеризуються.

plotly::plot_ly(data = wine.train,
               x = Color,
               y = Proline,
               z = Dilution,
               type = "scatter3d",
               color = Type,
               mode = "markers")

Побудуємо спочатку модель “випадковий ліс” на всі змінні.

control <- trainControl(met = 'repeatedcv', 
                        number = 10,       #10-кратка кросвалідація, 
                        repeats = 5)       #яка повторюється 5 разів
grid.1 <- expand.grid(mtry = 2:13)  #кількість змінних у дереві буде перебиратись від 2 до 13 (кількість змінних)

model.1 <- train(
  Type ~ . ,
  data = wine.train,
  method = 'rf',
  preProcess = c('center', 'scale'),
  trControl = control,
  tuneGrid = grid.1
)


model.1      # подивимось на результати моделі
## Random Forest 
## 
## 126 samples
##  13 predictor
##   3 classes: '1', '2', '3' 
## 
## Pre-processing: centered (13), scaled (13) 
## Resampling: Cross-Validated (10 fold, repeated 5 times) 
## Summary of sample sizes: 112, 113, 114, 114, 114, 113, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa      Accuracy SD  Kappa SD  
##    2    0.9839744  0.9758698  0.03240904   0.04881193
##    3    0.9838462  0.9756912  0.03266652   0.04917016
##    4    0.9838462  0.9756912  0.03266652   0.04917016
##    5    0.9774359  0.9658732  0.04027722   0.06095524
##    6    0.9757692  0.9634511  0.04436036   0.06681752
##    7    0.9758974  0.9635309  0.04086261   0.06186060
##    8    0.9742308  0.9611088  0.04483421   0.06755883
##    9    0.9726923  0.9585148  0.04200113   0.06380149
##   10    0.9726923  0.9587013  0.04524977   0.06828543
##   11    0.9726923  0.9587013  0.04524977   0.06828543
##   12    0.9694872  0.9537712  0.04605344   0.06960411
##   13    0.9710256  0.9560927  0.04575530   0.06916138
## 
## Accuracy was used to select the optimal model using  the largest value.
## The final value used for the model was mtry = 2.
plot(model.1)  # подивимось, як змінюється точність моделі при різній кількості параметру mtry

varImp(model.1)   # подивимось на список важливісті змінних
## rf variable importance
## 
##                 Overall
## Proline         100.000
## Color            86.065
## Flavanoids       75.315
## Dilution         65.659
## Alcohol          63.859
## Hue              62.040
## Phenols          29.953
## Malic            26.246
## Magnesium        15.776
## Alcalinity       11.166
## Proanthocyanins   9.584
## Ash               6.044
## Nonflavanoids     0.000
plot(varImp(model.1))  # подивимось на графік важливості змінних

# результати крос-табуляції для тренувальної вибірки
confusionMatrix(predict(model.1, wine.train),
                wine.train$Type)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  1  2  3
##          1 42  0  0
##          2  0 50  0
##          3  0  0 34
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9711, 1)
##     No Information Rate : 0.3968     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3
## Sensitivity            1.0000   1.0000   1.0000
## Specificity            1.0000   1.0000   1.0000
## Pos Pred Value         1.0000   1.0000   1.0000
## Neg Pred Value         1.0000   1.0000   1.0000
## Prevalence             0.3333   0.3968   0.2698
## Detection Rate         0.3333   0.3968   0.2698
## Detection Prevalence   0.3333   0.3968   0.2698
## Balanced Accuracy      1.0000   1.0000   1.0000
# результати крос-табуляції для тестової вибірки
confusionMatrix(predict(model.1, wine.test),
                wine.test$Type)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  1  2  3
##          1 17  0  0
##          2  0 20  0
##          3  0  1 14
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9808          
##                  95% CI : (0.8974, 0.9995)
##     No Information Rate : 0.4038          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9709          
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3
## Sensitivity            1.0000   0.9524   1.0000
## Specificity            1.0000   1.0000   0.9737
## Pos Pred Value         1.0000   1.0000   0.9333
## Neg Pred Value         1.0000   0.9687   1.0000
## Prevalence             0.3269   0.4038   0.2692
## Detection Rate         0.3269   0.3846   0.2692
## Detection Prevalence   0.3269   0.3846   0.2885
## Balanced Accuracy      1.0000   0.9762   0.9868
# тепер побудуємо модель без змінної, яка найбільше корелює із іншими змінними
model.2 <- train(
  Type ~ . ,
  data = select(wine.train, -Flavanoids),
  method = 'rf',
  preProcess = c('center', 'scale'),
  trControl = control,
  tuneGrid = grid.1
)
model.2
## Random Forest 
## 
## 126 samples
##  12 predictor
##   3 classes: '1', '2', '3' 
## 
## Pre-processing: centered (12), scaled (12) 
## Resampling: Cross-Validated (10 fold, repeated 5 times) 
## Summary of sample sizes: 113, 114, 114, 113, 114, 113, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa      Accuracy SD  Kappa SD  
##    2    0.9822894  0.9733161  0.03770731   0.05663819
##    3    0.9805128  0.9706230  0.04188417   0.06314628
##    4    0.9758974  0.9635366  0.04893161   0.07393741
##    5    0.9758974  0.9635366  0.04893161   0.07393741
##    6    0.9726923  0.9584330  0.05451311   0.08323865
##    7    0.9696154  0.9536832  0.06129118   0.09408781
##    8    0.9633333  0.9439406  0.07458779   0.11479517
##    9    0.9633333  0.9439406  0.07458779   0.11479517
##   10    0.9634615  0.9442256  0.07258445   0.11168667
##   11    0.9616667  0.9415426  0.07655689   0.11748542
##   12    0.9633333  0.9439406  0.07458779   0.11479517
##   13    0.9633333  0.9439406  0.07458779   0.11479517
## 
## Accuracy was used to select the optimal model using  the largest value.
## The final value used for the model was mtry = 2.
# як бачимо точність майже не змінилась
confusionMatrix(predict(model.2, wine.train),
                wine.train$Type)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  1  2  3
##          1 42  0  0
##          2  0 50  0
##          3  0  0 34
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9711, 1)
##     No Information Rate : 0.3968     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3
## Sensitivity            1.0000   1.0000   1.0000
## Specificity            1.0000   1.0000   1.0000
## Pos Pred Value         1.0000   1.0000   1.0000
## Neg Pred Value         1.0000   1.0000   1.0000
## Prevalence             0.3333   0.3968   0.2698
## Detection Rate         0.3333   0.3968   0.2698
## Detection Prevalence   0.3333   0.3968   0.2698
## Balanced Accuracy      1.0000   1.0000   1.0000
confusionMatrix(predict(model.2, wine.test),
                wine.test$Type)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  1  2  3
##          1 17  0  0
##          2  0 20  0
##          3  0  1 14
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9808          
##                  95% CI : (0.8974, 0.9995)
##     No Information Rate : 0.4038          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9709          
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3
## Sensitivity            1.0000   0.9524   1.0000
## Specificity            1.0000   1.0000   0.9737
## Pos Pred Value         1.0000   1.0000   0.9333
## Neg Pred Value         1.0000   0.9687   1.0000
## Prevalence             0.3269   0.4038   0.2692
## Detection Rate         0.3269   0.3846   0.2692
## Detection Prevalence   0.3269   0.3846   0.2885
## Balanced Accuracy      1.0000   0.9762   0.9868
model.3 <- randomForest(
  Type ~ . ,
  data = select(wine.train, -Flavanoids),
  mtry = 2,
  scaled = TRUE,
  importance = TRUE)

plot(model.3)