Лабораторная работа: Разведочный анализ и отбор признаков (caret, FSelector, arules, Boruta)
1 Введение
В работе выполняются четыре задания: 1) Разведочный анализ данных и
обзор моделей пакета caret;
2) Оценка важности признаков для iris с помощью
FSelector;
3) Дискретизация непрерывных переменных с помощью
arules::discretize();
4) Полный отбор признаков методом Boruta на наборе
Ozone из mlbench.
Каждый раздел содержит воспроизводимый R‑код и сохраняет графики в
формате .jpg (папка figures/).
2 caret: обзор моделей и featurePlot()
# Установка (при необходимости) и загрузка пакетов
pkgs <- c("caret", "lattice")
needs <- pkgs[!pkgs %in% installed.packages()[, "Package"]]
if (length(needs)) install.packages(needs, dependencies = TRUE)
library(caret)
library(lattice)2.1 Список доступных моделей/методов в caret
mods <- names(getModelInfo())
length(mods)## [1] 239head(mods, 30)## [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"Выше показано количество и первые 30 доступных моделей (методов). Полный список доступен в объекте
mods.
2.2 Разведочный анализ с featurePlot()
Создадим искусственные данные, как в задании:
set.seed(123)
x <- matrix(rnorm(50 * 5), ncol = 5)
colnames(x) <- paste0("Feature", 1:5)
x_df <- as.data.frame(x)
y <- factor(rep(c("A", "B"), 25))
str(x_df); table(y)## 'data.frame': 50 obs. of 5 variables:
## $ Feature1: num -0.5605 -0.2302 1.5587 0.0705 0.1293 ...
## $ Feature2: num 0.2533 -0.0285 -0.0429 1.3686 -0.2258 ...
## $ Feature3: num -0.71 0.257 -0.247 -0.348 -0.952 ...
## $ Feature4: num 0.788 0.769 0.332 -1.008 -0.119 ...
## $ Feature5: num 2.199 1.312 -0.265 0.543 -0.414 ...## y
## A B
## 25 252.2.1 Boxplots по признакам
# Сохранение в JPG
jpeg(file.path("figures", "caret_boxplots.jpg"), width = 1200, height = 800, quality = 95)
print(featurePlot(x = x_df, y = y, plot = "box"))
dev.off()## png
## 2# Отрисовка в HTML для отчёта
featurePlot(x = x_df, y = y, plot = "box")
Boxplots по признакам для классов A/B (caret::featurePlot)
2.2.2 Scatter matrix (pairs)
jpeg(file.path("figures", "caret_pairs.jpg"), width = 1200, height = 1200, quality = 95)
print(featurePlot(x = x_df, y = y, plot = "pairs"))
dev.off()## png
## 2featurePlot(x = x_df, y = y, plot = "pairs")
Scatter matrix (pairs) (caret::featurePlot)
2.2.3 Плотности распределений
jpeg(file.path("figures", "caret_density.jpg"), width = 1200, height = 800, quality = 95)
print(featurePlot(x = x_df, y = y, plot = "density",
scales = list(x = list(relation = "free"),
y = list(relation = "free"))))
dev.off()## png
## 2featurePlot(x = x_df, y = y, plot = "density",
scales = list(x = list(relation = "free"),
y = list(relation = "free")))
Плотности распределений по классам (caret::featurePlot)
Вывод по разделу 1.
На случайно сгенерированных данных различия между классами не выражены,
что ожидаемо. Тем не менее, featurePlot() удобно
подсвечивает потенциально информативные признаки и взаимодействия, что
применимо к реальным наборам данных.
3 FSelector: важность признаков для iris
pkgs <- c("FSelector")
needs <- pkgs[!pkgs %in% installed.packages()[, "Package"]]
if (length(needs)) install.packages(needs, dependencies = TRUE)
library(FSelector)
data(iris)3.1 Information Gain / Gain Ratio / Symmetrical Uncertainty
weights_ig <- information.gain(Species ~ ., iris)
weights_gr <- gain.ratio(Species ~ ., iris)
weights_su <- symmetrical.uncertainty(Species ~ ., iris)
weights_igweights_grweights_su3.1.1 Визуализация важности (Information Gain)
par(mar = c(6, 4, 2, 1))
jpeg(file.path("figures", "iris_importance_IG.jpg"), width = 1000, height = 600, quality = 95)
par(mar = c(6, 4, 2, 1))
barplot(weights_ig$attr_importance,
names.arg = rownames(weights_ig), las = 2,
ylab = "Важность", main = "Information Gain (iris)")
dev.off()## png
## 2barplot(weights_ig$attr_importance,
names.arg = rownames(weights_ig), las = 2,
ylab = "Важность", main = "Information Gain (iris)")
Важность признаков для iris (Information Gain)
Вывод по разделу 2.
Наиболее информативны для классификации видов ириса
Petal.Length и Petal.Width; менее
значимы Sepal.Length и Sepal.Width.
Это совпадает с визуальным анализом классического набора данных.
4 arules::discretize(): интервал, частота, кластеры, фиксированные границы
pkgs <- c("arules")
needs <- pkgs[!pkgs %in% installed.packages()[, "Package"]]
if (length(needs)) install.packages(needs, dependencies = TRUE)
library(arules)Для примера дискретизируем Sepal.Length четырьмя
методами:
sl <- iris$Sepal.Length
iris$SL_interval <- discretize(sl, method = "interval", categories = 3)
iris$SL_frequency <- discretize(sl, method = "frequency", categories = 3)
iris$SL_cluster <- discretize(sl, method = "cluster", categories = 3)
iris$SL_fixed <- discretize(sl, method = "fixed", breaks = c(4, 5, 6, 8))
lapply(iris[, c("SL_interval","SL_frequency","SL_cluster","SL_fixed")], table)## $SL_interval
##
## [4.3,5.5) [5.5,6.7) [6.7,7.9]
## 52 70 28
##
## $SL_frequency
##
## [4.3,5.4) [5.4,6.3) [6.3,7.9]
## 46 53 51
##
## $SL_cluster
##
## [4.3,5.33) [5.33,6.27) [6.27,7.9]
## 46 53 51
##
## $SL_fixed
##
## [4,5) [5,6) [6,8]
## 22 61 674.0.1 Визуальное сравнение разметки (цветом категории)
jpeg(file.path("figures", "discretize_comparison.jpg"), width = 1200, height = 1000, quality = 95)
par(mfrow = c(2,2), mar = c(4,4,2,1))
plot(sl, col = as.numeric(iris$SL_interval), main = "interval (равная ширина)")
plot(sl, col = as.numeric(iris$SL_frequency), main = "frequency (равная частота)")
plot(sl, col = as.numeric(iris$SL_cluster), main = "cluster (k-means)")
plot(sl, col = as.numeric(iris$SL_fixed), main = "fixed (заданные границы)")
dev.off()## png
## 2par(mfrow = c(2,2), mar = c(4,4,2,1))
plot(sl, col = as.numeric(iris$SL_interval), main = "interval (равная ширина)")
plot(sl, col = as.numeric(iris$SL_frequency), main = "frequency (равная частота)")
plot(sl, col = as.numeric(iris$SL_cluster), main = "cluster (k-means)")
plot(sl, col = as.numeric(iris$SL_fixed), main = "fixed (заданные границы)")
Сравнение дискретизаций для Sepal.Length
par(mfrow = c(1,1))Вывод по разделу 3.
- interval — равные по ширине бины, не учитывает плотность
распределения;
- frequency — сбалансированные по числу объектов категории
(квантили), но ширина интервалов разная;
- cluster — отражает естественные группы значений;
- fixed — ручной контроль границ, полезно при экспертных
порогах.
5 Boruta: полный отбор признаков для Ozone
pkgs <- c("Boruta", "mlbench")
needs <- pkgs[!pkgs %in% installed.packages()[, "Package"]]
if (length(needs)) install.packages(needs, dependencies = TRUE)
library(Boruta)
library(mlbench)
data("Ozone")5.1 Предобработка и запуск Boruta
# Удалим пропуски
Ozone <- na.omit(Ozone)
# Посмотрим структуру
str(Ozone); summary(Ozone)## 'data.frame': 203 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",..: 5 6 7 8 9 12 13 14 15 16 ...
## $ V3 : Factor w/ 7 levels "1","2","3","4",..: 1 2 3 4 5 1 2 3 4 5 ...
## $ V4 : num 5 6 4 4 6 6 5 4 4 7 ...
## $ V5 : num 5760 5720 5790 5790 5700 5720 5760 5780 5830 5870 ...
## $ V6 : num 3 4 6 3 3 3 6 6 3 2 ...
## $ V7 : num 51 69 19 25 73 44 33 19 19 19 ...
## $ V8 : num 54 35 45 55 41 51 51 54 58 61 ...
## $ V9 : num 45.3 49.6 46.4 52.7 48 ...
## $ V10: num 1450 1568 2631 554 2083 ...
## $ V11: num 25 15 -33 -28 23 9 -44 -44 -53 -67 ...
## $ V12: num 57 53.8 54.1 64.8 52.5 ...
## $ V13: num 60 60 100 250 120 150 40 200 250 200 ...
## - attr(*, "na.action")= 'omit' Named int [1:163] 1 2 3 4 10 11 17 18 20 24 ...
## ..- attr(*, "names")= chr [1:163] "1" "2" "3" "4" ...## V1 V2 V3 V4 V5
## 3 :21 9 : 9 1:37 Min. : 1.00 Min. :5320
## 4 :21 12 : 9 2:45 1st Qu.: 5.00 1st Qu.:5690
## 12 :21 13 : 8 3:43 Median : 9.00 Median :5760
## 10 :18 14 : 8 4:36 Mean :11.37 Mean :5746
## 1 :17 15 : 8 5:42 3rd Qu.:16.00 3rd Qu.:5830
## 2 :17 22 : 8 6: 0 Max. :38.00 Max. :5950
## (Other):88 (Other):153 7: 0
## V6 V7 V8 V9
## Min. : 0.000 Min. :19.00 Min. :25.00 Min. :27.68
## 1st Qu.: 3.000 1st Qu.:46.00 1st Qu.:51.50 1st Qu.:49.64
## Median : 5.000 Median :64.00 Median :61.00 Median :56.48
## Mean : 4.867 Mean :57.61 Mean :61.11 Mean :56.54
## 3rd Qu.: 6.000 3rd Qu.:73.00 3rd Qu.:71.00 3rd Qu.:66.20
## Max. :11.000 Max. :93.00 Max. :93.00 Max. :82.58
##
## V10 V11 V12 V13
## Min. : 111 Min. :-69.00 Min. :27.50 Min. : 0.0
## 1st Qu.: 869 1st Qu.:-14.00 1st Qu.:51.26 1st Qu.: 60.0
## Median :2083 Median : 18.00 Median :60.98 Median :100.0
## Mean :2602 Mean : 14.43 Mean :60.69 Mean :122.2
## 3rd Qu.:5000 3rd Qu.: 43.00 3rd Qu.:70.88 3rd Qu.:150.0
## Max. :5000 Max. :107.00 Max. :90.68 Max. :350.0
## # В наборе mlbench::Ozone целевая переменная — V4 (концентрация озона)
set.seed(123)
boruta_result <- Boruta(V4 ~ ., data = Ozone, doTrace = 1)
final_boruta <- TentativeRoughFix(boruta_result)
final_boruta## Boruta performed 24 iterations in 1.159024 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;5.2 Boxplot важности признаков (Boruta)
jpeg(file.path("figures", "boruta_boxplot.jpg"), width = 1200, height = 800, quality = 95)
plot(final_boruta, las = 2, xlab = "", main = "Важность признаков (Boruta) — Ozone")
dev.off()## png
## 2plot(final_boruta, las = 2, xlab = "", main = "Важность признаков (Boruta) — Ozone")
Boruta: важность признаков для Ozone
5.3 Ключевые признаки
getSelectedAttributes(final_boruta, withTentative = FALSE)## [1] "V1" "V5" "V7" "V8" "V9" "V10" "V11" "V12" "V13"Вывод по разделу 4.
Алгоритм Boruta (на базе случайного леса) сравнивает
важности реальных признаков с «теневыми». Признаки, превосходящие тени
статистически значимо — Confirmed; слабые —
Rejected. Для Ozone значимыми оказываются
небольшое подмножество переменных (конкретный результат зависит от
итераций, но воспроизводим при фиксированном set.seed).