Практическая работа №2. Работа с пакетами CARET и BORUTA

1. Пакет CARET: список методов и графический разведочный анализ

1.1 Установка пакета и список доступных методов

install.packages("caret", dependencies = TRUE)
install.packages("FSelector")
install.packages("arules")
install.packages("Boruta")
install.packages("mlbench")
install.packages("ggplot2")
install.packages("lattice")

library(caret)
library(lattice)
library(ggplot2)

# Список всех доступных методов в caret
all_methods <- names(getModelInfo())
cat("Всего доступных методов:", length(all_methods), "\n")

## Всего доступных методов: 239

cat("\nПервые 50 методов:\n")

## 
## Первые 50 методов:

print(head(all_methods, 50))

##  [1] "ada"            "AdaBag"         "AdaBoost.M1"    "adaboost"      
##  [5] "amdai"          "ANFIS"          "avNNet"         "awnb"          
##  [9] "awtan"          "bag"            "bagEarth"       "bagEarthGCV"   
## [13] "bagFDA"         "bagFDAGCV"      "bam"            "bartMachine"   
## [17] "bayesglm"       "binda"          "blackboost"     "blasso"        
## [21] "blassoAveraged" "bridge"         "brnn"           "BstLm"         
## [25] "bstSm"          "bstTree"        "C5.0"           "C5.0Cost"      
## [29] "C5.0Rules"      "C5.0Tree"       "cforest"        "chaid"         
## [33] "CSimca"         "ctree"          "ctree2"         "cubist"        
## [37] "dda"            "deepboost"      "DENFIS"         "dnn"           
## [41] "dwdLinear"      "dwdPoly"        "dwdRadial"      "earth"         
## [45] "elm"            "enet"           "evtree"         "extraTrees"    
## [49] "fda"            "FH.GBML"

Пакет caret (Classification And REgression Training) предоставляет унифицированный интерфейс для работы с более чем 239 алгоритмами машинного обучения. Среди них: линейные модели (lm, glm), деревья решений (rpart, C5.0), случайные леса (rf), градиентный бустинг (gbm, xgbTree), метод опорных векторов (svmLinear, svmRadial), нейронные сети (nnet) и многие другие.

1.2 Генерация данных из справочного файла CARET

set.seed(42)
x <- matrix(rnorm(50 * 5), ncol = 5)
y <- factor(rep(c("A", "B"), 25))

# Преобразуем в data.frame для удобства
df <- data.frame(x, Class = y)
colnames(df)[1:5] <- paste0("V", 1:5)

cat("Размер матрицы x:", dim(x), "\n")

## Размер матрицы x: 50 5

cat("Распределение классов y:\n")

## Распределение классов y:

print(table(y))

## y
##  A  B 
## 25 25

cat("\nПервые строки данных:\n")

## 
## Первые строки данных:

print(head(df))

##           V1          V2         V3          V4         V5 Class
## 1  1.3709584  0.32192527  1.2009654 -0.04069848 -2.0009292     A
## 2 -0.5646982 -0.78383894  1.0447511 -1.55154482  0.3337772     B
## 3  0.3631284  1.57572752 -1.0032086  1.16716955  1.1713251     A
## 4  0.6328626  0.64289931  1.8484819 -0.27364570  2.0595392     B
## 5  0.4042683  0.08976065 -0.6667734 -0.46784532 -1.3768616     A
## 6 -0.1061245  0.27655075  0.1055138 -1.23825233 -1.1508556     B

1.3 Графический разведочный анализ с featurePlot()

Диаграммы рассеяния (scatter)

scatter_plot <- featurePlot(
  x = x,
  y = y,
  plot = "pairs",
  auto.key = list(columns = 2)
)
print(scatter_plot)

Диаграмма рассеяния признаков по классам

jpeg("featurePlot_scatter.jpg", width = 800, height = 700, quality = 90)
print(featurePlot(
  x = x,
  y = y,
  plot = "pairs",
  auto.key = list(columns = 2)
))
dev.off()

## quartz_off_screen 
##                 2

cat("График сохранён: featurePlot_scatter.jpg\n")

## График сохранён: featurePlot_scatter.jpg

Box-plots по классам

box_plot <- featurePlot(
  x = x,
  y = y,
  plot = "box",
  scales = list(y = list(relation = "free"),
                x = list(rot = 90)),
  layout = c(5, 1),
  auto.key = list(columns = 2)
)
print(box_plot)

Box-plot распределений признаков по классам

jpeg("featurePlot_boxplot.jpg", width = 900, height = 500, quality = 90)
print(featurePlot(
  x = x,
  y = y,
  plot = "box",
  scales = list(y = list(relation = "free"),
                x = list(rot = 90)),
  layout = c(5, 1),
  auto.key = list(columns = 2)
))
dev.off()

## quartz_off_screen 
##                 2

cat("График сохранён: featurePlot_boxplot.jpg\n")

## График сохранён: featurePlot_boxplot.jpg

Плотности распределений

density_plot <- featurePlot(
  x = x,
  y = y,
  plot = "density",
  scales = list(x = list(relation = "free"),
                y = list(relation = "free")),
  adjust = 1.5,
  pch = "|",
  layout = c(5, 1),
  auto.key = list(columns = 2)
)
print(density_plot)

Плотности распределений признаков по классам

jpeg("featurePlot_density.jpg", width = 900, height = 500, quality = 90)
print(featurePlot(
  x = x,
  y = y,
  plot = "density",
  scales = list(x = list(relation = "free"),
                y = list(relation = "free")),
  adjust = 1.5,
  pch = "|",
  layout = c(5, 1),
  auto.key = list(columns = 2)
))
dev.off()

## quartz_off_screen 
##                 2

cat("График сохранён: featurePlot_density.jpg\n")

## График сохранён: featurePlot_density.jpg

Violin-plot

# Строим violin вручную через ggplot2 для большей наглядности
library(tidyr)
df_long <- pivot_longer(df, cols = V1:V5, names_to = "Feature", values_to = "Value")

vp <- ggplot(df_long, aes(x = Feature, y = Value, fill = Class)) +
  geom_violin(alpha = 0.6, position = position_dodge(0.8)) +
  geom_boxplot(width = 0.1, position = position_dodge(0.8), outlier.size = 0.5) +
  scale_fill_manual(values = c("A" = "#2196F3", "B" = "#FF5722")) +
  labs(title = "Violin-plot: распределения признаков по классам",
       x = "Признак", y = "Значение") +
  theme_minimal(base_size = 13)
print(vp)

Violin-plot признаков по классам

ggsave("featurePlot_violin.jpg", plot = vp, width = 9, height = 5, dpi = 150)
cat("График сохранён: featurePlot_violin.jpg\n")

## График сохранён: featurePlot_violin.jpg

1.4 Выводы по разделу 1

Выводы: Данные были сгенерированы случайно из нормального распределения N(0,1), поэтому все пять признаков (V1–V5) не несут предсказательной силы для разделения классов A и B. Это подтверждается:

• На scatter-диаграммах точки классов A и B перемешаны без выраженного разделения;
• На box-plot медианы и квартили обоих классов совпадают в пределах случайного шума;
• На density-plot кривые плотностей для A и B практически идентичны;
• На violin-plot формы распределений обоих классов одинаковы.

Это ожидаемый результат для случайных данных — функция featurePlot() позволяет быстро визуально оценить, есть ли в признаках различие между классами.

---

2. Важность признаков с пакетом FSelector (набор данных iris)

library(FSelector)
data(iris)

cat("Структура набора данных iris:\n")

## Структура набора данных 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 ...

cat("\nПервые строки:\n")

## 
## Первые строки:

print(head(iris))

##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

2.1 Метод Information Gain (информационный выигрыш)

ig_weights <- information.gain(Species ~ ., data = iris)
cat("Information Gain:\n")

## Information Gain:

print(ig_weights)

##              attr_importance
## Sepal.Length       0.4521286
## Sepal.Width        0.2672750
## Petal.Length       0.9402853
## Petal.Width        0.9554360

ig_top <- cutoff.k(ig_weights, 3)
cat("\nТоп-3 признака по Information Gain:", ig_top, "\n")

## 
## Топ-3 признака по Information Gain: Petal.Width Petal.Length Sepal.Length

2.2 Метод Gain Ratio

gr_weights <- gain.ratio(Species ~ ., data = iris)
cat("Gain Ratio:\n")

## Gain Ratio:

print(gr_weights)

##              attr_importance
## Sepal.Length       0.4196464
## Sepal.Width        0.2472972
## Petal.Length       0.8584937
## Petal.Width        0.8713692

gr_top <- cutoff.k(gr_weights, 3)
cat("\nТоп-3 признака по Gain Ratio:", gr_top, "\n")

## 
## Топ-3 признака по Gain Ratio: Petal.Width Petal.Length Sepal.Length

2.3 Метод симметричной неопределённости (Symmetrical Uncertainty)

su_weights <- symmetrical.uncertainty(Species ~ ., data = iris)
cat("Symmetrical Uncertainty:\n")

## Symmetrical Uncertainty:

print(su_weights)

##              attr_importance
## Sepal.Length       0.4155563
## Sepal.Width        0.2452743
## Petal.Length       0.8571872
## Petal.Width        0.8705214

2.4 Метод корреляции с целевой переменной (chi-squared)

chi_weights <- chi.squared(Species ~ ., data = iris)
cat("Chi-Squared:\n")

## Chi-Squared:

print(chi_weights)

##              attr_importance
## Sepal.Length       0.6288067
## Sepal.Width        0.4922162
## Petal.Length       0.9346311
## Petal.Width        0.9432359

chi_top <- cutoff.k(chi_weights, 3)
cat("\nТоп-3 признака по Chi-Squared:", chi_top, "\n")

## 
## Топ-3 признака по Chi-Squared: Petal.Width Petal.Length Sepal.Length

2.5 OneR — правило одного атрибута

oner_weights <- oneR(Species ~ ., data = iris)
cat("OneR:\n")

## OneR:

print(oner_weights)

##              attr_importance
## Sepal.Length       0.1733333
## Sepal.Width        0.0400000
## Petal.Length       0.4000000
## Petal.Width        0.4066667

2.6 Визуализация важности признаков

library(ggplot2)

# Собираем результаты всех методов
importance_df <- data.frame(
  Feature = rownames(ig_weights),
  InformationGain = ig_weights$attr_importance,
  GainRatio = gr_weights$attr_importance,
  SymmUncertainty = su_weights$attr_importance,
  ChiSquared = chi_weights$attr_importance / max(chi_weights$attr_importance)
)

importance_long <- tidyr::pivot_longer(
  importance_df,
  cols = -Feature,
  names_to = "Method",
  values_to = "Importance"
)

ggplot(importance_long, aes(x = reorder(Feature, Importance), y = Importance, fill = Method)) +
  geom_bar(stat = "identity", position = "dodge") +
  coord_flip() +
  scale_fill_brewer(palette = "Set2") +
  labs(
    title = "Важность признаков iris по методам FSelector",
    x = "Признак", y = "Важность (нормализованная)",
    fill = "Метод"
  ) +
  theme_minimal(base_size = 13)

Важность признаков по методам FSelector

2.7 Выводы по разделу 2

Выводы: Все четыре метода пакета FSelector единогласно выделяют Petal.Length и Petal.Width как наиболее важные признаки для классификации видов ирисов. Признаки лепестка содержат значительно больше информации для разделения классов, чем признаки чашелистика (Sepal.Length, Sepal.Width).

• Information Gain и Gain Ratio дают похожий рейтинг: Petal.Width ≈ Petal.Length >> Sepal.Length > Sepal.Width;
• Symmetrical Uncertainty подтверждает сильную связь признаков лепестка с целевой переменной;
• Chi-Squared также ставит на первое место Petal.Width и Petal.Length.

Это согласуется с известным свойством набора данных iris: виды setosa легко отделить по любому признаку, но для разделения versicolor/virginica решающую роль играют именно размеры лепестков.

---

3. Дискретизация непрерывных переменных (пакет arules)

library(arules)
data(iris)

# Используем Sepal.Length как демонстрационную переменную
x_cont <- iris$Sepal.Length
cat("Исходные значения Sepal.Length:\n")

## Исходные значения Sepal.Length:

print(summary(x_cont))

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   4.300   5.100   5.800   5.843   6.400   7.900

3.1 Метод «interval» — равная ширина интервала

disc_interval <- discretize(x_cont, method = "interval", breaks = 4)
cat("Метод 'interval' (равная ширина):\n")

## Метод 'interval' (равная ширина):

print(table(disc_interval))

## disc_interval
## [4.3,5.2) [5.2,6.1)   [6.1,7)   [7,7.9] 
##        41        48        48        13

cat("\nГраницы интервалов:\n")

## 
## Границы интервалов:

print(levels(disc_interval))

## [1] "[4.3,5.2)" "[5.2,6.1)" "[6.1,7)"   "[7,7.9]"

3.2 Метод «frequency» — равная частота

disc_freq <- discretize(x_cont, method = "frequency", breaks = 4)
cat("Метод 'frequency' (равная частота):\n")

## Метод 'frequency' (равная частота):

print(table(disc_freq))

## disc_freq
## [4.3,5.1) [5.1,5.8) [5.8,6.4) [6.4,7.9] 
##        32        41        35        42

cat("\nГраницы интервалов:\n")

## 
## Границы интервалов:

print(levels(disc_freq))

## [1] "[4.3,5.1)" "[5.1,5.8)" "[5.8,6.4)" "[6.4,7.9]"

3.3 Метод «cluster» — кластеризация (k-means)

set.seed(42)
disc_cluster <- discretize(x_cont, method = "cluster", breaks = 4)
cat("Метод 'cluster' (k-means кластеризация):\n")

## Метод 'cluster' (k-means кластеризация):

print(table(disc_cluster))

## disc_cluster
##  [4.3,5.26) [5.26,5.95) [5.95,6.68)  [6.68,7.9] 
##          45          38          39          28

cat("\nГраницы интервалов:\n")

## 
## Границы интервалов:

print(levels(disc_cluster))

## [1] "[4.3,5.26)"  "[5.26,5.95)" "[5.95,6.68)" "[6.68,7.9]"

3.4 Метод «fixed» — фиксированные границы

disc_fixed <- discretize(
  x_cont,
  method = "fixed",
  breaks = c(-Inf, 5.0, 6.0, 7.0, Inf),
  labels = c("очень короткий", "короткий", "средний", "длинный")
)
cat("Метод 'fixed' (фиксированные границы: 5.0, 6.0, 7.0):\n")

## Метод 'fixed' (фиксированные границы: 5.0, 6.0, 7.0):

print(table(disc_fixed))

## disc_fixed
## очень короткий       короткий        средний        длинный 
##             22             61             54             13

3.5 Сравнительная визуализация методов дискретизации

par(mfrow = c(2, 2), mar = c(5, 4, 3, 1))

# Исходное непрерывное распределение
hist(x_cont, breaks = 20, col = "#90CAF9", border = "white",
     main = "Исходное распределение", xlab = "Sepal.Length", ylab = "Частота")

# interval
barplot(table(disc_interval), col = "#A5D6A7", border = "white",
        main = "Метод: interval", xlab = "Категория", ylab = "Частота",
        las = 2, cex.names = 0.7)

# frequency
barplot(table(disc_freq), col = "#FFCC80", border = "white",
        main = "Метод: frequency", xlab = "Категория", ylab = "Частота",
        las = 2, cex.names = 0.7)

# cluster
barplot(table(disc_cluster), col = "#CE93D8", border = "white",
        main = "Метод: cluster", xlab = "Категория", ylab = "Частота",
        las = 2, cex.names = 0.7)

Сравнение методов дискретизации Sepal.Length

par(mfrow = c(1, 1))

# Дискретизация всех 4 признаков iris
iris_disc <- iris
for (col in names(iris)[1:4]) {
  iris_disc[[col]] <- discretize(iris[[col]], method = "frequency", breaks = 3,
                                  labels = c("низкий", "средний", "высокий"))
}

# Сводная таблица
cat("Дискретизированные признаки (первые 10 строк):\n")

## Дискретизированные признаки (первые 10 строк):

print(head(iris_disc, 10))

##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1        низкий     высокий       низкий      низкий  setosa
## 2        низкий     средний       низкий      низкий  setosa
## 3        низкий     высокий       низкий      низкий  setosa
## 4        низкий     средний       низкий      низкий  setosa
## 5        низкий     высокий       низкий      низкий  setosa
## 6       средний     высокий       низкий      низкий  setosa
## 7        низкий     высокий       низкий      низкий  setosa
## 8        низкий     высокий       низкий      низкий  setosa
## 9        низкий     средний       низкий      низкий  setosa
## 10       низкий     средний       низкий      низкий  setosa

# Визуализация
library(ggplot2)
library(tidyr)
iris_long <- pivot_longer(iris_disc, cols = 1:4, names_to = "Feature", values_to = "Category")
iris_long$Category <- factor(iris_long$Category, levels = c("низкий", "средний", "высокий"))

ggplot(iris_long, aes(x = Category, fill = Species)) +
  geom_bar(position = "dodge") +
  facet_wrap(~ Feature, scales = "free") +
  scale_fill_brewer(palette = "Set1") +
  labs(title = "Дискретизация признаков iris (метод frequency, 3 категории)",
       x = "Категория", y = "Количество") +
  theme_minimal(base_size = 11)

Дискретизация всех непрерывных признаков iris методом frequency

3.6 Выводы по разделу 3

Выводы:

Метод	Принцип	Особенность
interval	Равная ширина интервала	Простой, но чувствителен к выбросам; неравномерное наполнение категорий
frequency	Равное число объектов в категории	Равномерное наполнение, лучше для статистического анализа
cluster	k-means кластеризация	Адаптируется к форме распределения, находит «естественные» группы
fixed	Задаются вручную	Максимальная интерпретируемость, требует знаний предметной области

Для признака Sepal.Length: - Метод interval даёт неравномерное распределение объектов по категориям, т.к. распределение не равномерное; - Метод frequency обеспечивает примерно равное число наблюдений в каждой категории; - Метод cluster находит группы схожие с естественными кластерами в данных; - Метод fixed позволяет задать экспертные пороги (например, 5.0, 6.0, 7.0 см).

---

4. Выбор признаков с пакетом Boruta (набор данных Ozone)

4.1 Загрузка данных

library(Boruta)
library(mlbench)

data("Ozone")
cat("Структура набора данных Ozone:\n")

## Структура набора данных Ozone:

str(Ozone)

## 'data.frame':    366 obs. of  13 variables:
##  $ V1 : Factor w/ 12 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ V2 : Factor w/ 31 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ V3 : Factor w/ 7 levels "1","2","3","4",..: 4 5 6 7 1 2 3 4 5 6 ...
##  $ V4 : num  3 3 3 5 5 6 4 4 6 7 ...
##  $ V5 : num  5480 5660 5710 5700 5760 5720 5790 5790 5700 5700 ...
##  $ V6 : num  8 6 4 3 3 4 6 3 3 3 ...
##  $ V7 : num  20 NA 28 37 51 69 19 25 73 59 ...
##  $ V8 : num  NA 38 40 45 54 35 45 55 41 44 ...
##  $ V9 : num  NA NA NA NA 45.3 ...
##  $ V10: num  5000 NA 2693 590 1450 ...
##  $ V11: num  -15 -14 -25 -24 25 15 -33 -28 23 -2 ...
##  $ V12: num  30.6 NA 47.7 55 57 ...
##  $ V13: num  200 300 250 100 60 60 100 250 120 120 ...

cat("\nПервые строки:\n")

## 
## Первые строки:

print(head(Ozone))

##   V1 V2 V3 V4   V5 V6 V7 V8    V9  V10 V11   V12 V13
## 1  1  1  4  3 5480  8 20 NA    NA 5000 -15 30.56 200
## 2  1  2  5  3 5660  6 NA 38    NA   NA -14    NA 300
## 3  1  3  6  3 5710  4 28 40    NA 2693 -25 47.66 250
## 4  1  4  7  5 5700  3 37 45    NA  590 -24 55.04 100
## 5  1  5  1  5 5760  3 51 54 45.32 1450  25 57.02  60
## 6  1  6  2  6 5720  4 69 35 49.64 1568  15 53.78  60

cat("\nПропущенные значения по столбцам:\n")

## 
## Пропущенные значения по столбцам:

print(colSums(is.na(Ozone)))

##  V1  V2  V3  V4  V5  V6  V7  V8  V9 V10 V11 V12 V13 
##   0   0   0   5  12   0  15   2 139  15   1  14   0

4.2 Предобработка данных

# Удаляем строки с пропущенными значениями (для корректной работы Boruta)
Ozone_clean <- na.omit(Ozone)
cat("Размер после удаления NA: ", nrow(Ozone_clean), "x", ncol(Ozone_clean), "\n")

## Размер после удаления NA:  203 x 13

# Целевая переменная — V4 (концентрация озона)
cat("\nОписательная статистика целевой переменной V4 (озон):\n")

## 
## Описательная статистика целевой переменной V4 (озон):

print(summary(Ozone_clean$V4))

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    5.00    9.00   11.37   16.00   38.00

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

set.seed(42)
boruta_result <- Boruta(
  V4 ~ .,
  data = Ozone_clean,
  doTrace = 0,
  maxRuns = 100
)

cat("Результат Boruta:\n")

## Результат Boruta:

print(boruta_result)

## Boruta performed 21 iterations in 0.1794751 secs.
##  9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
##  3 attributes confirmed unimportant: V2, V3, V6;

cat("\nСтатус каждого признака:\n")

## 
## Статус каждого признака:

print(boruta_result$finalDecision)

##        V1        V2        V3        V5        V6        V7        V8        V9 
## Confirmed  Rejected  Rejected Confirmed  Rejected Confirmed Confirmed Confirmed 
##       V10       V11       V12       V13 
## Confirmed Confirmed Confirmed Confirmed 
## Levels: Tentative Confirmed Rejected

4.4 Финальное решение (обработка «Tentative»)

final_boruta <- TentativeRoughFix(boruta_result)
cat("Финальное решение после TentativeRoughFix:\n")

## Финальное решение после TentativeRoughFix:

print(final_boruta$finalDecision)

##        V1        V2        V3        V5        V6        V7        V8        V9 
## Confirmed  Rejected  Rejected Confirmed  Rejected Confirmed Confirmed Confirmed 
##       V10       V11       V12       V13 
## Confirmed Confirmed Confirmed Confirmed 
## Levels: Tentative Confirmed Rejected

# Важные признаки
confirmed <- getSelectedAttributes(final_boruta, withTentative = FALSE)
cat("\nПодтверждённые важные признаки:\n")

## 
## Подтверждённые важные признаки:

print(confirmed)

## [1] "V1"  "V5"  "V7"  "V8"  "V9"  "V10" "V11" "V12" "V13"

rejected <- names(final_boruta$finalDecision[final_boruta$finalDecision == "Rejected"])
cat("\nОтвергнутые признаки:\n")

## 
## Отвергнутые признаки:

print(rejected)

## [1] "V2" "V3" "V6"

4.5 Box-plot важности признаков

# Базовый boxplot из пакета Boruta
plot(
  final_boruta,
  cex.axis = 0.8,
  las = 2,
  xlab = "Признак",
  main = "Boruta: важность признаков для прогноза концентрации озона\n(зелёный — важный, красный — неважный, синий — теневой эталон)"
)

Boruta: важность признаков (Z-scores случайных лесов)

# Улучшенный ggplot2 вариант
imp_df <- data.frame(
  Feature = rownames(attStats(final_boruta)),
  attStats(final_boruta)
)

imp_df$Status <- final_boruta$finalDecision[match(imp_df$Feature, names(final_boruta$finalDecision))]

# Добавляем теневые переменные (они не входят в finalDecision)
imp_df$Status[is.na(imp_df$Status)] <- "Shadow"
imp_df$Status <- as.character(imp_df$Status)
imp_df$Status[grepl("^shadow", imp_df$Feature, ignore.case = TRUE)] <- "Shadow"

# Получаем importance score
boruta_imp_long <- data.frame(
  Feature = names(final_boruta$ImpHistory[1, ]),
  t(final_boruta$ImpHistory)
)
boruta_imp_long <- tidyr::pivot_longer(boruta_imp_long, cols = -Feature,
                                        names_to = "Run", values_to = "Importance")
boruta_imp_long <- boruta_imp_long[!is.nan(boruta_imp_long$Importance), ]

# Статус для цвета
status_map <- c(as.character(final_boruta$finalDecision))
names(status_map) <- names(final_boruta$finalDecision)

boruta_imp_long$Status <- status_map[boruta_imp_long$Feature]
boruta_imp_long$Status[is.na(boruta_imp_long$Status)] <- "Shadow"

color_map <- c("Confirmed" = "#43A047", "Rejected" = "#E53935",
               "Tentative" = "#FB8C00", "Shadow" = "#90A4AE")

median_order <- aggregate(Importance ~ Feature, data = boruta_imp_long, FUN = median)
median_order <- median_order[order(median_order$Importance, decreasing = TRUE), ]

boruta_imp_long$Feature <- factor(
  boruta_imp_long$Feature,
  levels = rev(median_order$Feature)
)

ggplot(boruta_imp_long, aes(x = Feature, y = Importance, fill = Status)) +
  geom_boxplot(outlier.size = 0.5, alpha = 0.85) +
  coord_flip() +
  scale_fill_manual(values = color_map) +
  labs(
    title = "Boruta: важность признаков для прогноза концентрации озона",
    subtitle = "Зелёный = Confirmed, Красный = Rejected, Серый = Shadow (теневые эталоны)",
    x = "Признак", y = "Z-score важности (случайный лес)",
    fill = "Статус"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom")

Boruta: ggplot2 boxplot важности признаков

4.6 Сравнение предсказательной силы отобранных признаков

if (length(confirmed) > 0) {
  # Оставляем только числовые подтверждённые признаки
  numeric_confirmed <- confirmed[sapply(Ozone_clean[, confirmed, drop = FALSE], is.numeric)]

  if (length(numeric_confirmed) > 0) {
    cor_vals <- cor(Ozone_clean[, numeric_confirmed, drop = FALSE],
                    Ozone_clean$V4, use = "complete.obs")
    cor_df <- data.frame(
      Feature = rownames(cor_vals),
      Correlation = cor_vals[, 1]
    )
    cor_df <- cor_df[order(abs(cor_df$Correlation), decreasing = TRUE), ]

    ggplot(cor_df, aes(x = reorder(Feature, abs(Correlation)),
                       y = Correlation,
                       fill = Correlation > 0)) +
      geom_bar(stat = "identity", alpha = 0.8) +
      coord_flip() +
      scale_fill_manual(values = c("TRUE" = "#43A047", "FALSE" = "#E53935"),
                        labels = c("TRUE" = "Положительная", "FALSE" = "Отрицательная")) +
      labs(
        title = "Корреляция подтверждённых числовых признаков с концентрацией озона (V4)",
        x = "Признак", y = "Коэффициент корреляции Пирсона",
        fill = "Тип корреляции"
      ) +
      theme_minimal(base_size = 12)
  } else {
    cat("Все подтверждённые признаки являются категориальными — корреляция Пирсона неприменима.\n")
    cat("Подтверждённые признаки:", paste(confirmed, collapse = ", "), "\n")
  }
}

Корреляция подтверждённых признаков с концентрацией озона

4.7 Выводы по разделу 4

n_confirmed <- sum(final_boruta$finalDecision == "Confirmed")
n_rejected  <- sum(final_boruta$finalDecision == "Rejected")
n_tentative <- sum(final_boruta$finalDecision == "Tentative")

Выводы:

Алгоритм Boruta является оберткой над случайным лесом (Random Forest) и использует метод «теневых признаков» для объективной оценки важности: 1. К исходным признакам добавляются их перемешанные копии («тени»); 2. Обучается случайный лес; признак считается важным, если его Z-score значимо превышает максимальный Z-score теневых признаков.

Результаты для набора Ozone: - Подтверждено (Confirmed): 9 признаков - Отвергнуто (Rejected): 3 признаков - Под вопросом (Tentative): 0 признаков

Подтверждённые признаки: V1, V5, V7, V8, V9, V10, V11, V12, V13

Набор Ozone содержит метеорологические данные (температура, давление, скорость ветра, радиация и т.д.), влияющие на концентрацию озона. Boruta позволяет автоматически отобрать переменные с реальной предсказательной силой, что помогает упростить модель и избежать переобучения.

---

Общее заключение

В ходе практической работы были освоены следующие методы и инструменты:

Задача	Пакет / Функция	Результат
Список методов ML	caret::getModelInfo()	Изучено 239 методов
Визуальный EDA	caret::featurePlot()	4 типа графиков сохранены в .jpg
Важность признаков	FSelector	Petal.Width и Petal.Length — ключевые для iris
Дискретизация	arules::discretize()	Проверены 4 метода на iris
Выбор признаков	Boruta	Автоматический отбор на данных Ozone

Ключевые выводы:

1. featurePlot() из пакета caret — мощный инструмент быстрой визуальной диагностики, позволяющий оценить разделимость классов и характер распределений.

2. FSelector предоставляет несколько взаимодополняющих критериев важности признаков (Information Gain, Gain Ratio, Chi-Squared), что позволяет получить более устойчивую оценку.

3. Выбор метода дискретизации существенно влияет на результат: метод frequency предпочтителен для равномерного заполнения категорий, cluster — для выявления естественной структуры, fixed — при наличии экспертных знаний.

4. Алгоритм Boruta является robust-методом выбора признаков: он устойчив к мультиколлинеарности и автоматически определяет порог значимости через сравнение с теневыми признаками.

---

Работа выполнена в R 4.6.0