Лабораторная работа № 2
Выбор признаков и дискретизация данных в R
Сорока М.Р., группа 233-332
22 октября 2026 года
1 Цель и подготовка
Цель работы — выполнить разведочный анализ признаков, оценить их информативность для классификации, сравнить способы дискретизации и применить Boruta для отбора признаков в задаче регрессии.
Использованы искусственная выборка из задания, набор
iris и данные Ozone из пакета
mlbench. Генерация случайных данных и случайные алгоритмы
выполняются с фиксированными начальными состояниями генератора.
Команда установки необходимых пакетов:
install.packages(c('caret','ellipse','FSelector','arules','Boruta',
'mlbench','ranger','rmarkdown','knitr'),
repos='https://cloud.r-project.org')Для FSelector требуется 64-разрядная Java, для преобразования R Markdown в HTML — Pandoc. Все вычисления далее выполнены в R; версии пакетов приведены в конце работы.
2 CARET и графический разведочный анализ
2.1 Список моделей
## [1] 239## [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" "FIR.DM" "foba"
## [53] "FRBCS.CHI" "FRBCS.W" "FS.HGD" "gam"
## [57] "gamboost" "gamLoess" "gamSpline" "gaussprLinear"
## [61] "gaussprPoly" "gaussprRadial" "gbm_h2o" "gbm"
## [65] "gcvEarth" "GFS.FR.MOGUL" "GFS.LT.RS" "GFS.THRIFT"
## [69] "glm.nb" "glm" "glmboost" "glmnet_h2o"
## [73] "glmnet" "glmStepAIC" "gpls" "hda"
## [77] "hdda" "hdrda" "HYFIS" "icr"
## [81] "J48" "JRip" "kernelpls" "kknn"
## [85] "knn" "krlsPoly" "krlsRadial" "lars"
## [89] "lars2" "lasso" "lda" "lda2"
## [93] "leapBackward" "leapForward" "leapSeq" "Linda"
## [97] "lm" "lmStepAIC" "LMT" "loclda"
## [101] "logicBag" "LogitBoost" "logreg" "lssvmLinear"
## [105] "lssvmPoly" "lssvmRadial" "lvq" "M5"
## [109] "M5Rules" "manb" "mda" "Mlda"
## [113] "mlp" "mlpKerasDecay" "mlpKerasDecayCost" "mlpKerasDropout"
## [117] "mlpKerasDropoutCost" "mlpML" "mlpSGD" "mlpWeightDecay"
## [121] "mlpWeightDecayML" "monmlp" "msaenet" "multinom"
## [125] "mxnet" "mxnetAdam" "naive_bayes" "nb"
## [129] "nbDiscrete" "nbSearch" "neuralnet" "nnet"
## [133] "nnls" "nodeHarvest" "null" "OneR"
## [137] "ordinalNet" "ordinalRF" "ORFlog" "ORFpls"
## [141] "ORFridge" "ORFsvm" "ownn" "pam"
## [145] "parRF" "PART" "partDSA" "pcaNNet"
## [149] "pcr" "pda" "pda2" "penalized"
## [153] "PenalizedLDA" "plr" "pls" "plsRglm"
## [157] "polr" "ppr" "pre" "PRIM"
## [161] "protoclass" "qda" "QdaCov" "qrf"
## [165] "qrnn" "randomGLM" "ranger" "rbf"
## [169] "rbfDDA" "Rborist" "rda" "regLogistic"
## [173] "relaxo" "rf" "rFerns" "RFlda"
## [177] "rfRules" "ridge" "rlda" "rlm"
## [181] "rmda" "rocc" "rotationForest" "rotationForestCp"
## [185] "rpart" "rpart1SE" "rpart2" "rpartCost"
## [189] "rpartScore" "rqlasso" "rqnc" "RRF"
## [193] "RRFglobal" "rrlda" "RSimca" "rvmLinear"
## [197] "rvmPoly" "rvmRadial" "SBC" "sda"
## [201] "sdwd" "simpls" "SLAVE" "slda"
## [205] "smda" "snn" "sparseLDA" "spikeslab"
## [209] "spls" "stepLDA" "stepQDA" "superpc"
## [213] "svmBoundrangeString" "svmExpoString" "svmLinear" "svmLinear2"
## [217] "svmLinear3" "svmLinearWeights" "svmLinearWeights2" "svmPoly"
## [221] "svmRadial" "svmRadialCost" "svmRadialSigma" "svmRadialWeights"
## [225] "svmSpectrumString" "tan" "tanSearch" "treebag"
## [229] "vbmpRadial" "vglmAdjCat" "vglmContRatio" "vglmCumulative"
## [233] "widekernelpls" "WM" "wsrf" "xgbDART"
## [237] "xgbLinear" "xgbTree" "xyf"getModelInfo() содержит описания поддерживаемых моделей
машинного обучения. Полученный список не является отдельным
списком методов выбора признаков. Для отбора признаков в CARET
предусмотрены, например, рекурсивное исключение признаков
rfe, отбор по фильтрам sbf и оценка важности
varImp. В этом разделе использована требуемая функция
featurePlot() для разведочного анализа.
2.2 Формирование выборки
set.seed(233332)
x <- matrix(rnorm(50*5), ncol=5)
y <- factor(rep(c('A','B'),25))
colnames(x) <- paste0('X',1:5)
dim(x)## [1] 50 5## y
## A B
## 25 25## X1 X2 X3 X4 X5
## Min. :-2.33681 Min. :-2.2586 Min. :-1.8520 Min. :-1.83286 Min. :-1.8567
## 1st Qu.:-0.63214 1st Qu.:-0.8816 1st Qu.:-0.9007 1st Qu.:-0.68846 1st Qu.:-0.3613
## Median : 0.09398 Median : 0.1130 Median :-0.2494 Median :-0.06545 Median : 0.1450
## Mean : 0.05918 Mean :-0.1163 Mean :-0.2176 Mean :-0.02486 Mean : 0.1461
## 3rd Qu.: 0.81534 3rd Qu.: 0.5570 3rd Qu.: 0.3765 3rd Qu.: 0.75455 3rd Qu.: 0.7775
## Max. : 2.42273 Max. : 1.6827 Max. : 1.4769 Max. : 2.39491 Max. : 2.3676Матрица содержит 50 наблюдений и пять нормально распределённых признаков. В каждом классе по 25 наблюдений. Метки классов заданы независимо от генерации признаков: устойчивая закономерность классификации в данных не заложена.
2.3 Графики featurePlot
Построены все пять типов графиков, доступных для категориальной целевой переменной. Каждый график сохранён отдельно в формате JPG.
plot_types <- c('ellipse','strip','box','pairs','density')
feature_plots <- setNames(lapply(plot_types, function(type) {
if(type=='strip') {
featurePlot(x,y,plot=type,jitter=TRUE,
auto.key=list(columns=2),main='Synthetic data: strip')
} else {
featurePlot(x,y,plot=type,
auto.key=list(columns=2),main=paste('Synthetic data:',type))
}
}), plot_types)
for(type in plot_types) {
export_jpg(paste0('caret_',type), function() print(feature_plots[[type]]))
}
Вывод. Диаграммы рассеяния показывают перекрытие классов, диаграммы размаха и плотности позволяют сравнить распределения, а strip-график — отдельные наблюдения. На этой небольшой случайной выборке возможны различия медиан, плотностей и формы облаков точек, но они не доказывают устойчивую предсказательную связь. Выбирать признаки только по таким случайным различиям нельзя.
3 Оценка важности признаков с FSelector
3.1 Данные и методы
## [1] 150 5##
## setosa versicolor virginica
## 50 50 50ig <- information.gain(Species~., iris)
gr <- gain.ratio(Species~., iris)
su <- symmetrical.uncertainty(Species~., iris)
importance <- data.frame(
Feature=rownames(ig),
InformationGain=ig$attr_importance,
GainRatio=gr$attr_importance,
SymmetricalUncertainty=su$attr_importance,
row.names=NULL
)
importance <- importance[order(-importance$InformationGain),]
knitr::kable(importance,digits=6,
col.names=c('Признак','Information Gain','Gain Ratio',
'Symmetrical Uncertainty'))| Признак | Information Gain | Gain Ratio | Symmetrical Uncertainty | |
|---|---|---|---|---|
| 4 | Petal.Width | 0.955436 | 0.871369 | 0.870521 |
| 3 | Petal.Length | 0.940285 | 0.858494 | 0.857187 |
| 1 | Sepal.Length | 0.452129 | 0.419646 | 0.415556 |
| 2 | Sepal.Width | 0.267275 | 0.247297 | 0.245274 |
Использованы три фильтра на основе энтропии. Information Gain оценивает уменьшение неопределённости о классе, Gain Ratio нормирует информационный выигрыш по энтропии признака, Symmetrical Uncertainty использует симметричную нормировку. Численные шкалы методов различаются; сравнивать следует прежде всего порядок признаков внутри каждого метода. Для непрерывных признаков функции выполняют дискретизацию.
draw_importance <- function() {
par(mar=c(7,5,3,1))
barplot(t(as.matrix(importance[,-1])),beside=TRUE,
names.arg=importance$Feature,las=2,
col=c('#2878b5','#f28e2b','#59a14f'),
ylab='Score',main='FSelector: iris',
ylim=c(0,1.25))
legend('topright',legend=c('Information Gain','Gain Ratio','Symmetrical Uncertainty'),
fill=c('#2878b5','#f28e2b','#59a14f'),bty='n',cex=.85)
}
export_jpg('fselector',draw_importance)
selected_iris <- cutoff.k(ig,2)
selected_iris## [1] "Petal.Width" "Petal.Length"
Вывод. Все три критерия дают порядок: Petal.Width
> Petal.Length > Sepal.Length > Sepal.Width. Наиболее
информативны длина и ширина лепестка. В качестве примера отбора
cutoff.k(ig,2) оставляет Petal.Width, Petal.Length. Это
оценка зависимости признаков от класса на всей выборке, а не оценка
точности классификатора на новых данных. Для проверки качества модели
отбор необходимо повторять внутри обучающих подвыборок
кросс-валидации.
4 Дискретизация iris с arules
Для сравнения выбрана непрерывная переменная
Sepal.Length. Во всех четырёх вариантах используются три
категории. Методы не используют метки Species.
z <- iris$Sepal.Length
fixed_breaks <- c(4,5.5,6.5,8)
set.seed(233333)
discrete <- list(
interval=discretize(z,method='interval',breaks=3),
frequency=discretize(z,method='frequency',breaks=3),
cluster=discretize(z,method='cluster',breaks=3,nstart=25),
fixed=discretize(z,method='fixed',breaks=fixed_breaks)
)
stopifnot(all(vapply(discrete,length,integer(1))==nrow(iris)),
all(vapply(discrete,function(a)sum(is.na(a)),integer(1))==0))
disc_counts <- do.call(rbind,lapply(names(discrete),function(method) {
t <- table(discrete[[method]])
data.frame(Method=method,Category=names(t),Count=as.integer(t))
}))
knitr::kable(disc_counts,row.names=FALSE,
col.names=c('Метод','Категория','Число наблюдений'))| Метод | Категория | Число наблюдений |
|---|---|---|
| interval | [4.3,5.5) | 52 |
| interval | [5.5,6.7) | 70 |
| interval | [6.7,7.9] | 28 |
| frequency | [4.3,5.4) | 46 |
| frequency | [5.4,6.3) | 53 |
| frequency | [6.3,7.9] | 51 |
| cluster | [4.3,5.45) | 52 |
| cluster | [5.45,6.46) | 63 |
| cluster | [6.46,7.9] | 35 |
| fixed | [4,5.5) | 52 |
| fixed | [5.5,6.5) | 63 |
| fixed | [6.5,8] | 35 |
interval делит диапазон на равные по ширине части.
frequency использует квантильные границы и стремится
уравнять численности. cluster применяет одномерный k-means,
а границы располагает между центрами соседних кластеров. Для
fixed вручную заданы границы 4, 5.5, 6.5 и 8 см,
покрывающие весь наблюдаемый диапазон.
cut_points <- lapply(discrete,function(a) attr(a,'discretized:breaks'))
draw_discrete <- function() {
old <- par(mfrow=c(2,2),mar=c(5,4,3,1),oma=c(1,0,0,0));on.exit(par(old))
palette <- c('#2878b5','#f28e2b','#59a14f')
for(method in names(discrete)) {
counts <- table(discrete[[method]])
barplot(counts,col=palette,ylim=c(0,max(disc_counts$Count)+8),
main=method,xlab='Sepal.Length (cm)',ylab='Count',cex.names=.85)
}
}
export_jpg('discretization',draw_discrete)
head(data.frame(Sepal.Length=z,as.data.frame(discrete)))
Для сравнения категорий с известными видами ириса построены таблицы сопряжённости. Метки классов используются только после дискретизации для описания результата.
for(method in names(discrete)) {
cat('\nМетод:',method,'\n')
print(table(Category=discrete[[method]],Species=iris$Species))
}##
## Метод: interval
## Species
## Category setosa versicolor virginica
## [4.3,5.5) 45 6 1
## [5.5,6.7) 5 38 27
## [6.7,7.9] 0 6 22
##
## Метод: frequency
## Species
## Category setosa versicolor virginica
## [4.3,5.4) 40 5 1
## [5.4,6.3) 10 31 12
## [6.3,7.9] 0 14 37
##
## Метод: cluster
## Species
## Category setosa versicolor virginica
## [4.3,5.45) 45 6 1
## [5.45,6.46) 5 35 23
## [6.46,7.9] 0 9 26
##
## Метод: fixed
## Species
## Category setosa versicolor virginica
## [4,5.5) 45 6 1
## [5.5,6.5) 5 35 23
## [6.5,8] 0 9 26Вывод. Равная ширина интервалов не означает равенства числа наблюдений. Квантильный метод даёт близкие численности, однако одинаковые значения не разделяются между интервалами, поэтому полное равенство не гарантируется. Кластеризация учитывает группировку значений, но зависит от начального состояния генератора и не обязана создавать равные группы. Фиксированные границы удобны, когда категории определены предметной областью. В выполненных преобразованиях пропуски не возникли; дискретизация уменьшает детализацию исходного признака.
5 Выбор признаков Ozone с Boruta
5.1 Исходные данные и пропуски
Использован Ozone из mlbench: ежедневные
наблюдения за загрязнением воздуха в Лос-Анджелесе за 1976 год, 366
строк и 13 переменных. Целевая переменная V4 — дневной
максимум часового среднего содержания озона. Остальные 12 столбцов
используются как предикторы. Поскольку V4 числовая,
решается задача регрессии.
## [1] 366 13missing_values <- data.frame(Variable=names(Ozone),Missing=colSums(is.na(Ozone)))
knitr::kable(missing_values,row.names=FALSE,
col.names=c('Переменная','Число пропусков'))| Переменная | Число пропусков |
|---|---|
| V1 | 0 |
| V2 | 0 |
| V3 | 0 |
| V4 | 5 |
| V5 | 12 |
| V6 | 0 |
| V7 | 15 |
| V8 | 2 |
| V9 | 139 |
| V10 | 15 |
| V11 | 1 |
| V12 | 14 |
| V13 | 0 |
## original complete removed
## 366 203 163Для воспроизведения примера пакета использованы полные строки: осталось 203 из 366 наблюдений; удалено 163 (44.5%). Такое сокращение выборки может изменить её распределение, поэтому результаты относятся к подвыборке полных наблюдений. Пропуски не заменялись значениями целевой переменной.
5.2 Запуск Boruta
В качестве источника важности явно задан случайный лес ranger через
адаптер getImpRfZ: это Z-оценки перестановочной важности.
Boruta сравнивает важность исходных признаков с важностью их случайно
перемешанных теневых копий. Признаки получают статусы Confirmed,
Rejected или Tentative. Алгоритм ищет все релевантные признаки, а не
минимальный набор без избыточности.
set.seed(233334)
bor <- Boruta(V4~.,data=ozo,maxRuns=300,doTrace=0,
holdHistory=TRUE,getImp=getImpRfZ,num.threads=1,num.trees=500)
print(bor)## Boruta performed 11 iterations in 1.557782 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;bor_stats <- attStats(bor)
bor_stats <- bor_stats[order(-bor_stats$meanImp),]
knitr::kable(data.frame(Feature=rownames(bor_stats),bor_stats,row.names=NULL),
digits=3)| Feature | meanImp | medianImp | minImp | maxImp | normHits | decision |
|---|---|---|---|---|---|---|
| V9 | 18.843 | 19.076 | 16.977 | 20.337 | 1 | Confirmed |
| V8 | 16.660 | 16.891 | 15.192 | 17.802 | 1 | Confirmed |
| V12 | 14.641 | 14.590 | 13.168 | 16.187 | 1 | Confirmed |
| V11 | 11.770 | 11.909 | 11.011 | 12.273 | 1 | Confirmed |
| V7 | 11.246 | 11.378 | 10.091 | 12.119 | 1 | Confirmed |
| V10 | 10.285 | 10.203 | 9.233 | 11.582 | 1 | Confirmed |
| V13 | 9.976 | 9.990 | 8.810 | 11.231 | 1 | Confirmed |
| V5 | 9.607 | 9.693 | 8.772 | 10.231 | 1 | Confirmed |
| V1 | 9.581 | 9.610 | 8.947 | 10.357 | 1 | Confirmed |
| V6 | 1.350 | 1.265 | -0.472 | 2.269 | 0 | Rejected |
| V2 | 0.809 | 0.678 | -0.318 | 2.377 | 0 | Rejected |
| V3 | -0.663 | -0.428 | -2.475 | 0.671 | 0 | Rejected |
## [1] "V1" "V5" "V7" "V8" "V9" "V10" "V11" "V12" "V13"5.3 Boxplot важности признаков
Функция plot() для объекта Boruta строит диаграммы
размаха истории важности признаков, то есть требуемый boxplot. Синим
показаны теневые признаки, зелёным — подтверждённые, красным —
отклонённые, жёлтым — неопределённые, если они остались.
draw_boruta <- function() {
par(mar=c(8,5,3,1))
plot(bor,las=2,cex.axis=.85,xlab='',main='Boruta: Ozone (V4)',ylab='Importance (Z-score)')
}
export_jpg('boruta',draw_boruta)
Вывод. Подтверждены признаки: V1, V5, V7, V8, V9, V10, V11, V12, V13. Отклонены: V6, V2, V3. Неопределённые: отсутствуют. Наибольшая средняя важность у V9. В данном наборе V9 обозначает температуру воздуха в Эль-Монте, V8 — температуру в Сандберге, V12 — температуру у основания инверсии. Решения получены при фиксированном seed, уровне значимости по умолчанию и поправке на множественные сравнения по умолчанию. Признаки календаря и погоды могут отражать сезонность и связанные процессы; отбор не доказывает причинного влияния. Точность прогноза и переносимость результатов на другие годы в этой работе не оценивались.
6 Итог
Выполнен графический анализ искусственной выборки средствами CARET,
сохранены JPG-файлы. Три энтропийных критерия FSelector выделили
параметры лепестка как наиболее информативные для классификации
iris. Четыре метода arules::discretize()
показали разные способы формирования категорий. Boruta применён к
регрессионной задаче Ozone с явной обработкой пропусков и
визуализацией важности признаков.
Все разделы, вычислительный код, результаты и выводы объединены в этот R Markdown-документ.
7 Источники
8 Среда выполнения
## R version 4.6.1 (2026-06-24 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
##
## 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] knitr_1.52 mlbench_2.1-11 Boruta_10.0.0 arules_1.7.15 Matrix_1.7-5 FSelector_0.34
## [7] caret_7.0-1 lattice_0.23-1 ggplot2_4.0.3
##
## loaded via a namespace (and not attached):
## [1] ellipse_0.5.0 gtable_0.3.6 xfun_0.62 bslib_0.12.0
## [5] recipes_1.4.0 rJava_1.0-18 vctrs_0.7.3 tools_4.6.1
## [9] generics_0.1.4 stats4_4.6.1 parallel_4.6.1 tibble_3.3.1
## [13] pkgconfig_2.0.3 ModelMetrics_1.2.2.2 data.table_1.18.6.1 RColorBrewer_1.1-3
## [17] S7_0.2.2 lifecycle_1.0.5 compiler_4.6.1 farver_2.1.2
## [21] stringr_1.6.0 codetools_0.2-20 htmltools_0.5.9 class_7.3-23
## [25] sass_0.4.10 yaml_2.3.12 prodlim_2026.03.11 pillar_1.11.1
## [29] jquerylib_0.1.4 MASS_7.3-65 entropy_1.3.2 cachem_1.1.0
## [33] gower_1.0.2 iterators_1.0.14 rpart_4.1.27 foreach_1.5.2
## [37] nlme_3.1-169 parallelly_1.48.0 lava_1.9.3 tidyselect_1.2.1
## [41] digest_0.6.39 stringi_1.8.9 future_1.80.0 dplyr_1.2.1
## [45] reshape2_1.4.5 purrr_1.2.2 listenv_1.1.0 RWekajars_3.9.3-2
## [49] splines_4.6.1 fastmap_1.2.0 grid_4.6.1 cli_3.6.6
## [53] magrittr_2.0.5 randomForest_4.7-1.2 survival_3.8-6 future.apply_1.21.0
## [57] withr_3.0.3 scales_1.4.0 lubridate_1.9.5 timechange_0.4.0
## [61] rmarkdown_2.32 globals_0.20.0 otel_0.2.0 nnet_7.3-20
## [65] RWeka_0.4-50 timeDate_4052.112 ranger_0.18.0 evaluate_1.0.5
## [69] hardhat_1.4.3 rlang_1.3.0 Rcpp_1.1.2 glue_1.8.1
## [73] pROC_1.19.1 ipred_0.9-16 jsonlite_2.0.0 R6_2.6.1
## [77] plyr_1.8.9