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

install.packages(
  c("caret", "FSelector", "arules", "Boruta", "mlbench",
    "ggplot2", "randomForest", "reshape2"),
  repos = "https://cloud.r-project.org/"
)
library(caret)
library(FSelector)
library(arules)
library(Boruta)
library(mlbench)
library(ggplot2)
library(randomForest)
library(reshape2)

Задание 1. Пакет CARET: визуальный анализ признаков

Доступные методы моделирования

model_list <- names(getModelInfo())
cat("Всего доступных методов:", length(model_list), "\n")
## Всего доступных методов: 239
cat("Первые 20 методов:\n")
## Первые 20 методов:
print(head(model_list, 20))
##  [1] "ada"         "AdaBag"      "AdaBoost.M1" "adaboost"    "amdai"      
##  [6] "ANFIS"       "avNNet"      "awnb"        "awtan"       "bag"        
## [11] "bagEarth"    "bagEarthGCV" "bagFDA"      "bagFDAGCV"   "bam"        
## [16] "bartMachine" "bayesglm"    "binda"       "blackboost"  "blasso"

Синтетические данные

set.seed(123)
x <- matrix(rnorm(50 * 5), ncol = 5)
y <- factor(rep(c("A", "B"), 25))
colnames(x) <- paste0("Feature", 1:5)

cat("Размерность матрицы признаков:", dim(x), "\n")
## Размерность матрицы признаков: 50 5
cat("Распределение классов:\n")
## Распределение классов:
print(table(y))
## y
##  A  B 
## 25 25

Рис. 1: Boxplot признаков по классам

featurePlot(
  x = x, y = y,
  plot = "box",
  main = "Рис.1: Boxplot признаков по классам"
)

Рис. 2: Плотность распределения признаков

featurePlot(
  x = x, y = y,
  plot = "density",
  auto.key = list(columns = 2),
  main = "Рис.2: Плотность распределения признаков"
)

Рис. 3: Матрица диаграмм рассеяния

featurePlot(
  x = x, y = y,
  plot = "pairs",
  main = "Рис.3: Матрица диаграмм рассеяния"
)

Вывод

На синтетических данных (случайные числа) нет разделения между классами A и B. Все три графика показывают сильное перекрытие распределений. Это говорит о низкой информативности признаков, что ожидаемо для случайных данных.

Задание 2. Мультиметодный анализ важности признаков (Iris)

data(iris)

# Random Forest
set.seed(123)
rf <- randomForest(Species ~ ., data = iris, importance = TRUE)
rf_imp <- importance(rf)[, "MeanDecreaseAccuracy"]

# Корреляция
iris_num <- iris
iris_num$Species <- as.numeric(iris_num$Species)
cor_imp <- abs(cor(iris_num[, 1:4], iris_num$Species))[, 1]
names(cor_imp) <- names(iris)[1:4]

# ANOVA F-статистика
f_stats <- sapply(names(iris)[1:4], function(f) {
  summary(aov(as.formula(paste(f, "~ Species")), data = iris))[[1]]$F[1]
})

# Хи-квадрат
chi_imp <- sapply(names(iris)[1:4], function(f) {
  disc <- discretize(iris[[f]], method = "frequency", breaks = 3)
  chisq.test(table(disc, iris$Species))$statistic
})

# Сводная таблица
results <- data.frame(
  Feature      = names(iris)[1:4],
  RandomForest = round(rf_imp, 3),
  Correlation  = round(cor_imp, 3),
  ANOVA_F      = round(f_stats, 3),
  ChiSquare    = round(chi_imp, 3)
)

# Нормировка
results_norm <- results
for (i in 2:5) {
  results_norm[, i] <- round(
    (results[, i] - min(results[, i])) /
      (max(results[, i]) - min(results[, i])), 3
  )
}

Абсолютные значения важности

knitr::kable(results, caption = "Абсолютные значения важности признаков")
Абсолютные значения важности признаков
Feature RandomForest Correlation ANOVA_F ChiSquare
Sepal.Length Sepal.Length 11.098 0.783 119.265 116.310
Sepal.Width Sepal.Width 5.145 0.427 49.160 56.473
Petal.Length Petal.Length 33.536 0.949 1180.161 260.984
Petal.Width Petal.Width 32.840 0.957 960.007 256.010

Нормированные значения (0-1)

knitr::kable(results_norm, caption = "Нормированные значения важности (0-1)")
Нормированные значения важности (0-1)
Feature RandomForest Correlation ANOVA_F ChiSquare
Sepal.Length Sepal.Length 0.210 0.672 0.062 0.293
Sepal.Width Sepal.Width 0.000 0.000 0.000 0.000
Petal.Length Petal.Length 1.000 0.985 1.000 1.000
Petal.Width Petal.Width 0.975 1.000 0.805 0.976

Рис. 4: Сравнение методов оценки важности

results_melt <- melt(results_norm, id.vars = "Feature",
                     variable.name = "Method", value.name = "Importance")

ggplot(results_melt, aes(x = Feature, y = Importance, fill = Method)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Рис.4: Сравнение методов оценки важности признаков",
    x = "Признаки",
    y = "Нормированная важность"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Вывод

Все 4 метода дают одинаковый рейтинг признаков:

Место Признак Роль
1 Petal.Length Самый важный
2 Petal.Width Второй по важности
3 Sepal.Length Средняя информативность
4 Sepal.Width Наименее важный

Виды ирисов различаются в первую очередь размером лепестков. Длина и ширина чашелистика менее информативны для классификации.

Задание 3. Дискретизация переменной (arules)

data(iris)
var <- iris$Sepal.Length

cat("Первые 10 значений:", head(var, 10), "\n")
## Первые 10 значений: 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9
cat("Диапазон значений:", range(var), "\n")
## Диапазон значений: 4.3 7.9
# Метод 1: равная ширина интервала
disc_int <- discretize(var, method = "interval", breaks = 3)

# Метод 2: равная частота
disc_freq <- discretize(var, method = "frequency", breaks = 3)

# Метод 3: кластеризация k-means
disc_clust <- discretize(var, method = "cluster", breaks = 3)

# Метод 4: фиксированные границы (квантили)
breaks_fixed <- quantile(var, probs = c(0, 1/3, 2/3, 1))
disc_fixed <- discretize(var, method = "fixed", breaks = breaks_fixed)

Результаты дискретизации

cat("Метод 'interval' (равная ширина):\n")
## Метод 'interval' (равная ширина):
print(table(disc_int))
## disc_int
## [4.3,5.5) [5.5,6.7) [6.7,7.9] 
##        52        70        28
cat("\nМетод 'frequency' (равная частота):\n")
## 
## Метод 'frequency' (равная частота):
print(table(disc_freq))
## disc_freq
## [4.3,5.4) [5.4,6.3) [6.3,7.9] 
##        46        53        51
cat("\nМетод 'cluster' (кластеризация k-means):\n")
## 
## Метод 'cluster' (кластеризация k-means):
print(table(disc_clust))
## disc_clust
##  [4.3,5.33) [5.33,6.27)  [6.27,7.9] 
##          46          53          51
cat("\nМетод 'fixed' (фиксированные границы на основе квантилей):\n")
## 
## Метод 'fixed' (фиксированные границы на основе квантилей):
print(table(disc_fixed))
## disc_fixed
## [4.3,5.4) [5.4,6.3) [6.3,7.9] 
##        46        53        51
cat("Заданные границы:", breaks_fixed, "\n")
## Заданные границы: 4.3 5.4 6.3 7.9

Вывод

Метод Принцип
interval Интервалы равной длины; количество наблюдений разное
frequency Примерно равное количество наблюдений в каждом интервале
cluster Интервалы соответствуют естественным группам данных
fixed Полный контроль исследователя над границами

Выбор метода зависит от конкретной задачи и целей анализа.

Задание 4. Отбор признаков с помощью Boruta (Ozone)

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

data("Ozone", package = "mlbench")
cat("Исходная размерность:", dim(Ozone), "\n")
## Исходная размерность: 366 13
ozone_clean <- na.omit(Ozone)
cat("После удаления NA:", dim(ozone_clean), "\n")
## После удаления NA: 203 13
for (col in names(ozone_clean)) {
  if (is.factor(ozone_clean[[col]])) {
    ozone_clean[[col]] <- as.numeric(as.character(ozone_clean[[col]]))
  }
}
cat("Данные подготовлены.\n")
## Данные подготовлены.

Запуск алгоритма Boruta

set.seed(123)
boruta_result <- Boruta(V4 ~ ., data = ozone_clean, doTrace = 0)
print(boruta_result)
## Boruta performed 24 iterations in 1.815943 secs.
##  9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
##  3 attributes confirmed unimportant: V2, V3, V6;

Статистика по признакам

stats <- attStats(boruta_result)
stats_num <- stats[, sapply(stats, is.numeric)]
stats_rounded <- cbind(round(stats_num, 3), decision = stats$decision)
knitr::kable(stats_rounded, caption = "Статистика Boruta по признакам")
Статистика Boruta по признакам
meanImp medianImp minImp maxImp normHits decision
V1 9.556 9.707 8.426 10.725 1.000 Confirmed
V2 1.156 1.158 -0.247 2.742 0.167 Rejected
V3 -0.988 -0.733 -3.416 0.379 0.000 Rejected
V5 9.243 9.231 8.111 10.514 1.000 Confirmed
V6 0.989 1.362 -1.101 1.985 0.000 Rejected
V7 11.703 11.517 10.513 13.490 1.000 Confirmed
V8 17.165 17.226 16.034 18.553 1.000 Confirmed
V9 19.228 19.063 17.589 20.919 1.000 Confirmed
V10 9.866 9.727 8.648 11.313 1.000 Confirmed
V11 11.898 11.848 10.935 13.652 1.000 Confirmed
V12 14.633 14.610 13.560 16.078 1.000 Confirmed
V13 9.444 9.549 8.101 10.788 1.000 Confirmed

Рис. 5: Важность признаков по Boruta

plot(
  boruta_result,
  las = 2,
  xlab = "",
  main = "Рис.5: Важность признаков по Boruta для Ozone"
)

Результаты отбора

confirmed <- names(boruta_result$finalDecision[
  boruta_result$finalDecision == "Confirmed"])
rejected  <- names(boruta_result$finalDecision[
  boruta_result$finalDecision == "Rejected"])
tentative <- names(boruta_result$finalDecision[
  boruta_result$finalDecision == "Tentative"])

cat("Подтвержденные (важные):", paste(confirmed, collapse = ", "), "\n")
## Подтвержденные (важные): V1, V5, V7, V8, V9, V10, V11, V12, V13
cat("Отвергнутые (неважные):", paste(rejected, collapse = ", "), "\n")
## Отвергнутые (неважные): V2, V3, V6
cat("Сомнительные:", ifelse(length(tentative) > 0,
                            paste(tentative, collapse = ", "),
                            "нет"), "\n")
## Сомнительные: нет

Вывод

Boruta подтвердил 9 важных признаков: V1, V5, V7, V8, V9, V10, V11, V12, V13. Отвергнуты как неинформативные: V2, V3, V6. Сомнительных признаков нет.

Признаки в зеленой зоне на графике влияют на уровень озона (V4) и должны использоваться в модели.

Итоговые выводы

В ходе лабораторной работы изучены 4 пакета R для анализа признаков:

  1. CARET. Изучен список из 239 методов моделирования. Выполнен визуальный анализ с помощью featurePlot на синтетических данных.

  2. FSelector / randomForest / arules. Оценена важность признаков в датасете Iris четырьмя методами. Все методы согласованно выделяют Petal.Length и Petal.Width как наиболее информативные.

  3. arules. Проведена дискретизация Sepal.Length четырьмя методами. Показаны различия в распределении наблюдений по интервалам в зависимости от метода.

  4. Boruta. Выполнен автоматический отбор признаков для данных Ozone. Из 12 признаков 9 подтверждены как важные, 3 отвергнуты.