Введение

В данной лабораторной работе рассматриваются методы машинного обучения:

  • K-ближайших соседей (KNN) — непараметрический метод классификации
  • Метод опорных векторов (SVM) — алгоритм построения оптимальной разделяющей гиперплоскости
  • Анализ главных компонент (PCA) — метод снижения размерности данных

Задание 2: Классификация методом k-ближайших соседей

2.1 Загрузка и исследование данных

# Загружаем датасет iris
data(iris)

# Структура данных
str(iris)
## 'data.frame':    150 obs. of  5 variables:
##  $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
##  $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
##  $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
##  $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
##  $ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
# Распределение по классам
table(iris$Species)
## 
##     setosa versicolor  virginica 
##         50         50         50
# Процентное соотношение классов
round(prop.table(table(iris$Species)) * 100, digits = 1)
## 
##     setosa versicolor  virginica 
##       33.3       33.3       33.3

2.2 Визуализация данных

par(mfrow = c(1, 2))

# График Sepal.Length vs Sepal.Width
plot(iris$Sepal.Length, iris$Sepal.Width, 
     col = iris$Species, pch = 19,
     xlab = "Sepal.Length", ylab = "Sepal.Width",
     main = "Sepal: Length vs Width")
legend("topright", legend = levels(iris$Species), 
       bty = "n", pch = 19, col = 1:3)

# График Petal.Length vs Petal.Width
plot(iris$Petal.Length, iris$Petal.Width, 
     col = iris$Species, pch = 19,
     xlab = "Petal.Length", ylab = "Petal.Width",
     main = "Petal: Length vs Width")
legend("topright", legend = levels(iris$Species), 
       bty = "n", pch = 19, col = 1:3)

Наблюдение: Видно, что setosa хорошо отделяется от других видов, в то время как versicolor и virginica частично перекрываются.

2.3 Нормализация данных

Алгоритм KNN сильно зависит от масштаба признаков, поэтому необходима нормализация:

# Функция min-max нормализации
normMinMax <- function(x) {
  return((x - min(x)) / (max(x) - min(x)))
}

# Применяем нормализацию к числовым признакам
iris_norm <- as.data.frame(lapply(iris[1:4], normMinMax))

# Проверяем результат
summary(iris_norm)
##   Sepal.Length     Sepal.Width      Petal.Length     Petal.Width     
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.00000  
##  1st Qu.:0.2222   1st Qu.:0.3333   1st Qu.:0.1017   1st Qu.:0.08333  
##  Median :0.4167   Median :0.4167   Median :0.5678   Median :0.50000  
##  Mean   :0.4287   Mean   :0.4406   Mean   :0.4675   Mean   :0.45806  
##  3rd Qu.:0.5833   3rd Qu.:0.5417   3rd Qu.:0.6949   3rd Qu.:0.70833  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.00000

После нормализации все признаки находятся в диапазоне [0, 1].

2.4 Разделение на обучающую и тестовую выборки

set.seed(1234)

# Случайное разделение: 70% обучающая, 30% тестовая
indexes <- sample(2, nrow(iris), replace = TRUE, prob = c(0.7, 0.3))

# Обучающая выборка (признаки)
iris_train <- iris_norm[indexes == 1, ]
# Тестовая выборка (признаки)
iris_test <- iris_norm[indexes == 2, ]

# Метки классов
iris_train_labels <- iris[indexes == 1, 5]
iris_test_labels <- iris[indexes == 2, 5]

cat("Размер обучающей выборки:", nrow(iris_train), "\n")
## Размер обучающей выборки: 112
cat("Размер тестовой выборки:", nrow(iris_test), "\n")
## Размер тестовой выборки: 38

2.5 Построение модели KNN

library(class)

# Построение модели KNN с k=3
iris_mdl <- knn(train = iris_train, 
                test = iris_test, 
                cl = iris_train_labels, 
                k = 3)

# Результаты предсказания
cat("Предсказанные классы:\n")
## Предсказанные классы:
print(iris_mdl)
##  [1] setosa     setosa     setosa     setosa     setosa     setosa    
##  [7] setosa     setosa     setosa     setosa     versicolor versicolor
## [13] versicolor versicolor versicolor versicolor versicolor versicolor
## [19] versicolor versicolor versicolor versicolor virginica  virginica 
## [25] virginica  virginica  versicolor virginica  virginica  virginica 
## [31] virginica  virginica  versicolor virginica  virginica  virginica 
## [37] virginica  virginica 
## Levels: setosa versicolor virginica

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

library(gmodels)

# CrossTable для оценки модели
CrossTable(x = iris_test_labels, 
           y = iris_mdl, 
           prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  38 
## 
##  
##                  | iris_mdl 
## iris_test_labels |     setosa | versicolor |  virginica |  Row Total | 
## -----------------|------------|------------|------------|------------|
##           setosa |         10 |          0 |          0 |         10 | 
##                  |      1.000 |      0.000 |      0.000 |      0.263 | 
##                  |      1.000 |      0.000 |      0.000 |            | 
##                  |      0.263 |      0.000 |      0.000 |            | 
## -----------------|------------|------------|------------|------------|
##       versicolor |          0 |         12 |          0 |         12 | 
##                  |      0.000 |      1.000 |      0.000 |      0.316 | 
##                  |      0.000 |      0.857 |      0.000 |            | 
##                  |      0.000 |      0.316 |      0.000 |            | 
## -----------------|------------|------------|------------|------------|
##        virginica |          0 |          2 |         14 |         16 | 
##                  |      0.000 |      0.125 |      0.875 |      0.421 | 
##                  |      0.000 |      0.143 |      1.000 |            | 
##                  |      0.000 |      0.053 |      0.368 |            | 
## -----------------|------------|------------|------------|------------|
##     Column Total |         10 |         14 |         14 |         38 | 
##                  |      0.263 |      0.368 |      0.368 |            | 
## -----------------|------------|------------|------------|------------|
## 
## 

2.7 Матрица ошибок (Confusion Matrix)

# Построение матрицы ошибок
CM <- table(Факт = iris_test_labels, Прогноз = iris_mdl)
print(CM)
##             Прогноз
## Факт     setosa versicolor virginica
##   setosa         10          0         0
##   versicolor      0         12         0
##   virginica       0          2        14

Интерпретация матрицы ошибок

  • True Positive (TP): Правильно классифицированные объекты каждого класса (диагональные элементы)
  • False Positive (FP): Объекты, ошибочно отнесённые к данному классу
  • False Negative (FN): Объекты данного класса, ошибочно отнесённые к другим классам

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

# Расчёт точности (accuracy)
accuracy <- sum(diag(CM)) / sum(CM)
cat("Точность модели (Accuracy):", round(accuracy * 100, 2), "%\n")
## Точность модели (Accuracy): 94.74 %
# Детальный анализ по классам
cat("\nКоличество правильных классификаций:", sum(diag(CM)), "\n")
## 
## Количество правильных классификаций: 36
cat("Общее количество наблюдений:", sum(CM), "\n")
## Общее количество наблюдений: 38

Вывод: Модель KNN с k=3 показывает высокую точность на датасете iris. Большинство ошибок связано с путаницей между versicolor и virginica, что объясняется их схожестью.

2.9 Исследование влияния параметра k

# Проверка разных значений k
k_values <- 1:15
accuracies <- sapply(k_values, function(k) {
  pred <- knn(train = iris_train, test = iris_test, 
              cl = iris_train_labels, k = k)
  mean(pred == iris_test_labels)
})

# Визуализация
plot(k_values, accuracies, type = "b", 
     xlab = "Значение k", ylab = "Accuracy",
     main = "Зависимость точности от параметра k",
     pch = 19, col = "blue")
abline(h = max(accuracies), lty = 2, col = "red")

cat("Лучшее значение k:", k_values[which.max(accuracies)], 
    "с точностью", round(max(accuracies) * 100, 2), "%\n")
## Лучшее значение k: 2 с точностью 97.37 %

Задание 3: Метод опорных векторов (SVM)

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

Для демонстрации SVM используем датасет iris с бинарной классификацией:

library(e1071)

# Загрузка данных
data(iris)

# Преобразуем в задачу бинарной классификации
# Класс 1: setosa, Класс 2: versicolor + virginica
iris_svm <- iris
iris_svm$Class <- as.factor(ifelse(iris$Species == "setosa", "Setosa", "Other"))

# Проверка распределения
table(iris_svm$Class)
## 
##  Other Setosa 
##    100     50

3.2 Построение линейного SVM-классификатора

# Построение SVM с линейным ядром и 10-fold перекрестной проверкой
svm_model <- svm(formula = Class ~ Sepal.Length + Sepal.Width + 
                          Petal.Length + Petal.Width,
                 data = iris_svm,
                 cross = 10,
                 kernel = "linear")

# Информация о модели
print(svm_model)
## 
## Call:
## svm(formula = Class ~ Sepal.Length + Sepal.Width + Petal.Length + 
##     Petal.Width, data = iris_svm, cross = 10, kernel = "linear")
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  linear 
##        cost:  1 
## 
## Number of Support Vectors:  4

3.3 Результаты перекрестной проверки

# Точность на перекрестной проверке
cat("Точность 10-fold CV:", round(svm_model$tot.accuracy, 2), "%\n")
## Точность 10-fold CV: 100 %
# Предсказания модели
svm_predictions <- predict(svm_model)

# Матрица ошибок
svm_CM <- table(Факт = iris_svm$Class, Прогноз = svm_predictions)
print(svm_CM)
##         Прогноз
## Факт Other Setosa
##   Other    100      0
##   Setosa     0     50
# Точность on training data
svm_accuracy <- mean(svm_predictions == iris_svm$Class)
cat("\nТочность на обучающих данных:", round(svm_accuracy * 100, 2), "%\n")
## 
## Точность на обучающих данных: 100 %

3.4 Визуализация опорных векторов

# Количество опорных векторов
cat("Количество опорных векторов:", svm_model$tot.nSV, "\n")
## Количество опорных векторов: 4
cat("Опорные векторы по классам:", svm_model$nSV, "\n")
## Опорные векторы по классам: 2 2
# Визуализация (используем первые 2 признака для наглядности)
plot(svm_model, iris_svm, Sepal.Width ~ Sepal.Length,
     main = "SVM: Sepal.Width vs Sepal.Length")

3.5 Многоклассовая SVM-классификация

Рассмотрим также полную трёхклассовую задачу:

# SVM для всех трёх классов
svm_multi <- svm(formula = Species ~ .,
                 data = iris,
                 cross = 10,
                 kernel = "linear")

cat("Точность многоклассовой SVM (10-fold CV):", 
    round(svm_multi$tot.accuracy, 2), "%\n")
## Точность многоклассовой SVM (10-fold CV): 96 %
# Матрица ошибок
multi_pred <- predict(svm_multi)
multi_CM <- table(Факт = iris$Species, Прогноз = multi_pred)
print(multi_CM)
##             Прогноз
## Факт     setosa versicolor virginica
##   setosa         50          0         0
##   versicolor      0         46         4
##   virginica       0          1        49

Вывод: - Линейный SVM-классификатор эффективно разделяет setosa от других видов с высокой точностью. - При многоклассовой классификации SVM также показывает хорошие результаты. - 10-fold перекрестная проверка (cross=10) позволяет получить более надёжную оценку качества модели.


Задание 4: Анализ главных компонент (PCA)

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

library(vegan)
library(ggplot2)

# Используем числовые признаки iris
Y <- iris[, 1:4]

# Описательные статистики
summary(Y)
##   Sepal.Length    Sepal.Width     Petal.Length    Petal.Width   
##  Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100  
##  1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300  
##  Median :5.800   Median :3.000   Median :4.350   Median :1.300  
##  Mean   :5.843   Mean   :3.057   Mean   :3.758   Mean   :1.199  
##  3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100   3rd Qu.:1.800  
##  Max.   :7.900   Max.   :4.400   Max.   :6.900   Max.   :2.500

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

# Выполняем PCA с помощью rda() из пакета vegan
mod_pca <- rda(Y ~ 1)

# Полный отчёт PCA
summary(mod_pca)
## 
## Call:
## rda(formula = Y ~ 1) 
## 
## Partitioning of variance:
##               Inertia Proportion
## Total           4.573          1
## Unconstrained   4.573          1
## 
## Eigenvalues, and their contribution to the variance 
## 
## Importance of components:
##                          PC1     PC2     PC3      PC4
## Eigenvalue            4.2282 0.24267 0.07821 0.023835
## Proportion Explained  0.9246 0.05307 0.01710 0.005212
## Cumulative Proportion 0.9246 0.97769 0.99479 1.000000

4.3 Собственные значения и доля объяснённой дисперсии

# Собственные значения
eigenvalues <- mod_pca$CA$eig
cat("Собственные значения (eigenvalues):\n")
## Собственные значения (eigenvalues):
print(round(eigenvalues, 4))
##    PC1    PC2    PC3    PC4 
## 4.2282 0.2427 0.0782 0.0238
# Доля объяснённой дисперсии
prop_var <- eigenvalues / sum(eigenvalues)
cumulative_var <- cumsum(prop_var)

variance_table <- data.frame(
  PC = paste0("PC", 1:length(eigenvalues)),
  Eigenvalue = round(eigenvalues, 4),
  Proportion = round(prop_var * 100, 2),
  Cumulative = round(cumulative_var * 100, 2)
)
print(variance_table)
##      PC Eigenvalue Proportion Cumulative
## PC1 PC1     4.2282      92.46      92.46
## PC2 PC2     0.2427       5.31      97.77
## PC3 PC3     0.0782       1.71      99.48
## PC4 PC4     0.0238       0.52     100.00
# Scree plot
barplot(prop_var * 100, names.arg = paste0("PC", 1:length(eigenvalues)),
        main = "Scree Plot - Доля объяснённой дисперсии",
        ylab = "Процент дисперсии (%)",
        xlab = "Главные компоненты",
        col = "steelblue")

4.4 Нагрузки (Loadings)

# Нагрузки переменных на главные компоненты
loadings <- scores(mod_pca, display = "species")
cat("Нагрузки переменных на главные компоненты:\n")
## Нагрузки переменных на главные компоненты:
print(round(loadings, 4))
##                  PC1     PC2
## Sepal.Length  1.7754 -0.7728
## Sepal.Width  -0.4152 -0.8594
## Petal.Length  4.2086  0.2041
## Petal.Width   1.7602  0.0888
## attr(,"const")
## [1] 5.109117

4.5 Ординационная диаграмма

# Получаем координаты наблюдений
pca_scores <- as.data.frame(scores(mod_pca, display = "sites")[, 1:2])
colnames(pca_scores) <- c("PC1", "PC2")
pca_scores$Species <- iris$Species

# Включаем доли объяснённой дисперсии в названия осей
axX <- paste("PC1 (", 
             round(100 * mod_pca$CA$eig[1] / sum(mod_pca$CA$eig), 1), "%)", sep = "")
axY <- paste("PC2 (", 
             round(100 * mod_pca$CA$eig[2] / sum(mod_pca$CA$eig), 1), "%)", sep = "")

# Каркас (hull) для выделения классов на диаграмме
hull <- do.call(rbind, lapply(unique(pca_scores$Species), function(s) {
  f <- subset(pca_scores, Species == s)
  f[chull(f$PC1, f$PC2), ]
}))

# Построение ординационной диаграммы
ggplot() +
  geom_polygon(data = hull, aes(x = PC1, y = PC2, fill = Species), 
               alpha = 0.3, linetype = 0) +
  geom_point(data = pca_scores, 
             aes(x = PC1, y = PC2, shape = Species, colour = Species), 
             size = 3) +
  scale_colour_manual(values = c("setosa" = "#E41A1C", 
                                  "versicolor" = "#377EB8", 
                                  "virginica" = "#4DAF4A")) +
  scale_fill_manual(values = c("setosa" = "#E41A1C", 
                                "versicolor" = "#377EB8", 
                                "virginica" = "#4DAF4A")) +
  xlab(axX) + ylab(axY) +
  ggtitle("Ординационная диаграмма PCA (метод RDA)") +
  coord_equal() + 
  theme_bw() +
  theme(legend.position = "right",
        plot.title = element_text(hjust = 0.5, face = "bold"))

4.6 Биплот с нагрузками переменных

# Альтернативная визуализация с векторами переменных
biplot(mod_pca, display = c("sites", "species"), 
       type = c("points", "text"),
       main = "PCA Biplot")

4.7 Выводы по PCA

  1. Объяснённая дисперсия:
    • PC1 объясняет 92.5% вариации данных.
    • PC1 + PC2 совместно объясняют 97.8% вариации.
    • Первые две компоненты достаточны для визуализации.
  2. Интерпретация главных компонент:
    • PC1 определяется преимущественно Petal.Length и Petal.Width.
    • PC2 отражает вариацию в Sepal.Width.
  3. Разделение классов:
    • Setosa чётко отделяется от других видов по PC1.
    • Versicolor и Virginica частично перекрываются.
    • Это согласуется с результатами KNN и SVM.

Заключение

В ходе лабораторной работы были изучены и применены три метода анализа данных:

  1. KNN-классификация:
    • Нормализация данных критически важна для работы алгоритма
    • Модель показала высокую точность на датасете iris
    • Оптимальное значение k следует подбирать экспериментально
  2. SVM-классификация:
    • Линейный SVM эффективно работает с линейно разделимыми данными
    • 10-fold перекрестная проверка обеспечивает надёжную оценку качества
    • Метод устойчив к выбросам благодаря использованию опорных векторов
  3. Анализ главных компонент:
    • Позволяет визуализировать многомерные данные в 2D
    • Первые две компоненты объясняют большую часть вариации
    • Подтверждает наблюдения о структуре данных iris

Информация о сессии

sessionInfo()
## R version 4.5.2 (2025-10-31)
## Platform: x86_64-pc-linux-gnu
## Running under: CachyOS
## 
## Matrix products: default
## BLAS:   /usr/lib/libblas.so.3.12.0 
## LAPACK: /usr/lib/liblapack.so.3.12.0  LAPACK version 3.12.0
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## time zone: Europe/Samara
## tzcode source: system (glibc)
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] ggplot2_4.0.2  vegan_2.7-2    permute_0.9-10 e1071_1.7-17   gmodels_2.19.1
## [6] class_7.3-23  
## 
## loaded via a namespace (and not attached):
##  [1] Matrix_1.7-4       gtable_0.3.6       jsonlite_2.0.0     dplyr_1.2.0       
##  [5] compiler_4.5.2     gtools_3.9.5       tidyselect_1.2.1   parallel_4.5.2    
##  [9] cluster_2.1.8.1    jquerylib_0.1.4    splines_4.5.2      scales_1.4.0      
## [13] yaml_2.3.12        fastmap_1.2.0      lattice_0.22-7     R6_2.6.1          
## [17] labeling_0.4.3     generics_0.1.4     knitr_1.51         MASS_7.3-65       
## [21] tibble_3.3.1       pillar_1.11.1      bslib_0.10.0       RColorBrewer_1.1-3
## [25] rlang_1.1.7        cachem_1.1.0       xfun_0.56          sass_0.4.10       
## [29] S7_0.2.1           cli_3.6.5          withr_3.0.2        magrittr_2.0.4    
## [33] mgcv_1.9-3         digest_0.6.39      grid_4.5.2         gdata_3.0.1       
## [37] lifecycle_1.0.5    nlme_3.1-168       vctrs_0.7.1        proxy_0.4-29      
## [41] evaluate_1.0.5     glue_1.8.0         farver_2.1.2       rmarkdown_2.30    
## [45] pkgconfig_2.0.3    tools_4.5.2        htmltools_0.5.9