Анализ данных, лабораторная работа №5 “№Кластерный и регрессионный анализ данных с использованием языка R”

Загружу необходимые пакеты.

options(repos = c(CRAN = "https://cran.rstudio.com/"))
install.packages(c("class", "gmodels"))

G2;WARNING: Rtools is required to build R packages but is not currently installed. Please download and install the appropriate version of Rtools before proceeding:

https://cran.rstudio.com/bin/windows/Rtools/g
пробую URL 'https://cran.rstudio.com/bin/windows/contrib/4.6/gtools_3.9.5.zip'
пробую URL 'https://cran.rstudio.com/bin/windows/contrib/4.6/gdata_3.0.1.zip'
пробую URL 'https://cran.rstudio.com/bin/windows/contrib/4.6/class_7.3-23.zip'
пробую URL 'https://cran.rstudio.com/bin/windows/contrib/4.6/gmodels_2.19.1.zip'

package ‘gtools’ successfully unpacked and MD5 sums checked
package ‘gdata’ successfully unpacked and MD5 sums checked
package ‘class’ successfully unpacked and MD5 sums checked
package ‘gmodels’ successfully unpacked and MD5 sums checked

Скачанные бинарные пакеты находятся в
    C:\Users\oleg3\AppData\Local\Temp\RtmpkrdKXA\downloaded_packages

library(class) # class - содержит функцию knn() для классификации методом k-ближайших соседей
library(gmodels) # gmodels - содержит функцию CrossTable() для создания перекрестных таблиц

Задание 2

Ход работы

Выполню классификацию k-ближайших соседей с использованием функции knn() из пакета class на наборе данных iris.

Для начала загружу данные iris.

data(iris)
head(iris)

Проведите нормализацию данных - произведу масштабирование в диапазон [0, 1]

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

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() из пакета gmodels.

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 |            | 
-------------|------------|------------|------------|------------|

 

     
   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 |            |
 -------------|------------|------------|------------|------------|   

Построю матрицу ошибок:

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

[1] "Матрица ошибок (Confusion Matrix):"
                  knn_pred 
test_y       setosa versicolor virginica   
  setosa         14          0         0   
  versicolor      0         17         1   
  virginica       0          1        12

Построю диагональную оценку качества прогноза (diagonal mark quality prediction):

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(round(accuracy * 100, 2))

[1] 95.56

[1] 95.56 

Вывод

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

Задание 3

Ход работы

Реализую метод опорных векторов с использованием функции svm() из пакета e1071. Загружу необходимый пакет.

install.packages("e1071")

library(e1071)

Загружу данные:

data(iris)
head(iris)

Для простоты классификации оставлю только два класса: setosa и versicolor. Преобразую Species в фактор с двумя уровнями (setosa, versicolor).

iris_binary <- iris[iris$Species != "virginica", ]

iris_binary$Species <- factor(iris_binary$Species)

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

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

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

# 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 

[1] "Сводка модели SVM"  
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

[1] 100

Применю модель к данным 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

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

Выведу точность на полном наборе.

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(round(accuracy * 100, 2))

[1] 100

[1] 100

Вывод

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

Задание 4

Ход работы

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

Установлю пакет.

install.packages("vegan")

library(vegan)

Загружу данные.

data(iris)
head(iris)

Выделю числовые признаки для метода главных компонент (PCA).

iris_features <- iris[, 1:4] # Sepal.Length, Sepal.Width, Petal.Length, Petal.Width

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

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

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

[1] "Сводка результатов PCA"

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   PC2   PC3   PC4
72.96 22.85  3.67  0.52 

1. PC1 (первая главная компонента) объясняет 72,96 % всей дисперсии в данных. Это направление в пространстве признаков, вдоль которого данные имеют наибольшую вариативность. Первая компонента «ухватила» основную часть информации из исходных переменных.

2. PC2 (вторая главная компонента) объясняет ещё 22,85 % дисперсии. Она ортогональна (некоррелирована) PC1 и захватывает следующую по величине часть вариативности, которую не объяснила PC1. Вместе они объясняют 95.81% вариации — достаточно для анализа.

3. PC3 добавляет всего 3,67 % объяснённой дисперсии. Вклад этой компоненты уже невелик — она описывает относительно малые закономерности в данных.

4. PC4 объясняет лишь 0,52 % дисперсии. Это очень малая доля, которая, скорее всего, соответствует шуму или крайне незначительным паттернам в данных.