Лабораторная работа №2. CARET и BORUTA
Попов Вадим Юрьевич
1. Пакет caret: список моделей и featurePlot()
library(caret)
model_list <- names(getModelInfo())
length(model_list)## [1] 239head(model_list, 25)## [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"Команда names(getModelInfo()) выводит перечень
моделей/методов, доступных в пакете caret (используется для
выбора подходящего алгоритма при построении модели).
1.1 Данные из задания
set.seed(2026)
x <- matrix(rnorm(50*5), ncol = 5)
y <- factor(rep(c("A","B"), 25))
colnames(x) <- paste0("X", 1:5)1.2 Графический разведочный анализ + сохранение в JPG
Boxplot
jpeg("plots/feat_boxplot.jpg", width=1600, height=1100, res=200)
featurePlot(x = x, y = y, plot = "box")
dev.off()## quartz_off_screen
## 2Density
jpeg("plots/feat_density.jpg", width=1600, height=1100, res=200)
featurePlot(x = x, y = y, plot = "density")
dev.off()## quartz_off_screen
## 2Stripplot (альтернатива pairs для наглядности распределений)
jpeg("plots/feat_stripplot.jpg", width=1600, height=1100, res=200)
featurePlot(x = x, y = y, plot = "strip")
dev.off()## quartz_off_screen
## 2
Вывод по пункту 1:
Так как данные x сгенерированы случайно из нормального
распределения, классы A и B по большинству признаков сильно
перекрываются. Явных признаков, уверенно разделяющих классы, не
наблюдается, следовательно информативность признаков в данном
синтетическом примере невысока.
2. FSelector: важность признаков (iris)
library(FSelector)
data(iris)
ig <- information.gain(Species ~ ., iris)
ig[order(-ig$attr_importance), , drop=FALSE]## attr_importance
## Petal.Width 0.9554360
## Petal.Length 0.9402853
## Sepal.Length 0.4521286
## Sepal.Width 0.2672750Дополнительно оценим важность через критерий хи-квадрат (для сравнения):
chi <- chi.squared(Species ~ ., iris)
chi[order(-chi$attr_importance), , drop=FALSE]## attr_importance
## Petal.Width 0.9432359
## Petal.Length 0.9346311
## Sepal.Length 0.6288067
## Sepal.Width 0.4922162Вывод по пункту 2:
По критериям Information Gain и Chi-squared наиболее значимыми обычно
оказываются признаки, связанные с лепестками (Petal.Length,
Petal.Width). Признаки чашелистиков
(Sepal.Length, Sepal.Width) чаще имеют меньшую
дискриминирующую способность для классов Species.
3. arules: discretize() (iris) разными методами
Будем дискретизировать непрерывную переменную
Sepal.Length.
library(arules)
x_cont <- iris$Sepal.Length
summary(x_cont)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.300 5.100 5.800 5.843 6.400 7.9003.1 interval (равная ширина)
d_interval <- discretize(x_cont, method = "interval", categories = 4)
table(d_interval)## d_interval
## [4.3,5.2) [5.2,6.1) [6.1,7) [7,7.9]
## 41 48 48 133.2 frequency (равная частота)
d_frequency <- discretize(x_cont, method = "frequency", categories = 4)
table(d_frequency)## d_frequency
## [4.3,5.1) [5.1,5.8) [5.8,6.4) [6.4,7.9]
## 32 41 35 423.3 cluster (кластеризация)
d_cluster <- discretize(x_cont, method = "cluster", categories = 4)
table(d_cluster)## d_cluster
## [4.3,5.32) [5.32,6.12) [6.12,6.98) [6.98,7.9]
## 46 49 42 133.4 fixed (границы интервалов заданы вручную)
d_fixed <- discretize(
x_cont,
method = "fixed",
breaks = c(-Inf, 5.0, 5.8, 6.4, Inf),
labels = c("low", "mid", "high", "very_high")
)
table(d_fixed)## d_fixed
## low mid high very_high
## 22 51 35 42Вывод по пункту 3:
- interval делит диапазон значений на интервалы одинаковой
ширины, но частоты по интервалам могут быть разными.
- frequency подбирает границы так, чтобы наблюдений в
интервалах было примерно поровну.
- cluster пытается учесть естественные группы
значений.
- fixed удобен, когда границы категорий задаются заранее
(например, экспертно).
4. Boruta: отбор признаков для data(“Ozone”)
library(mlbench)
library(Boruta)
data("Ozone")
oz <- na.omit(Ozone)
target <- names(oz)[ncol(oz)] # целевая переменная (последний столбец)
form <- as.formula(paste(target, "~ ."))
set.seed(2026)
bor <- Boruta(form, data = oz, doTrace = 0)
bor## Boruta performed 27 iterations in 2.331683 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V4 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;Посмотрим статистику по признакам:
attStats(bor)## meanImp medianImp minImp maxImp normHits decision
## V1 5.2775380 5.3562616 3.3758047 7.980213 0.85185185 Confirmed
## V2 0.2256107 0.6324181 -1.6722327 1.905387 0.07407407 Rejected
## V3 0.1566567 0.1004094 -1.6240854 1.894214 0.00000000 Rejected
## V4 12.6246486 12.5378374 10.5943912 14.234946 1.00000000 Confirmed
## V5 4.4939882 4.2047618 3.3385958 6.447749 0.85185185 Confirmed
## V6 1.3086212 1.3942107 -0.4290155 2.934666 0.14814815 Rejected
## V7 14.5866033 14.5814827 12.9423295 17.056102 1.00000000 Confirmed
## V8 4.8552213 4.9689361 2.7701178 6.194147 0.88888889 Confirmed
## V9 9.0964090 8.8890933 6.9293343 11.856749 1.00000000 Confirmed
## V10 7.0490865 6.9027659 5.6868495 8.865126 1.00000000 Confirmed
## V11 4.3907640 4.5988741 2.3754724 6.578922 0.81481481 Confirmed
## V12 10.1494035 10.3155283 8.6200901 11.537526 1.00000000 Confirmed4.1 Boxplot + сохранение JPG
jpeg("plots/boruta_importance.jpg", width=1800, height=1200, res=200)
plot(bor, las = 2, cex.axis = 0.8)
dev.off()## quartz_off_screen
## 2
4.2 Итоговый набор признаков
getSelectedAttributes(bor, withTentative = TRUE)## [1] "V1" "V4" "V5" "V7" "V8" "V9" "V10" "V11" "V12"bor_fixed <- TentativeRoughFix(bor)
getSelectedAttributes(bor_fixed, withTentative = FALSE)## [1] "V1" "V4" "V5" "V7" "V8" "V9" "V10" "V11" "V12"Вывод по пункту 4:
Boruta сравнивает важность реальных признаков с “теневыми” (случайными)
признаками. Признаки, которые стабильно важнее теневых, попадают в
Confirmed и рекомендуются к использованию. Boxplot позволяет визуально
оценить, какие признаки наиболее значимы.