Кластерный и регрессионный анализ данных с использованием языка R
Гринко Ярослав
2026-05-30
1 Задание 2 — Классификация k-ближайших соседей (KNN)
Задание: Выполнить классификацию kNN на датасете
iris, нормализовать данные, разделить на обучающую и
тестовую выборки, оценить через CrossTable() и матрицу
ошибок.
1.1 Подготовка данных
# install.packages(c("class", "gmodels", "caret"))
library(class) # knn()
library(gmodels) # CrossTable()
library(caret) # confusionMatrix()
# iris — 150 цветков, 4 признака + вид (Species)
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 ...## 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
## Species
## setosa :50
## versicolor:50
## virginica :50
##
##
## 1.2 Нормализация
# KNN работает через расстояния, поэтому все признаки надо привести к одному масштабу [0, 1].
# Иначе признак с большим диапазоном будет доминировать над остальными.
# Функция min-max нормализации
normalize <- function(x) {
return((x - min(x)) / (max(x) - min(x)))
}
# lapply применяет функцию к каждому столбцу, берём только числовые (1:4)
iris_norm <- as.data.frame(lapply(iris[, 1:4], normalize))
cat("До нормализации — диапазон Sepal.Length:\n")## До нормализации — диапазон Sepal.Length:## мин: 4.3 макс: 7.9## После нормализации:## мин: 0 макс: 1## Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 0.22222222 0.6250000 0.06779661 0.04166667
## 2 0.16666667 0.4166667 0.06779661 0.04166667
## 3 0.11111111 0.5000000 0.05084746 0.04166667
## 4 0.08333333 0.4583333 0.08474576 0.04166667
## 5 0.19444444 0.6666667 0.06779661 0.04166667
## 6 0.30555556 0.7916667 0.11864407 0.125000001.3 Разбивка на train/test
set.seed(123) # фиксируем случайность для воспроизводимости
# 70% — обучающая, 30% — тестовая
train_idx <- sample(1:nrow(iris_norm), size = 0.7 * nrow(iris_norm))
train_data <- iris_norm[train_idx, ]
test_data <- iris_norm[-train_idx, ]
train_labels <- iris$Species[train_idx]
test_labels <- iris$Species[-train_idx]
cat("Обучающая выборка:", nrow(train_data), "строк\n")## Обучающая выборка: 105 строк## Тестовая выборка: 45 строк1.4 Обучение KNN
# k берём как sqrt от размера обучающей выборки — стандартное правило
k_val <- round(sqrt(nrow(train_data)))
cat("Используем k =", k_val, "\n")## Используем k = 10# knn() не "обучается" в классическом смысле — он просто запоминает все точки
# и при предсказании ищет k ближайших соседей для каждого нового объекта
knn_pred <- knn(train = train_data,
test = test_data,
cl = train_labels, # метки классов обучающей выборки
k = k_val)
cat("Предсказания:\n")## Предсказания:## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa setosa setosa
## [13] setosa setosa versicolor versicolor versicolor versicolor
## [19] versicolor versicolor versicolor versicolor versicolor versicolor
## [25] versicolor versicolor versicolor virginica versicolor versicolor
## [31] versicolor versicolor virginica virginica virginica virginica
## [37] virginica virginica virginica virginica virginica versicolor
## [43] virginica virginica virginica
## Levels: setosa versicolor virginica1.5 CrossTable — перекрёстная таблица
# CrossTable показывает подробную таблицу: строки = реальные, столбцы = предсказанные.
# Идеально: все значения на диагонали (предсказано верно).
# Вне диагонали = ошибки.
CrossTable(x = test_labels,
y = knn_pred,
prop.chisq = FALSE) # убираем chi-квадрат — нам не нужен##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 45
##
##
## | knn_pred
## test_labels | 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 | |
## -------------|------------|------------|------------|------------|
##
## 1.6 Матрица ошибок и диагональная оценка качества
## Confusion Matrix and Statistics
##
## Reference
## Prediction setosa versicolor virginica
## setosa 14 0 0
## versicolor 0 17 1
## virginica 0 1 12
##
## Overall Statistics
##
## Accuracy : 0.9556
## 95% CI : (0.8485, 0.9946)
## No Information Rate : 0.4
## P-Value [Acc > NIR] : 2.842e-15
##
## Kappa : 0.9326
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: setosa Class: versicolor Class: virginica
## Sensitivity 1.0000 0.9444 0.9231
## Specificity 1.0000 0.9630 0.9688
## Pos Pred Value 1.0000 0.9444 0.9231
## Neg Pred Value 1.0000 0.9630 0.9688
## Prevalence 0.3111 0.4000 0.2889
## Detection Rate 0.3111 0.3778 0.2667
## Detection Prevalence 0.3111 0.4000 0.2889
## Balanced Accuracy 1.0000 0.9537 0.9459##
## === Матрица ошибок ===## Reference
## Prediction setosa versicolor virginica
## setosa 14 0 0
## versicolor 0 17 1
## virginica 0 1 12# Диагональная оценка (diagonal mark quality prediction):
# diag() берёт главную диагональ — это правильно классифицированные по каждому классу
cat("\n=== Диагональ (верно классифицированные по классам) ===\n")##
## === Диагональ (верно классифицированные по классам) ===## setosa versicolor virginica
## 14 17 12##
## === Точность по каждому классу (%) ===## setosa versicolor virginica
## 100.0 94.4 92.3##
## === Общая точность модели ===## 95.56 %1.7 Подбор оптимального k
k_values <- seq(1, 20, by = 2)
accuracies <- sapply(k_values, function(k) {
pred <- knn(train = train_data, test = test_data, cl = train_labels, k = k)
mean(pred == test_labels)
})
results_k <- data.frame(k = k_values, accuracy_pct = round(accuracies * 100, 1))
cat("=== Точность при разных k ===\n")## === Точность при разных k ===## k accuracy_pct
## 1 1 95.6
## 2 3 95.6
## 3 5 95.6
## 4 7 95.6
## 5 9 97.8
## 6 11 97.8
## 7 13 97.8
## 8 15 97.8
## 9 17 97.8
## 10 19 97.8plot(k_values, accuracies * 100,
type = "b", pch = 19, col = "steelblue",
xlab = "k (число соседей)", ylab = "Точность (%)",
main = "Выбор оптимального k для KNN",
ylim = c(80, 100))
abline(h = max(accuracies * 100), col = "red", lty = 2)
legend("bottomright",
legend = paste("Лучшее k =", k_values[which.max(accuracies)]),
col = "red", lty = 2, bty = "n")
2 Задание 3 — Метод опорных векторов (SVM)
Задание: Реализовать SVM через svm() из
пакета e1071, построить линейный классификатор, выполнить
кросс-валидацию с cross=10.
2.1 Линейный SVM на датасете iris
# install.packages("e1071")
library(e1071)
set.seed(42)
# Разбивка 70/30
idx_svm <- sample(1:nrow(iris), 0.7 * nrow(iris))
train_svm <- iris[idx_svm, ]
test_svm <- iris[-idx_svm, ]
# svm() — строит оптимальную разделяющую гиперплоскость
# kernel = "linear" — линейный классификатор (прямая в 2D, плоскость в 3D и т.д.)
# cost — штраф за ошибки: маленький = мягкая граница, большой = жёсткая
# scale = TRUE — нормализует данные автоматически
svm_linear <- svm(Species ~ .,
data = train_svm,
kernel = "linear",
cost = 1,
scale = TRUE)
print(svm_linear)##
## Call:
## svm(formula = Species ~ ., data = train_svm, kernel = "linear", cost = 1,
## scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: linear
## cost: 1
##
## Number of Support Vectors: 25##
## Число опорных векторов: 252.2 Визуализация линейного классификатора
# plot() для svm рисует разделяющую плоскость
# Крестики = опорные векторы (точки, которые "держат" границу)
# Цвет области = предсказанный класс
plot(svm_linear,
data = train_svm,
formula = Petal.Width ~ Petal.Length,
main = "SVM: линейный классификатор (iris)")
2.3 Предсказание и оценка модели
svm_pred <- predict(svm_linear, test_svm)
cm_svm <- confusionMatrix(svm_pred, test_svm$Species)
print(cm_svm)## Confusion Matrix and Statistics
##
## Reference
## Prediction setosa versicolor virginica
## setosa 12 0 0
## versicolor 0 14 1
## virginica 0 1 17
##
## Overall Statistics
##
## Accuracy : 0.9556
## 95% CI : (0.8485, 0.9946)
## No Information Rate : 0.4
## P-Value [Acc > NIR] : 2.842e-15
##
## Kappa : 0.9324
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: setosa Class: versicolor Class: virginica
## Sensitivity 1.0000 0.9333 0.9444
## Specificity 1.0000 0.9667 0.9630
## Pos Pred Value 1.0000 0.9333 0.9444
## Neg Pred Value 1.0000 0.9667 0.9630
## Prevalence 0.2667 0.3333 0.4000
## Detection Rate 0.2667 0.3111 0.3778
## Detection Prevalence 0.2667 0.3333 0.4000
## Balanced Accuracy 1.0000 0.9500 0.9537##
## === Матрица ошибок SVM ===## Reference
## Prediction setosa versicolor virginica
## setosa 12 0 0
## versicolor 0 14 1
## virginica 0 1 17##
## === Диагональная оценка качества ===## setosa versicolor virginica
## 12 14 17##
## === Общая точность SVM ===## 95.56 %2.4 Кросс-валидация с cross=10
# cross=10: данные делятся на 10 равных частей (фолдов).
# Модель обучается на 9 фолдах, проверяется на 10-м.
# Процедура повторяется 10 раз — каждый фолд побывает тестовым.
# Результат: честная оценка без переобучения.
svm_cv <- svm(Species ~ .,
data = train_svm,
kernel = "linear",
cost = 1,
scale = TRUE,
cross = 10) # <-- 10-fold кросс-валидация
cat("=== Точность по каждому из 10 фолдов (%) ===\n")## === Точность по каждому из 10 фолдов (%) ===## [1] 100.00 90.91 90.00 100.00 100.00 90.91 100.00 100.00 90.00 90.91##
## === Средняя точность кросс-валидации (%) ===## 95.27# tot.acc — суммарная точность, которую возвращает svm() при cross > 0
cat("\n=== Суммарная точность кросс-валидации (tot.acc) ===\n")##
## === Суммарная точность кросс-валидации (tot.acc) ===## 95.242.5 Подбор параметров через tune()
# tune() перебирает комбинации параметров и ищет лучшую через кросс-валидацию
tune_result <- tune(svm,
Species ~ .,
data = train_svm,
kernel = "radial",
ranges = list(
cost = c(0.1, 1, 10, 100),
gamma = c(0.01, 0.1, 1)
),
tunecontrol = tune.control(cross = 10))
cat("=== Лучшие параметры ===\n")## === Лучшие параметры ===## cost gamma
## 3 10 0.01##
## === Ошибка лучшей модели ===## 2.73 %# График ошибки по сетке параметров
plot(tune_result,
main = "Ошибка SVM при разных cost и gamma (меньше = лучше)")
# Финальная модель с лучшими параметрами
best_svm <- tune_result$best.model
best_pred <- predict(best_svm, test_svm)
cat("\n=== Точность лучшей SVM (radial) ===\n")##
## === Точность лучшей SVM (radial) ===## 97.78 %3 Задание 4 — Метод главных компонент (PCA)
Задание: Рассчитать главные компоненты через
rda() из пакета vegan, построить ординационную
диаграмму и сделать выводы.
3.1 Подготовка и исследование данных
# install.packages("vegan")
library(vegan)
# Числовые признаки iris
iris_num <- iris[, 1:4]
cat("=== Описательная статистика ===\n")## === Описательная статистика ===## 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##
## === Матрица корреляций ===# Сильная корреляция между признаками — сигнал, что PCA поможет
# (они несут похожую информацию, PCA её "схлопнет")
print(round(cor(iris_num), 2))## Sepal.Length Sepal.Width Petal.Length Petal.Width
## Sepal.Length 1.00 -0.12 0.87 0.82
## Sepal.Width -0.12 1.00 -0.43 -0.37
## Petal.Length 0.87 -0.43 1.00 0.96
## Petal.Width 0.82 -0.37 0.96 1.003.2 Расчёт PCA через rda()
# rda() из vegan без правой части формулы делает чистый PCA
# scale = TRUE ОБЯЗАТЕЛЬНО — иначе признаки с большей дисперсией будут доминировать
pca <- rda(iris_num, scale = TRUE)
# Полная сводка: собственные числа, нагрузки, координаты объектов
summary(pca)##
## Call:
## rda(X = iris_num, 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.0000003.3 Объясняемая дисперсия (Scree plot)
# Сколько % вариации объясняет каждая компонента?
eig <- as.numeric(eigenvals(pca))
prop_var <- eig / sum(eig) * 100
cumul_var <- cumsum(prop_var)
var_table <- data.frame(
PC = paste0("PC", 1:length(eig)),
Eigenvalue = round(eig, 3),
Variance_pct = round(prop_var, 2),
Cumulative = round(cumul_var, 2)
)
cat("=== Доля объясняемой дисперсии ===\n")## === Доля объясняемой дисперсии ===## PC Eigenvalue Variance_pct Cumulative
## 1 PC1 2.918 72.96 72.96
## 2 PC2 0.914 22.85 95.81
## 3 PC3 0.147 3.67 99.48
## 4 PC4 0.021 0.52 100.00# Scree plot — "каменистая осыпь": показывает, где компоненты перестают быть полезными
# Красная линия = порог Кайзера (eigenvalue > 1, т.е. выше среднего)
barplot(prop_var,
names.arg = paste0("PC", 1:length(prop_var)),
col = c("steelblue", "steelblue", "lightgray", "lightgray"),
main = "Scree plot: доля объясняемой дисперсии по компонентам",
ylab = "Дисперсия (%)",
xlab = "Главная компонента",
ylim = c(0, 80))
abline(h = mean(prop_var), col = "red", lty = 2, lwd = 2)
legend("topright", legend = "Порог Кайзера (среднее)", col = "red", lty = 2, bty = "n")
3.4 Ординационная диаграмма (biplot)
# Цвета по видам
sp_colors <- c(setosa = "#E74C3C", versicolor = "#27AE60", virginica = "#2980B9")
pt_colors <- sp_colors[as.character(iris$Species)]
# --- Биплот 1: объекты + переменные ---
# scaling = 2: расстояния между объектами = корреляционные расстояния,
# углы между стрелками = корреляция между переменными
biplot(pca,
display = c("sites", "species"),
type = c("points", "text"),
col = c("black", "navy"),
pch = 19,
scaling = 2,
main = "PCA biplot: объекты и переменные (iris)")
# Перерисовываем точки с цветами по видам
points(scores(pca, display = "sites", scaling = 2),
col = pt_colors, pch = 19, cex = 0.9)
legend("topright",
legend = names(sp_colors),
col = sp_colors,
pch = 19,
bty = "n",
title = "Вид")
# --- Биплот 2: через ordiplot (более гибкий) ---
ordiplot(pca,
type = "n",
scaling = 2,
main = "PCA: ординационная диаграмма методом ordiplot")
# Эллипсы доверия по группам — наглядно показывают разделение видов
ordiellipse(pca,
groups = iris$Species,
col = sp_colors,
lwd = 2,
scaling = 2,
label = FALSE)
# Точки объектов
points(scores(pca, display = "sites", scaling = 2),
col = pt_colors, pch = 19, cex = 0.9)
# Стрелки переменных
plot(pca,
display = "species",
type = "text",
col = "navy",
add = TRUE,
scaling = 2)
legend("topright",
legend = names(sp_colors),
col = sp_colors,
pch = 19,
bty = "n",
title = "Вид")
3.5 Нагрузки признаков (loadings)
# Нагрузки = вклад каждого исходного признака в каждую главную компоненту.
# Большая нагрузка (по модулю) = признак сильно влияет на эту компоненту.
loadings_mat <- scores(pca, display = "species", scaling = 0)
cat("=== Нагрузки признаков ===\n")## === Нагрузки признаков ===## PC1 PC2
## Sepal.Length 0.521 -0.377
## Sepal.Width -0.269 -0.923
## Petal.Length 0.580 -0.024
## Petal.Width 0.565 -0.067
## attr(,"const")
## [1] 4.940963##
## === Топ-признаки по PC1 (по убыванию вклада) ===## Petal.Length Petal.Width Sepal.Length Sepal.Width
## 0.5804131 0.5648565 0.5210659 0.2693474##
## === Топ-признаки по PC2 (по убыванию вклада) ===## Sepal.Width Sepal.Length Petal.Width Petal.Length
## 0.92329566 0.37741762 0.06694199 0.024491613.6 Выводы
## ================================================## ВЫВОДЫ ПО РЕЗУЛЬТАТАМ PCA## ================================================## 1. Объясняемая дисперсия:## PC1: 73 % — самая информативная ось## PC2: 22.9 %## PC1 + PC2: 95.8 % — двух компонент достаточно!## 2. Интерпретация главных компонент:## PC1 = 'общий размер цветка': Petal.Length, Petal.Width## и Sepal.Length сильно нагружены — большие значения PC1## означают крупный цветок.## PC2 = 'форма чашелистика': Sepal.Width вносит## наибольший вклад независимо от общего размера.## 3. Разделение видов на биплоте:## - Setosa чётко отделена от остальных по оси PC1## (маленький размер лепестков).## - Versicolor и Virginica перекрываются частично,## но Virginica смещена правее (крупнее).## 4. Интерпретация стрелок:## Длина стрелки = важность признака.## Малый угол между стрелками = высокая корреляция.## Petal.Length и Petal.Width почти параллельны —## они сильно коррелируют (r ≈ 0.96).