Достаточно ли того красного вина?

Вводное руководство, чтобы познакомить с основным рабочим процессом прогнозного моделирования и продемонстрировать, как его документировать.

Предположим, что нас наняла винодельня, чтобы построить прогностическую модель, чтобы проверить качество их красного вина. Традиционный способ дегустации вина проводится экспертом-человеком. Таким образом, процесс подвержен человеческой ошибке. Цель состоит в том, чтобы создать процесс создания объективного метода тестирования вин и объединить его с существующим процессом, чтобы уменьшить количество человеческих ошибок.

Для построения прогнозной модели мы будем использовать набор данных, предоставленный репозиторием машинного обучения UCI. Мы попытаемся предсказать качество вина на основе характеристик, связанных с вином.

Цель:

  • Изучите данные
  • Прогнозировать качество вина (бинарная классификация)
  • Изучить результат модели

Изучение данных

Загрузка данных, библиотек и предварительный просмотр данных

# libraries
library(dplyr)
library(ggplot2)
library(caTools)
library(caret)
library(GGally) 
dataFrame = read.csv("https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-red.csv", sep = ';')
summary(dataFrame)
##  fixed.acidity   volatile.acidity  citric.acid    residual.sugar  
##  Min.   : 4.60   Min.   :0.1200   Min.   :0.000   Min.   : 0.900  
##  1st Qu.: 7.10   1st Qu.:0.3900   1st Qu.:0.090   1st Qu.: 1.900  
##  Median : 7.90   Median :0.5200   Median :0.260   Median : 2.200  
##  Mean   : 8.32   Mean   :0.5278   Mean   :0.271   Mean   : 2.539  
##  3rd Qu.: 9.20   3rd Qu.:0.6400   3rd Qu.:0.420   3rd Qu.: 2.600  
##  Max.   :15.90   Max.   :1.5800   Max.   :1.000   Max.   :15.500  
##    chlorides       free.sulfur.dioxide total.sulfur.dioxide    density      
##  Min.   :0.01200   Min.   : 1.00       Min.   :  6.00       Min.   :0.9901  
##  1st Qu.:0.07000   1st Qu.: 7.00       1st Qu.: 22.00       1st Qu.:0.9956  
##  Median :0.07900   Median :14.00       Median : 38.00       Median :0.9968  
##  Mean   :0.08747   Mean   :15.87       Mean   : 46.47       Mean   :0.9967  
##  3rd Qu.:0.09000   3rd Qu.:21.00       3rd Qu.: 62.00       3rd Qu.:0.9978  
##  Max.   :0.61100   Max.   :72.00       Max.   :289.00       Max.   :1.0037  
##        pH          sulphates         alcohol         quality     
##  Min.   :2.740   Min.   :0.3300   Min.   : 8.40   Min.   :3.000  
##  1st Qu.:3.210   1st Qu.:0.5500   1st Qu.: 9.50   1st Qu.:5.000  
##  Median :3.310   Median :0.6200   Median :10.20   Median :6.000  
##  Mean   :3.311   Mean   :0.6581   Mean   :10.42   Mean   :5.636  
##  3rd Qu.:3.400   3rd Qu.:0.7300   3rd Qu.:11.10   3rd Qu.:6.000  
##  Max.   :4.010   Max.   :2.0000   Max.   :14.90   Max.   :8.000

Судя по характеристикам, мы видим, что «качество» - это наша целевая характеристика. И у нас есть всего 11 функций, которые можно использовать в качестве предикторов.

Изучение возможностей

Преобразование целевой функции

Поскольку мы поговорим о модели классификации, мы преобразуем нашу целевую функцию из непрерывного в двоичный класс. Так что мы могли бы соответствовать одной из очень широко используемых, но очень простых моделей классификации.

Распространение оригинальных меток целевых функций

# checking ratio of different labels in target feature
prop.table(table(dataFrame$quality)
## 
##           3           4           5           6           7           8 
## 0.006253909 0.033145716 0.425891182 0.398999375 0.124452783 0.011257036
dataFrame = dataFrame %>%
  mutate(quality_bin = as.factor(ifelse(quality <= 5, 0,1))) %>%
  select(-quality)

p = round(prop.table(table(dataFrame$quality_bin))*100,2)

После преобразования у нас 53,47% случаев классифицировали записи как хорошие вина против 46,53% как плохие вина.

У нас здесь хорошее распределение наших целевых классов! Что очень приятно. В противном случае нам пришлось бы иметь дело с балансировкой данных. Хотя мы не будем рассматривать эту область в этом руководстве, это отличная область для обсуждения. Итак, несколько дополнительных баллов тем, кто узнает об этом!

Короче говоря, мы хотели бы сбалансированное распределение наблюдений от разных ярлыков в нашей целевой функции. В противном случае некоторые алгоритмы машинного обучения имеют тенденцию переоснащаться.

Изучение предикторов визуально

Изучение кислотности

dataFrame %>%
  ggplot(aes(x = as.factor(quality_bin), y = fixed.acidity, color = quality_bin)) +
  geom_boxplot(outlier.color = "darkred", notch = FALSE) +
  ylab("Acidity") + xlab("Quality (1 = good, 2 = bad)") + 
  theme(legend.position = "none", axis.title.x = element_blank()) + 
  theme_minimal()

У нас есть несколько непрерывных функций, которые можно строить аналогично. Это означает, что нам придется снова и снова переписывать код, который мы только что написали в фрагменте кода: viz_acidity. В кодировании мы не хотим этого делать. Итак, мы создадим функцию и обернем ее вокруг нашего кода, чтобы его можно было повторно использовать в будущем!

Если это звучит слишком много, просто придерживайтесь его. Когда вы увидите код, он станет понятнее.

# boxplot_viz
# plots continuous feature in boxplot categorized on the quality_bin feature labels from dataFrame 
# @param feat Feature name (string) to be plotted
boxplot_viz = function(feat){
  dataFrame %>%
    ggplot(aes_string(x = as.factor('quality_bin'), y = feat, color = 'quality_bin')) +
    geom_boxplot(outlier.color = "darkred", notch = FALSE) +
    labs(title = paste0("Boxplot of feature: ", feat)) + ylab(feat) + xlab("Quality (1 = good, 2 = bad)") + 
    theme(legend.position = "none", axis.title.x = element_blank()) + 
    theme_minimal()
}
boxplot_viz('volatile.acidity')

for (i in names(dataFrame %>% select(-'quality_bin'))){
  print(boxplot_viz(i))
}

Проверка корреляции

Мы можем быстро проверить корреляцию между нашими предсказателями.

dataFrame %>% 
  # correlation plot 
  ggcorr(method = c('complete.obs','pearson'), 
         nbreaks = 6, digits = 3, palette = "RdGy", label = TRUE, label_size = 3, 
         label_color = "white", label_round = 2)

Сильно коррелированные функции не добавляют новую информацию в модель и размывают влияние отдельных функций на предсказатель, что затрудняет объяснение влияния отдельных функций на целевую функцию. Эта проблема называется мультиколлинеарностью. Как правило, мы не хотим сохранять функции с очень высокой корреляцией.

  • Какой должен быть порог корреляции?
  • Как мы решаем, какую переменную отбросить?
  • Вредят ли коррелированные характеристики точности прогнозов?

Все это отличные вопросы, и в них стоит хорошо разобраться. Так что снова дополнительные баллы для тех, кто узнает о них!

Прежде чем принимать какое-либо решение на основе корреляции, проверьте распределение функции. Если между любыми двумя характеристиками нет линейной связи, корреляция не имеет большого значения.

Функциональная инженерия

На основе понимания, полученного в результате исследования данных, может потребоваться преобразование некоторых функций или создание новых функций. Вот некоторые общие задачи проектирования функций:

  • Нормализация и стандартизация функций
  • Объединение непрерывных функций
  • Создание композитных объектов
  • Создание фиктивных переменных

В этом руководстве не рассматривается разработка функций, но это отличная область для изучения. Хорошее исследование данных с последующим проектированием необходимых функций - это абсолютно необходимые предварительные условия перед подгонкой любой прогнозной модели!

Модель установки

Разделение данных

На практике мы обучаем наши прогнозные модели на исторических данных, которые называются обучающими данными. Затем мы применяем эту модель к новым невидимым данным, которые называются тестовыми данными, и измеряем производительность. таким образом, мы можем быть уверены, что наша модель устойчива или не переборщила с данными обучения. Но поскольку у нас не будет доступа к новым данным о винах, мы разделим наш набор данных на данные для обучения и тестирования в соотношении 80:20.

set.seed(123)
split = sample.split(dataFrame$quality_bin, SplitRatio = 0.80)
training_set = subset(dataFrame, split == TRUE)
test_set = subset(dataFrame, split == FALSE)

Давайте проверим баланс данных в обучающих и тестовых данных.

prop.table(table(training_set$quality_bin))
## 
##         0         1 
## 0.4652072 0.5347928
prop.table(table(test_set$quality_bin))
## 
##        0        1 
## 0.465625 0.534375

Подгонка модели к обучающим данным

Мы поместим модель классификации логистической регрессии в наш набор данных.

model_log = glm(quality_bin ~ ., 
                data = training_set, family = 'binomial')
summary(model_log)
## 
## Call:
## glm(formula = quality_bin ~ ., family = "binomial", data = training_set)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.3688  -0.8309   0.2989   0.8109   2.4184  
## 
## Coefficients:
##                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)           17.369521  90.765368   0.191  0.84824    
## fixed.acidity          0.069510   0.112062   0.620  0.53507    
## volatile.acidity      -3.602258   0.558889  -6.445 1.15e-10 ***
## citric.acid           -1.543276   0.638161  -2.418  0.01559 *  
## residual.sugar         0.012106   0.060364   0.201  0.84106    
## chlorides             -4.291590   1.758614  -2.440  0.01467 *  
## free.sulfur.dioxide    0.027452   0.009293   2.954  0.00314 ** 
## total.sulfur.dioxide  -0.016723   0.003229  -5.180 2.22e-07 ***
## density              -23.425390  92.700349  -0.253  0.80050    
## pH                    -0.977906   0.828710  -1.180  0.23799    
## sulphates              3.070254   0.532655   5.764 8.21e-09 ***
## alcohol                0.946654   0.120027   7.887 3.10e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1766.9  on 1278  degrees of freedom
## Residual deviance: 1301.4  on 1267  degrees of freedom
## AIC: 1325.4
## 
## Number of Fisher Scoring iterations: 4

Построим график переменных с наименьшим значением p / наибольшим абсолютным значением z.

p = varImp(model_log) %>% data.frame() 
p = p %>% mutate(Features = rownames(p)) %>% arrange(desc(Overall)) %>% mutate(Features = tolower(Features))
p %>% ggplot(aes(x = reorder(Features, Overall), y = Overall)) + geom_col(width = .50, fill = 'darkred') + coord_flip() + 
  labs(title = "Importance of Features", subtitle = "Based on the value of individual z score") +
  xlab("Features") + ylab("Abs. Z Score") + 
  theme_minimal()

Проверка производительности модели

Мы проверим, как работает наша модель, запустив ее на ранее невиданных тестовых данных. Мы сравним прогнозируемый результат с фактическим и вычислим некоторые обычно используемые метрики измерения производительности бинарной модели классификации.

# predict target feature in test data
y_pred = as.data.frame(predict(model_log, type = "response", newdata = test_set)) %>% 
  structure( names = c("pred_prob")) %>%
  mutate(pred_cat = as.factor(ifelse(pred_prob > 0.5, "1", "0"))) %>% 
  mutate(actual_cat = test_set$quality_bin)
p = confusionMatrix(y_pred$pred_cat, y_pred$actual_cat, positive = "1")
p
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 108  46
##          1  41 125
##                                           
##                Accuracy : 0.7281          
##                  95% CI : (0.6758, 0.7761)
##     No Information Rate : 0.5344          
##     P-Value [Acc > NIR] : 9.137e-13       
##                                           
##                   Kappa : 0.4548          
##                                           
##  Mcnemar's Test P-Value : 0.668           
##                                           
##             Sensitivity : 0.7310          
##             Specificity : 0.7248          
##          Pos Pred Value : 0.7530          
##          Neg Pred Value : 0.7013          
##              Prevalence : 0.5344          
##          Detection Rate : 0.3906          
##    Detection Prevalence : 0.5188          
##       Balanced Accuracy : 0.7279          
##                                           
##        'Positive' Class : 1               
##

Обзор эффективности модели:

  • Точность: 72,81% вин классифицированы правильно.
  • Чувствительность / запоминаемость: 73,1% действительно хороших вин классифицированы правильно.
  • Pos Pred Value / Precision: 75,3% от общего числа прогнозов хорошего вина - это действительно хорошие вина.

Сводная информация

Итак, давайте подведем итог тому, что мы узнали о тестировании вин из нашего упражнения:

  • Содержание алкоголя, летучая кислотность, сульфат и общий диоксид серы - это четыре наиболее статистически значимых показателя, влияющих на качество вина.
  • Учитывая информацию об 11 проанализированных нами характеристиках, мы можем точно предсказать качество вина примерно в 73% случаев.
  • Это примерно на 26% точнее, чем точность, достигаемая при использовании традиционного экспертного метода.

« Люди могли заметить разницу между винами стоимостью менее 5 фунтов стерлингов и более 10 фунтов стерлингов только в 53% случаев для белых и только в 47% случаев для красных .

Спасибо за чтение!

Прочитав эту статью, вы должны иметь фундаментальное представление о том, как работают функции в R, а также о том, как их можно использовать в своей личной жизни!

Не знаете, что читать дальше? Я подобрала для вас другую статью:



Позаботьтесь о своих акциях!
Используйте R, чтобы проверять цены на акции для вас и уведомлять вас. curious-joe.medium.com



Арафат Хоссейн