Классификация k-ближайших соседей.

Выполним классификацию k-ближайших соседей с использованием функции knn() из пакета class на наборе данных iris. Проведем нормализацию данных, разделим выборку на обучающую и тестовую. Оценим построенную модель с использованием функции CrossTable() из пакета gmodels. Построим матрицу ошибок и диагональную оценку качества прогноза (diagonal mark quality prediction).

Установка и загрузка пакетов

options(repos = c(CRAN = "https://cran.rstudio.com/"))
install.packages(c("class", "gmodels"))
## package 'class' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'class'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Soft\R-4.5.2\library\00LOCK\class\libs\x64\class.dll to
## C:\Soft\R-4.5.2\library\class\libs\x64\class.dll: Permission denied
## Warning: restored 'class'
## package 'gmodels' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\alexa\AppData\Local\Temp\RtmpGumjj2\downloaded_packages
library(class) # class - содержит функцию knn() для классификации методом k-ближайших соседей
library(gmodels) # gmodels - содержит функцию CrossTable() для создания перекрестных таблиц

Загрузка данных iris

data(iris)
head(iris)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

Нормализация данных (масштабирование в диапазон [0, 1])

normalize <- function(x) {
  return((x - min(x)) / (max(x) - min(x)))
}

# Применяем нормализацию только к числовым колонкам (первые 4)
# lapply применяет функцию normalize к каждому столбцу и возвращает список
# as.data.frame преобразует список обратно в таблицу
iris_norm <- as.data.frame(lapply(iris[, 1:4], normalize))

# Добавляем обратно колонку с видами ирисов (не нормализуем её, т.к. это категориальная переменная)
iris_norm$Species <- iris$Species

Разделение на обучающую (70%) и тестовую (30%) выборки

set.seed(123)
# sample() случайным образом выбирает 70% индексов строк
train_idx <- sample(1:nrow(iris_norm), 0.7 * nrow(iris_norm))
train_data <- iris_norm[train_idx, ] # 70%
test_data <- iris_norm[-train_idx, ] # 30%

Извлекаем признаки и метки

train_X <- train_data[, 1:4] # Признаки для обучения (первые 4 колонки)
train_y <- train_data$Species # Метки классов для обучения
test_X <- test_data[, 1:4] # Признаки для тестирования
test_y <- test_data$Species # Фактические метки классов тестовой выборки

Классификация k-NN

# knn() находит k ближайших объектов из train_X для каждого объекта test_X
# и присваивает класс, наиболее часто встречающийся среди этих соседей
# train - обучающие данные, test - тестовые данные, cl - метки классов, k - количество соседей
knn_pred <- knn(train = train_X, test = test_X, cl = train_y, k = 3)

Оценка модели с помощью CrossTable

# CrossTable создает таблицу сопряженности между фактическими и предсказанными значениями
# prop.chisq = FALSE отключает вывод статистики хи-квадрат для упрощения таблицы
CrossTable(x = test_y, y = knn_pred, prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  45 
## 
##  
##              | knn_pred 
##       test_y |     setosa | versicolor |  virginica |  Row Total | 
## -------------|------------|------------|------------|------------|
##       setosa |         14 |          0 |          0 |         14 | 
##              |      1.000 |      0.000 |      0.000 |      0.311 | 
##              |      1.000 |      0.000 |      0.000 |            | 
##              |      0.311 |      0.000 |      0.000 |            | 
## -------------|------------|------------|------------|------------|
##   versicolor |          0 |         17 |          1 |         18 | 
##              |      0.000 |      0.944 |      0.056 |      0.400 | 
##              |      0.000 |      0.944 |      0.077 |            | 
##              |      0.000 |      0.378 |      0.022 |            | 
## -------------|------------|------------|------------|------------|
##    virginica |          0 |          1 |         12 |         13 | 
##              |      0.000 |      0.077 |      0.923 |      0.289 | 
##              |      0.000 |      0.056 |      0.923 |            | 
##              |      0.000 |      0.022 |      0.267 |            | 
## -------------|------------|------------|------------|------------|
## Column Total |         14 |         18 |         13 |         45 | 
##              |      0.311 |      0.400 |      0.289 |            | 
## -------------|------------|------------|------------|------------|
## 
##

Матрица ошибок вручную

# table() создает таблицу, показывающую соответствие между фактическими и предсказанными классами
# По диагонали - правильные предсказания, вне диагонали - ошибки
conf_matrix <- table(test_y, knn_pred)
print("Матрица ошибок (Confusion Matrix):")
## [1] "Матрица ошибок (Confusion Matrix):"
print(conf_matrix)
##             knn_pred
## test_y       setosa versicolor virginica
##   setosa         14          0         0
##   versicolor      0         17         1
##   virginica       0          1        12

Диагональная оценка качества прогноза (accuracy)

# diag(conf_matrix) извлекает диагональные элементы (правильные предсказания)
# sum(conf_matrix) - общее количество предсказаний
# accuracy - доля правильных предсказаний
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(round(accuracy * 100, 2))
## [1] 95.56

Модель справилась с классификацией очень хорошо с точностью 95.56%, допустив всего 2 ошибки

Реализация метода опорных векторов.

Рассмотрим пример реализации метода опорных векторов с использованием функции svm() из пакета e1071. Построим линейный классификатор для прогнозирования. Для подбора параметров модели выполним перекрестную проверку с делением исходной выборки на 10 равных частей (cross=10).

Установка и загрузка пакета

install.packages("e1071") # Пакет e1071 содержит реализацию метода опорных векторов (SVM)
## package 'e1071' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\alexa\AppData\Local\Temp\RtmpGumjj2\downloaded_packages
library(e1071)

Загрузка данных iris

data(iris)
head(iris)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

Подготовка данных

# Для простоты линейной классификации оставляем только два класса:
# setosa и versicolor (исключаем virginica, который трудно линейно отделить)
iris_binary <- iris[iris$Species != "virginica", ]

# Преобразуем Species в фактор с двумя уровнями (setosa, versicolor)
# Это необходимо для корректной работы классификатора
iris_binary$Species <- factor(iris_binary$Species)

Разделение на признаки и метки

# Разделение на признаки (X) и целевую переменную (y) для наглядности
X <- iris_binary[, 1:4] # признаки (первые 4 колонки)
y <- iris_binary$Species # метки классов

Построение SVM с линейным ядром и перекрестной проверкой

# svm() - функция для создания модели опорных векторов
# Параметры:
#   Species ~ . - формула
#   data = iris_binary - используем бинарный набор данных
#   kernel = "linear" - линейное ядро (для линейно разделимых данных)
#   cost = 1 - параметр стоимости ошибки (штраф за неверную классификацию)
#     Чем больше cost, тем меньше допускается ошибок, но выше риск переобучения
#   cross = 10 - 10-кратная перекрестная проверка:
#     Данные делятся на 10 частей, 9 используются для обучения, 1 для проверки
#     Процесс повторяется 10 раз, каждый раз с новой проверочной частью
svm_model <- svm(Species ~ ., data = iris_binary, kernel = "linear", 
                 cost = 1, cross = 10)

Вывод сводки модели

# summary показывает:
#   - параметры модели (kernel, cost, gamma и др.)
#   - количество опорных векторов
#   - результаты перекрестной проверки по каждой из 10 итераций
#   - среднюю точность перекрестной проверки
print("Сводка модели SVM")
## [1] "Сводка модели SVM"
summary(svm_model)
## 
## Call:
## svm(formula = Species ~ ., data = iris_binary, kernel = "linear", 
##     cost = 1, cross = 10)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  linear 
##        cost:  1 
## 
## Number of Support Vectors:  4
## 
##  ( 2 2 )
## 
## 
## Number of Classes:  2 
## 
## Levels: 
##  setosa versicolor
## 
## 10-fold cross-validation on training data:
## 
## Total Accuracy: 100 
## Single Accuracies:
##  100 100 100 100 100 100 100 100 100 100

Оценка точности перекрестной проверки

# svm_model$tot.accuracy хранит среднюю точность по всем 10 проверкам
# Это более объективная оценка качества модели, чем точность на обучающей выборке
print(round(svm_model$tot.accuracy, 2))
## [1] 100

Предсказание на полном наборе данных

# predict() применяет обученную модель к данным X
# Возвращает предсказанные классы для каждого образца
svm_pred <- predict(svm_model, X)
conf_matrix <- table(True = y, Predicted = svm_pred)

print("Матрица ошибок")
## [1] "Матрица ошибок"
print(conf_matrix)
##             Predicted
## True         setosa versicolor
##   setosa         50          0
##   versicolor      0         50

Точность на полном наборе

# sum(diag(conf_matrix)) - сумма диагональных элементов (правильные ответы)
# sum(conf_matrix) - общее количество образцов
# Точность = правильные ответы / общее количество
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(round(accuracy * 100, 2))
## [1] 100

Модель прекрасно определила все типы на полной выборке без ошибок.

Расчет главных компонент.

Выполним расчет главных компонент с использованием пакета vegan() и его функции rda(). Построим ординационную диаграмму методом PCA и сделаем выводы.

Установка и загрузка пакета

# Пакет vegan предназначен для экологического анализа, но содержит отличные функции для ординации
# rda() - функция для анализа избыточности (redundancy analysis), которая может выполнять PCA
install.packages("vegan")
## package 'vegan' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\alexa\AppData\Local\Temp\RtmpGumjj2\downloaded_packages
library(vegan)
## Loading required package: permute

Загрузка данных iris

data(iris)
head(iris)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

Выделяем числовые признаки для PCA

# Для анализа главных компонент нужны только числовые признаки (первые 4 колонки)
iris_features <- iris[, 1:4] # отбираем колонки Sepal.Length, Sepal.Width, Petal.Length, Petal.Width

Выполнение PCA с помощью rda()

# rda() с одним аргументом выполняет обычный PCA
# scale = TRUE - стандартизация данных (приводит все признаки к единому масштабу)
pca_result <- rda(iris_features, scale = TRUE)

Вывод сводки

# summary показывает:
# - Собственные значения (eigenvalues) для каждой главной компоненты
# - Долю объясненной дисперсии
# - Вклад признаков в компоненты (нагрузки)
# - Координаты объектов в новом пространстве
print("Сводка результатов PCA")
## [1] "Сводка результатов PCA"
summary(pca_result)
## 
## Call:
## rda(X = iris_features, scale = TRUE) 
## 
## Partitioning of correlations:
##               Inertia Proportion
## Total               4          1
## Unconstrained       4          1
## 
## Eigenvalues, and their contribution to the correlations 
## 
## Importance of components:
##                          PC1    PC2     PC3      PC4
## Eigenvalue            2.9185 0.9140 0.14676 0.020715
## Proportion Explained  0.7296 0.2285 0.03669 0.005179
## Cumulative Proportion 0.7296 0.9581 0.99482 1.000000

Построение ординационной диаграммы

# biplot отображает одновременно:
# - Объекты (точки) - 150 ирисов в пространстве первых двух главных компонент
# - Признаки (стрелки) - показывают направление максимального изменения признаков
# scaling = "species" - масштабирование для лучшего отображения признаков
# main - заголовок графика
biplot(pca_result, scaling = "species", main = "PCA для Iris")

Доля объясненной дисперсии

prop_var <- pca_result$CA$eig / sum(pca_result$CA$eig)
print(round(prop_var * 100, 2))
##   PC1   PC2   PC3   PC4 
## 72.96 22.85  3.67  0.52

PC1 (72.96%) и PC2 (22.85%) объясняют 95.81% вариации — достаточно для анализа. PC3 и PC4 почти не вносят вклад (3.67% и 0.52%). График показывает, как цветы группируются по видам в пространстве PC1 и PC2. Petal.Length и Petal.Width — ключевые признаки для разделения видов. setosa обычно отделяется четко, а versicolor и virginica ближе друг к другу.