В прошлой статье (KNN для задачи классификации) мы попытались понять, как работает KNN. Теперь давайте реализуем алгоритм KNN в R/R Studio. Мы будем строить модель KNN и прогнозировать наши тестовые данные, чтобы увидеть, насколько хорошо работает наша модель.
Набор данных, над которым мы будем работать, — это данные о грибах от Kaggle. Этот набор данных включает образцы 23 видов грибов. Каждый вид определяется как определенно съедобный и определенно ядовитый, данные о грибах содержат 23 переменных и 8124 наблюдения.
Начнем с загрузки необходимых библиотек
# Loading the necessary libraries
```{r}
library(readr)
library(tidyverse)
library(visdat)
library(missMethods)
library(fastDummies)
library(caret)
```
# Loading The Data
```{r}
mushrooms <- read.csv("mushrooms.csv")
head(mushrooms)
```
```{r}
str(mushrooms)
```
output:
'data.frame': 8124 obs. of 23 variables:
$ class : chr "p" "e" "e" "p" ...
$ cap.shape : chr "x" "x" "b" "x" ...
$ cap.surface : chr "s" "s" "s" "y" ...
$ cap.color : chr "n" "y" "w" "w" ...
$ bruises : chr "t" "t" "t" "t" ...
$ odor : chr "p" "a" "l" "p" ...
$ gill.attachment : chr "f" "f" "f" "f" ...
$ gill.spacing : chr "c" "c" "c" "c" ...
$ gill.size : chr "n" "b" "b" "n" ...
$ gill.color : chr "k" "k" "n" "n" ...
$ stalk.shape : chr "e" "e" "e" "e" ...
$ stalk.root : chr "e" "c" "c" "e" ...
$ stalk.surface.above.ring: chr "s" "s" "s" "s" ...
$ stalk.surface.below.ring: chr "s" "s" "s" "s" ...
$ stalk.color.above.ring : chr "w" "w" "w" "w" ...
$ stalk.color.below.ring : chr "w" "w" "w" "w" ...
$ veil.type : chr "p" "p" "p" "p" ...
$ veil.color : chr "w" "w" "w" "w" ...
$ ring.number : chr "o" "o" "o" "o" ...
$ ring.type : chr "p" "p" "p" "p" ...
$ spore.print.color : chr "k" "n" "n" "k" ...
$ population : chr "s" "n" "n" "s" ...
$ habitat : chr "u" "g" "m" "u" ...
Все переменные являются категориальными, поэтому нашим первым шагом будет преобразование всех этих переменных в фактор. Категориальная переменная не относится ни к какой шкале. Алгоритмы машинного обучения требуют чисел в качестве входных данных, поэтому, если ваша категориальная переменная принимает такие значения, как «яблоко», «апельсин» и «груша», вам нужно каким-то образом закодировать ее как числа, поскольку функция.factor() предоставляет способ сделать это.
```{r}
mushrooms[sapply(mushrooms, is.character)] <- lapply(
mushrooms[sapply(mushrooms, is.character)], as.factor)
```
```{r}
str(mushrooms)
```
output:
'data.frame': 8124 obs. of 23 variables:
$ class : Factor w/ 2 levels "e","p": 2 1 1 2 1 1 1 1 2 1 ...
$ cap.shape : Factor w/ 6 levels "b","c","f","k",..: 6 6 1 6 6 6 1 1 6 1 ...
$ cap.surface : Factor w/ 4 levels "f","g","s","y": 3 3 3 4 3 4 3 4 4 3 ...
$ cap.color : Factor w/ 10 levels "b","c","e","g",..: 5 10 9 9 4 10 9 9 9 10 ...
$ bruises : Factor w/ 2 levels "f","t": 2 2 2 2 1 2 2 2 2 2 ...
$ odor : Factor w/ 9 levels "a","c","f","l",..: 7 1 4 7 6 1 1 4 7 1 ...
$ gill.attachment : Factor w/ 2 levels "a","f": 2 2 2 2 2 2 2 2 2 2 ...
$ gill.spacing : Factor w/ 2 levels "c","w": 1 1 1 1 2 1 1 1 1 1 ...
$ gill.size : Factor w/ 2 levels "b","n": 2 1 1 2 1 1 1 1 2 1 ...
$ gill.color : Factor w/ 12 levels "b","e","g","h",..: 5 5 6 6 5 6 3 6 8 3 ...
$ stalk.shape : Factor w/ 2 levels "e","t": 1 1 1 1 2 1 1 1 1 1 ...
$ stalk.root : Factor w/ 5 levels "?","b","c","e",..: 4 3 3 4 4 3 3 3 4 3 ...
$ stalk.surface.above.ring: Factor w/ 4 levels "f","k","s","y": 3 3 3 3 3 3 3 3 3 3 ...
$ stalk.surface.below.ring: Factor w/ 4 levels "f","k","s","y": 3 3 3 3 3 3 3 3 3 3 ...
$ stalk.color.above.ring : Factor w/ 9 levels "b","c","e","g",..: 8 8 8 8 8 8 8 8 8 8 ...
$ stalk.color.below.ring : Factor w/ 9 levels "b","c","e","g",..: 8 8 8 8 8 8 8 8 8 8 ...
$ veil.type : Factor w/ 1 level "p": 1 1 1 1 1 1 1 1 1 1 ...
$ veil.color : Factor w/ 4 levels "n","o","w","y": 3 3 3 3 3 3 3 3 3 3 ...
$ ring.number : Factor w/ 3 levels "n","o","t": 2 2 2 2 2 2 2 2 2 2 ...
$ ring.type : Factor w/ 5 levels "e","f","l","n",..: 5 5 5 5 1 5 5 5 5 5 ...
$ spore.print.color : Factor w/ 9 levels "b","h","k","n",..: 3 4 4 3 4 3 3 4 3 3 ...
$ population : Factor w/ 6 levels "a","c","n","s",..: 4 3 3 4 1 3 3 4 5 4 ...
$ habitat : Factor w/ 7 levels "d","g","l","m",..: 6 2 4 6 2 2 4 4 2 4 ...
Здесь, если мы видим, что корень переменной стебля имеет наблюдения, содержащие «?» что ничего не значит, это означает, что отсутствующие данные должны быть заменены на NA.
Работа с пропущенными значениями
```{r}
mushrooms$stalk.root[mushrooms$stalk.root=="?"]
```
# replacing ? with NA's
```{r}
mushrooms$stalk.root[mushrooms$stalk.root == "?"] <- NA
```
# dealing with missing values
```{r}
vis_miss(mushrooms)
```
Здесь мы видим, что 1,3% данных отсутствуют для переменной корня стебля. Решением проблемы с отсутствующими данными является вменение, другими словами, замена отсутствующих значений наилучшими предполагаемыми значениями. Поскольку значения отсутствующих данных являются категориальными, мы не можем использовать подход среднего и медианного значения для вменения отсутствующих данных. Мы можем использовать модовый подход для импутации данных, но мы должны проверить почти нулевую дисперсию данных.
Переменные с почти нулевой дисперсией — это те переменные, которые содержат только одно уникальное значение и не предоставляют никакой полезной информации и должны быть удалены из данных.
# Checking Near-Zero Variance
```{r}
caret::nearZeroVar(mushrooms, saveMetrics= TRUE) %>%
filter(nzv)
```
output:
freqRatio <dbl> percentUnique <dbl> zeroVar <lgl> nzv <lgl>
gill.attachment 37.68571 0.02461841 FALSE TRUE
veil.type 0.00000 0.01230921 TRUE TRUE
veil.color 82.54167 0.04923683 FALSE TRUE
Приведенный выше вывод показывает три переменные, которые содержат почти нулевую дисперсию и должны быть удалены.
# Removing Near-zero variance variables
```{r}
mushrooms_new <- mushrooms[,-c(7,11,18)]
```
# Mode imputaion for missing values
```{r}
mushrooms_new <- impute_mode(mushrooms_new)
```
```{r}
vis_miss(mushrooms_new)
```
Вменение режима заменяет отсутствующие значения категориальной переменной (в нашем случае это корень переменной) модой непропущенных значений этой переменной.
```{r}
ggplot(mushrooms_new, aes(x=class)) +
geom_bar(color = "black", fill = "lightgreen")
```
На приведенной выше гистограмме показан наш класс переменной ответа, где «e» представляет съедобный, а «p» — ядовитый. Обе группы почти равны: съедобные грибы составляют 52%, а ядовитые - 48%.
Преобразование категориальных данных в числовые
Все переменные в наших данных являются категориальными. Алгоритм KNN не может обрабатывать категориальные переменные, поэтому нам нужно кодировать наши данные, и для этого мы будем использовать фиктивное кодирование вместо одноразового кодирования, поскольку фиктивное кодирование имеет тенденцию удалять повторяющиеся категории, присутствующие в одном горячем кодировании. Другими словами, одно горячее кодирование создает фиктивные переменные, которые равны количеству категорий (k) в переменной, тогда как фиктивное кодирование использует k-1 фиктивные переменные, удаляя повторяющиеся категории.
```{r}
encoded_mushrooms <- dummy_cols(mushrooms_new,
select_columns = c("cap.shape", "cap.surface", "cap.color", "bruises", "odor",
"gill.spacing", "gill.size","gill.color", "stalk.root", "stalk.surface.above.ring",
"stalk.surface.below.ring", "stalk.color.above.ring", "stalk.color.below.ring",
"veil.type", "ring.number", "ring.type", "spore.print.color", "population", "habitat"),
remove_selected_columns = TRUE,
remove_first_dummy = TRUE)
```
Набор для обучения и тестирования
Разделение данных на наборы для обучения и тестирования, чтобы мы могли проверить точность нашей модели. Мы обучим наши данные на обучающем наборе и проверим точность модели на тестовом наборе, чтобы увидеть, насколько хорошо работает наша модель.
# Data Partition
```{r}
set.seed(42)
trn_idx = sample(nrow(encoded_mushrooms), size = trunc(0.70 * nrow(encoded_mushrooms)))
trn_data = encoded_mushrooms[trn_idx, ]
tst_data = encoded_mushrooms[-trn_idx, ]
```
Данные обучения содержат 5686 наблюдений, а данные тестирования — 2438 наблюдений.
Выбор значения К
Нам нужно найти оптимальное значение k, так как низкие значения k обычно перекрываются, а большие значения часто не соответствуют. Давайте создадим классификатор KNN, который мы можем использовать для прогнозирования съедобных или ядовитых грибов.
# Creating a resampling method
```{r}
cv <- trainControl(
method = "repeatedcv",
number = 10,
repeats = 5,
classProbs = TRUE,
summaryFunction = twoClassSummary
)
```
# Create a hyperparameter grid search
```{r}
hyper_grid <- expand.grid(k = seq(3, 25, by = 2))
```
В приведенном выше коде мы используем 10 итераций повторной выборки с 5-кратной перекрестной проверкой. Мы получим оптимальное значение k.
```{r}
set.seed(42) # for reproducibility
KNN_Model <- train(class ~ ., data = encoded_mushrooms,
method = "knn",
tuneGrid = hyper_grid,
tuneLength = 20,
trControl = cv,
metric = "ROC")
ggplot(KNN_Model)
```
```{r}
KNN_Model
```
output:
k-Nearest Neighbors
8124 samples
91 predictor
2 classes: 'e', 'p'
No pre-processing
Resampling: Cross-Validated (10 fold, repeated 5 times)
Summary of sample sizes: 7312, 7312, 7313, 7311, 7311, 7311, ...
Resampling results across tuning parameters:
k ROC Sens Spec
3 1.0000000 1 1.0000000
5 1.0000000 1 0.9998980
7 1.0000000 1 0.9996429
9 1.0000000 1 0.9992342
11 1.0000000 1 0.9985192
13 1.0000000 1 0.9980081
15 0.9999999 1 0.9979571
17 0.9999987 1 0.9979571
19 0.9999976 1 0.9979571
21 0.9999944 1 0.9979571
23 0.9999925 1 0.9979571
25 0.9999897 1 0.9979571
ROC was used to select the optimal model using the largest value.
The final value used for the model was k = 13.
На приведенном выше графике показаны результаты поиска по сетке, и наша лучшая модель использовала 13 ближайших соседей и обеспечила точность 99%.
Теперь давайте посмотрим на важные переменные в нашей модели KNN.
```{r}
varImp(KNN_Model)
```
output:
Importance
odor_n 100.00000
odor_f 70.78455
ring.type_p 69.38451
stalk.surface.above.ring_k 68.62144
stalk.surface.below.ring_k 66.39304
gill.size_n 64.09885
bruises_t 63.47782
stalk.surface.above.ring_s 60.67201
population_v 56.97877
stalk.surface.below.ring_s 53.35282
1-10 of 20 rows
Для нашей модели важны 20 переменных из закодированных 91 переменной. Давайте дополнительно оценим модель и спрогнозируем наши тестовые данные, чтобы увидеть, как работает наша модель.
```{r}
Prediction <- predict(KNN_Model, newdata = tst_data)
confusionMatrix(Prediction, tst_data$class)
```
output:
Confusion Matrix and Statistics
Reference
Prediction e p
e 1264 1
p 0 1173
Accuracy : 0.9996
95% CI : (0.9977, 1)
No Information Rate : 0.5185
P-Value [Acc > NIR] : <2e-16
Kappa : 0.9992
Mcnemar's Test P-Value : 1
Sensitivity : 1.0000
Specificity : 0.9991
Pos Pred Value : 0.9992
Neg Pred Value : 1.0000
Prevalence : 0.5185
Detection Rate : 0.5185
Detection Prevalence : 0.5189
Balanced Accuracy : 0.9996
'Positive' Class : e
Таким образом, в целом наша модель хорошо работает на тестовых данных, где 1264 гриба съедобны, наша модель также предсказывает то же самое. Ядовитых грибов 1174, где наша модель предсказывает, что 1173 гриба ядовиты, а 1 съедобен, поэтому наша модель точна на 99%. Здесь этот набор данных является отличным примером модели переобучения. Итак, что такое переобучение???
Модель, дающая точность 99%, является редким случаем, и больше шансов на переоснащение, мы подробно рассмотрим переоснащение и недообучение модели в моем следующем блоге.
Весь код в статье выложен на GitHub. Вот ссылка: G https://github.com/prabhtalwar/Projects-in-R/blob/main/Classification-on-Mushrooms-Data.Rmd
Надеюсь, вам понравилась статья. До следующего раза!!!
