Лабораторная работа № 2. Работа с пакетами CARET и BORUTA на языке R
Соколюк С. В., группа 233-331
17.10.2026
1. Пакет caret: список моделей и графический разведочный анализ
library(caret)
models <- names(getModelInfo())
length(models)## [1] 239head(models, 40)## [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"Методы выбора признаков в caret реализованы функциями
rfe() (рекурсивное исключение признаков),
sbf() (одномерный отбор, selection by filtering),
gafs() (генетический алгоритм) и safs()
(имитация отжига). Кроме того, у многих моделей есть встроенная оценка
важности признаков (varImp()). Модели, в метках которых
упоминается выбор признаков:
info <- getModelInfo()
fs <- sapply(info, function(m) any(grepl("Feature Selection|Implicit Feature", m$tags)))
names(info)[fs]## [1] "ada" "AdaBag" "AdaBoost.M1" "adaboost"
## [5] "bagEarth" "bagEarthGCV" "bagFDA" "bagFDAGCV"
## [9] "bartMachine" "blasso" "BstLm" "bstSm"
## [13] "C5.0" "C5.0Cost" "C5.0Rules" "C5.0Tree"
## [17] "cforest" "chaid" "ctree" "ctree2"
## [21] "cubist" "deepboost" "earth" "enet"
## [25] "evtree" "extraTrees" "fda" "foba"
## [29] "gamboost" "gbm_h2o" "gbm" "gcvEarth"
## [33] "glmnet_h2o" "glmnet" "glmStepAIC" "J48"
## [37] "JRip" "lars" "lars2" "lasso"
## [41] "leapBackward" "leapForward" "leapSeq" "lmStepAIC"
## [45] "LMT" "LogitBoost" "M5" "M5Rules"
## [49] "msaenet" "nodeHarvest" "OneR" "ordinalNet"
## [53] "ordinalRF" "ORFlog" "ORFpls" "ORFridge"
## [57] "ORFsvm" "pam" "parRF" "PART"
## [61] "penalized" "PenalizedLDA" "qrf" "ranger"
## [65] "Rborist" "relaxo" "rf" "rFerns"
## [69] "rfRules" "rotationForest" "rotationForestCp" "rpart"
## [73] "rpart1SE" "rpart2" "rpartCost" "rpartScore"
## [77] "rqlasso" "rqnc" "RRF" "RRFglobal"
## [81] "sdwd" "smda" "sparseLDA" "spikeslab"
## [85] "stepLDA" "stepQDA" "wsrf" "xgbDART"
## [89] "xgbLinear" "xgbTree"Данные из справочного файла функции featurePlot():
set.seed(2026)
x <- matrix(rnorm(50 * 5), ncol = 5)
y <- factor(rep(c("A", "B"), 25))
colnames(x) <- paste0("X", 1:5)
summary(x)## X1 X2 X3 X4
## Min. :-2.54688 Min. :-1.9585 Min. :-1.7388 Min. :-1.8588
## 1st Qu.:-0.71448 1st Qu.:-0.9731 1st Qu.:-0.6693 1st Qu.:-0.5812
## Median : 0.05318 Median :-0.2460 Median : 0.2343 Median : 0.1027
## Mean :-0.01627 Mean :-0.1798 Mean : 0.1264 Mean : 0.1166
## 3rd Qu.: 0.61068 3rd Qu.: 0.4479 3rd Qu.: 0.8299 3rd Qu.: 0.6114
## Max. : 1.90808 Max. : 2.4144 Max. : 2.6387 Max. : 2.1805
## X5
## Min. :-2.53523
## 1st Qu.:-0.51553
## Median : 0.09044
## Mean : 0.10325
## 3rd Qu.: 0.72517
## Max. : 2.16165table(y)## y
## A B
## 25 25types <- c("pairs", "ellipse", "density", "box", "strip")
for (tp in types) {
args <- list(x = x, y = y, plot = tp, auto.key = list(columns = 2),
main = paste0("featurePlot, plot = \"", tp, "\""))
if (tp %in% c("density", "box", "strip"))
args$scales <- list(x = list(relation = "free"), y = list(relation = "free"))
p <- do.call(featurePlot, args)
print(p)
jpeg(paste0("featurePlot_", tp, ".jpg"), width = 900, height = 700, quality = 95)
print(p)
dev.off()
}
list.files(pattern = "\\.jpg$")## [1] "featurePlot_box.jpg" "featurePlot_density.jpg"
## [3] "featurePlot_ellipse.jpg" "featurePlot_pairs.jpg"
## [5] "featurePlot_strip.jpg"# средние и p-значения t-теста по каждому признаку для двух классов
sapply(as.data.frame(x), function(v) c(mean_A = mean(v[y == "A"]), mean_B = mean(v[y == "B"]),
p_value = t.test(v ~ y)$p.value))## X1 X2 X3 X4 X5
## mean_A -0.1761587 -0.48520428 0.1169766 0.1224162 -0.07499316
## mean_B 0.1436219 0.12555791 0.1358479 0.1107636 0.28148635
## p_value 0.2508621 0.03515359 0.9505285 0.9622096 0.20060046Выводы. В caret доступно 239 моделей. Для выбора
признаков служат обёртки rfe(), sbf(),
gafs(), safs(), а многие модели (деревья,
бустинг, lasso/glmnet, MARS и др.) выполняют неявный отбор признаков,
что видно по их меткам. Графики featurePlot() сохранены в
пять файлов *.jpg. На всех графиках (матрица рассеяния, эллипсы,
плотности, boxplot, strip) классы A и B практически полностью
перекрываются: эллипсы совпадают, кривые плотности почти одинаковы,
медианы на boxplot близки. Это ожидаемо, потому что x – независимый
нормальный шум, никак не связанный с меткой y. Небольшое различие
средних по X2 (p = 0,035) случайно: при пяти проверках на уровне 0,05
одно ложное «значимое» различие вполне вероятно. Разведочный анализ
показывает, что ни один признак не разделяет классы.
2. Пакет FSelector: важность признаков для набора iris
library(FSelector)
data(iris)
w_ig <- information.gain(Species ~ ., iris)
w_gr <- gain.ratio(Species ~ ., iris)
w_su <- symmetrical.uncertainty(Species ~ ., iris)
w_chi <- chi.squared(Species ~ ., iris)
w_one <- oneR(Species ~ ., iris)
set.seed(2026)
w_rf <- random.forest.importance(Species ~ ., iris, importance.type = 1)
weights <- data.frame(information.gain = w_ig$attr_importance,
gain.ratio = w_gr$attr_importance,
symmetrical.uncertainty = w_su$attr_importance,
chi.squared = w_chi$attr_importance,
oneR = w_one$attr_importance,
random.forest = w_rf$attr_importance,
row.names = rownames(w_ig))
round(weights, 3)## information.gain gain.ratio symmetrical.uncertainty chi.squared
## Sepal.Length 0.452 0.420 0.416 0.629
## Sepal.Width 0.267 0.247 0.245 0.492
## Petal.Length 0.940 0.858 0.857 0.935
## Petal.Width 0.955 0.871 0.871 0.943
## oneR random.forest
## Sepal.Length 0.173 14.984
## Sepal.Width 0.040 7.955
## Petal.Length 0.400 48.026
## Petal.Width 0.407 46.975cutoff.k(w_ig, 2)## [1] "Petal.Width" "Petal.Length"f <- as.simple.formula(cutoff.k(w_ig, 2), "Species")
f## Species ~ Petal.Width + Petal.Length
## <environment: 0x000002363b448738>subset_cfs <- cfs(Species ~ ., iris)
subset_cfs## [1] "Petal.Length" "Petal.Width"op <- par(mar = c(5, 9, 3, 1))
barplot(sort(setNames(w_ig$attr_importance, rownames(w_ig))), horiz = TRUE, las = 1,
col = "steelblue", main = "Information gain признаков iris", xlab = "information gain")
par(op)Выводы. Все критерии FSelector дают одинаковый
порядок важности: Petal.Width и Petal.Length (information gain 0,955 и
0,940) намного важнее, чем Sepal.Length (0,452) и особенно Sepal.Width
(0,267). Важность по случайному лесу у лепестковых признаков (около
47–48) тоже в 3–6 раз выше, чем у чашелистиков. Функция
cutoff.k() оставляет два лучших признака, по ним построена
формула Species ~ Petal.Width + Petal.Length; метод CFS
(корреляционный отбор подмножества) выбирает те же два признака. Значит,
для классификации ирисов достаточно размеров лепестка, признаки
чашелистика добавляют мало информации.
3. Пакет arules: дискретизация непрерывной переменной
Дискретизируем длину лепестка Petal.Length набора iris
на 3 категории четырьмя способами.
library(arules)
x3 <- iris$Petal.Length
d_int <- discretize(x3, method = "interval", breaks = 3)
d_freq <- discretize(x3, method = "frequency", breaks = 3)
set.seed(2026)
d_clus <- discretize(x3, method = "cluster", breaks = 3)
d_fix <- discretize(x3, method = "fixed", breaks = c(-Inf, 2, 5, Inf),
labels = c("small", "medium", "large"))
table(d_int)## d_int
## [1,2.97) [2.97,4.93) [4.93,6.9]
## 50 54 46table(d_freq)## d_freq
## [1,2.63) [2.63,4.9) [4.9,6.9]
## 50 49 51table(d_clus)## d_clus
## [1,2.85) [2.85,4.89) [4.89,6.9]
## 50 49 51table(d_fix)## d_fix
## small medium large
## 50 54 46par(mfrow = c(2, 2))
show_cuts <- function(cuts, main) {
hist(x3, breaks = 30, col = "grey85", main = main, xlab = "Petal.Length")
abline(v = cuts, col = "red", lwd = 2)
}
show_cuts(discretize(x3, "interval", breaks = 3, onlycuts = TRUE), "interval (равная ширина)")
show_cuts(discretize(x3, "frequency", breaks = 3, onlycuts = TRUE), "frequency (равная частота)")
set.seed(2026)
show_cuts(discretize(x3, "cluster", breaks = 3, onlycuts = TRUE), "cluster (k-means)")
show_cuts(c(2, 5), "fixed (границы 2 и 5)")
par(mfrow = c(1, 1))# насколько категории совпадают с видами ирисов
table(interval = d_int, Species = iris$Species)## Species
## interval setosa versicolor virginica
## [1,2.97) 50 0 0
## [2.97,4.93) 0 48 6
## [4.93,6.9] 0 2 44table(frequency = d_freq, Species = iris$Species)## Species
## frequency setosa versicolor virginica
## [1,2.63) 50 0 0
## [2.63,4.9) 0 46 3
## [4.9,6.9] 0 4 47table(cluster = d_clus, Species = iris$Species)## Species
## cluster setosa versicolor virginica
## [1,2.85) 50 0 0
## [2.85,4.89) 0 46 3
## [4.89,6.9] 0 4 47table(fixed = d_fix, Species = iris$Species)## Species
## fixed setosa versicolor virginica
## small 50 0 0
## medium 0 48 6
## large 0 2 44Выводы. Методы дают разные границы. «interval» делит диапазон 1–6,9 на три равных отрезка (границы 2,97 и 4,93), размеры групп 50/54/46. «frequency» подбирает границы 2,63 и 4,9 так, чтобы группы были почти равны (50/49/51). «cluster» (k-means) ставит границы 2,85 и 4,89 – в местах естественных разрывов распределения. «fixed» использует заданные вручную границы 2 и 5 и метки small/medium/large. Все методы полностью отделяют setosa (короткие лепестки); между versicolor и virginica ошибок 8 у «interval» и «fixed» и 7 у «frequency» и «cluster». Для этих данных лучше всего подходит кластерный метод: он сам находит естественные границы и не требует знаний о предметной области, как «fixed».
4. Пакет Boruta: выбор признаков для набора Ozone
library(Boruta)
library(mlbench)
data("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 ...ozo <- na.omit(Ozone)
dim(ozo)## [1] 203 13Целевая переменная V4 – суточный максимум концентрации озона, остальные 12 переменных – дата и метеоусловия.
set.seed(2026)
bor <- Boruta(V4 ~ ., data = ozo, doTrace = 0, maxRuns = 200)
print(bor)## Boruta performed 18 iterations in 0.251807 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;attStats(bor)## meanImp medianImp minImp maxImp normHits decision
## V1 0.41337539 0.416004165 0.36060255 0.470450131 1.0000000 Confirmed
## V2 0.03219496 0.040810466 -0.05875336 0.087046950 0.1111111 Rejected
## V3 -0.04665987 -0.061703721 -0.09973038 0.008714154 0.0000000 Rejected
## V5 0.38597412 0.382870890 0.33205323 0.461353299 1.0000000 Confirmed
## V6 0.02058259 0.008694503 -0.04209242 0.120562317 0.0000000 Rejected
## V7 0.52198740 0.530254014 0.44189037 0.582055898 1.0000000 Confirmed
## V8 0.77954594 0.785294292 0.71113219 0.823817007 1.0000000 Confirmed
## V9 0.87277542 0.878108663 0.81552488 0.911687816 1.0000000 Confirmed
## V10 0.44083218 0.435506462 0.40015006 0.492082055 1.0000000 Confirmed
## V11 0.54475545 0.555525210 0.46111126 0.629740545 1.0000000 Confirmed
## V12 0.65540911 0.657749782 0.60911228 0.718395547 1.0000000 Confirmed
## V13 0.40269911 0.399089240 0.35516470 0.470107317 1.0000000 Confirmedpar(mar = c(8, 4, 3, 1))
plot(bor, las = 2, xlab = "", cex.axis = 0.9, main = "Boruta: важность признаков набора Ozone")
bor_fix <- TentativeRoughFix(bor)
print(bor_fix)## Boruta performed 18 iterations in 0.251807 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;getSelectedAttributes(bor_fix)## [1] "V1" "V5" "V7" "V8" "V9" "V10" "V11" "V12" "V13"getConfirmedFormula(bor_fix)## V4 ~ V1 + V5 + V7 + V8 + V9 + V10 + V11 + V12 + V13
## <environment: 0x0000023633a8cd28>plotImpHistory(bor, main = "История важности признаков по итерациям")
Выводы. В наборе Ozone 366 наблюдений, после
удаления пропусков осталось 203. Boruta за 18 итераций принял решение по
всем 12 признакам: 9 подтверждены как важные (V1 – месяц, V5 – высота
изобарической поверхности 500 мбар, V7 – влажность, V8 и V9 –
температура в Сандбурге и Эль-Монте, V10 – высота и V12 – температура
инверсионного слоя, V11 – градиент давления, V13 – видимость), 3
отклонены (V2 – день месяца, V3 – день недели, V6 – скорость ветра). На
boxplot зелёным показаны подтверждённые признаки, красным – отклонённые,
синим – «теневые» признаки (перемешанные копии): отклонённые признаки не
превосходят по важности shadowMax. Самые важные – температуры V9 и V8 и
температура инверсии V12, то есть концентрация озона определяется в
первую очередь нагревом воздуха. Признаков со статусом Tentative нет,
поэтому TentativeRoughFix() результат не меняет.
5. Итоги
В работе использованы четыре подхода к анализу и отбору признаков в
R: графический разведочный анализ (caret::featurePlot),
фильтры на основе теории информации и статистических критериев
(FSelector), дискретизация непрерывных переменных (arules) и обёрточный
метод на основе случайного леса (Boruta). Фильтры FSelector быстро
ранжируют признаки, Boruta надёжнее, так как сравнивает каждый признак
со случайными «теневыми» копиями, а графики featurePlot помогают ещё до
моделирования увидеть, разделяют ли признаки классы.
sessionInfo()## R version 4.6.1 (2026-06-24 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26300)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=Russian_Russia.utf8 LC_CTYPE=Russian_Russia.utf8
## [3] LC_MONETARY=Russian_Russia.utf8 LC_NUMERIC=C
## [5] LC_TIME=Russian_Russia.utf8
##
## time zone: Europe/Moscow
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] mlbench_2.1-11 Boruta_10.0.0 arules_1.7.15 Matrix_1.7-5 FSelector_0.34
## [6] caret_7.0-1 lattice_0.22-9 ggplot2_4.0.3
##
## loaded via a namespace (and not attached):
## [1] ellipse_0.5.0 gtable_0.3.6 xfun_0.61
## [4] bslib_0.12.0 recipes_1.4.0 rJava_1.0-18
## [7] vctrs_0.7.3 tools_4.6.1 generics_0.1.4
## [10] stats4_4.6.1 parallel_4.6.1 fru_1.0.0
## [13] tibble_3.3.1 pkgconfig_2.0.3 ModelMetrics_1.2.2.2
## [16] data.table_1.18.6.1 RColorBrewer_1.1-3 S7_0.2.2
## [19] lifecycle_1.0.5 compiler_4.6.1 farver_2.1.2
## [22] stringr_1.6.0 codetools_0.2-20 htmltools_0.5.9
## [25] class_7.3-23 sass_0.4.10 yaml_2.3.12
## [28] prodlim_2026.03.11 pillar_1.11.1 jquerylib_0.1.4
## [31] MASS_7.3-65 entropy_1.3.2 cachem_1.1.0
## [34] gower_1.0.2 iterators_1.0.14 rpart_4.1.27
## [37] foreach_1.5.2 nlme_3.1-169 parallelly_1.48.0
## [40] lava_1.9.3 tidyselect_1.2.1 digest_0.6.39
## [43] stringi_1.8.9 future_1.80.0 dplyr_1.2.1
## [46] reshape2_1.4.5 purrr_1.2.2 listenv_1.1.0
## [49] RWekajars_3.9.3-2 splines_4.6.1 fastmap_1.2.0
## [52] grid_4.6.1 cli_3.6.6 magrittr_2.0.5
## [55] randomForest_4.7-1.2 survival_3.8-6 future.apply_1.21.0
## [58] withr_3.0.3 scales_1.4.0 lubridate_1.9.5
## [61] timechange_0.4.0 rmarkdown_2.32 globals_0.20.0
## [64] otel_0.2.0 nnet_7.3-20 RWeka_0.4-50
## [67] timeDate_4052.112 evaluate_1.0.5 knitr_1.52
## [70] hardhat_1.4.3 rlang_1.3.0 Rcpp_1.1.2
## [73] glue_1.8.1 pROC_1.19.1 ipred_0.9-16
## [76] jsonlite_2.0.0 R6_2.6.1 plyr_1.8.9