В данной лабораторной работе рассматриваются методы машинного обучения:
## '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 ...
##
## setosa versicolor virginica
## 50 50 50
##
## setosa versicolor virginica
## 33.3 33.3 33.3
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 частично перекрываются.
Алгоритм 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].
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
## Размер тестовой выборки: 38
library(class)
# Построение модели KNN с k=3
iris_mdl <- knn(train = iris_train,
test = iris_test,
cl = iris_train_labels,
k = 3)
# Результаты предсказания
cat("Предсказанные классы:\n")## Предсказанные классы:
## [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
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 | |
## -----------------|------------|------------|------------|------------|
##
##
## Прогноз
## Факт setosa versicolor virginica
## setosa 10 0 0
## versicolor 0 12 0
## virginica 0 2 14
# Расчёт точности (accuracy)
accuracy <- sum(diag(CM)) / sum(CM)
cat("Точность модели (Accuracy):", round(accuracy * 100, 2), "%\n")## Точность модели (Accuracy): 94.74 %
##
## Количество правильных классификаций: 36
## Общее количество наблюдений: 38
Вывод: Модель KNN с k=3 показывает высокую точность на датасете iris. Большинство ошибок связано с путаницей между versicolor и virginica, что объясняется их схожестью.
# Проверка разных значений 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 %
Для демонстрации 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
# Построение 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
# Точность на перекрестной проверке
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 %
## Количество опорных векторов: 4
## Опорные векторы по классам: 2 2
# Визуализация (используем первые 2 признака для наглядности)
plot(svm_model, iris_svm, Sepal.Width ~ Sepal.Length,
main = "SVM: Sepal.Width vs Sepal.Length")Рассмотрим также полную трёхклассовую задачу:
# 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) позволяет получить более надёжную оценку качества модели.
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
# Выполняем 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
## Собственные значения (eigenvalues):
## 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")# Нагрузки переменных на главные компоненты
loadings <- scores(mod_pca, display = "species")
cat("Нагрузки переменных на главные компоненты:\n")## Нагрузки переменных на главные компоненты:
## 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
# Получаем координаты наблюдений
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"))# Альтернативная визуализация с векторами переменных
biplot(mod_pca, display = c("sites", "species"),
type = c("points", "text"),
main = "PCA Biplot")В ходе лабораторной работы были изучены и применены три метода анализа данных:
## 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