Введение В данной лабораторной работе рассматриваются различные подходы к отбору признаков (feature selection) в языке R. Отбор признаков — важный этап предобработки данных, который позволяет:
улучшить качество моделей снизить переобучение уменьшить время обучения повысить интерпретируемость результатов
all_models <- names(getModelInfo())
cat("Всего моделей в caret:", length(all_models), "\n")
## Всего моделей в caret: 239
cat("Первые 20:\n")
## Первые 20:
print(head(all_models, 20))
## [1] "ada" "AdaBag" "AdaBoost.M1" "adaboost" "amdai"
## [6] "ANFIS" "avNNet" "awnb" "awtan" "bag"
## [11] "bagEarth" "bagEarthGCV" "bagFDA" "bagFDAGCV" "bam"
## [16] "bartMachine" "bayesglm" "binda" "blackboost" "blasso"
1.2 Пример разведочного анализа с featurePlot
set.seed(123)
# Синтетические данные
x <- matrix(rnorm(50 * 5), ncol = 5)
colnames(x) <- paste0("Feature", 1:5)
y <- factor(rep(c("A", "B"), each = 25))
df_caret <- as.data.frame(x)
df_caret$y <- y
# Scatter plot
print(featurePlot(
x = df_caret[, 1:5],
y = df_caret$y,
plot = "scatter",
auto.key = list(columns = 2),
main = "Scatter plot признаков"
))
## NULL
# Box plot
print(featurePlot(
x = df_caret[, 1:5],
y = df_caret$y,
plot = "box",
main = "Box plot по классам"
))
# Density plot
print(featurePlot(
x = df_caret[, 1:5],
y = df_caret$y,
plot = "density",
auto.key = list(columns = 2),
main = "Плотности распределения"
))
Вывод: в синтетическом наборе с нормальным шумом классы практически не
разделимы по отдельным признакам.
data(iris)
# Information Gain
ig <- information.gain(Species ~ ., iris)
cat("Information Gain\n")
## Information Gain
print(ig)
## attr_importance
## Sepal.Length 0.4521286
## Sepal.Width 0.2672750
## Petal.Length 0.9402853
## Petal.Width 0.9554360
# Chi-squared
chi <- chi.squared(Species ~ ., iris)
cat("\nChi-squared\n")
##
## Chi-squared
print(chi)
## attr_importance
## Sepal.Length 0.6288067
## Sepal.Width 0.4922162
## Petal.Length 0.9346311
## Petal.Width 0.9432359
# OneR
oner <- oneR(Species ~ ., iris)
cat("\nOneR\n")
##
## OneR
print(oner)
## attr_importance
## Sepal.Length 0.1733333
## Sepal.Width 0.0400000
## Petal.Length 0.4000000
## Petal.Width 0.4066667
# Топ-2 признака по IG
top2 <- cutoff.k(ig, 2)
cat("\nТОП-2 признака по Information Gain:", paste(top2, collapse = ", "), "\n")
##
## ТОП-2 признака по Information Gain: Petal.Width, Petal.Length
# График
barplot(ig$attr_importance,
names.arg = rownames(ig),
main = "Важность признаков (Information Gain)",
col = "steelblue",
las = 2,
ylab = "Важность")
Вывод: все методы однозначно выделяют Petal.Length и Petal.Width как
самые информативные.
data(iris)
x <- iris$Petal.Length
disc_interval <- discretize(x, method = "interval", categories = 3, labels = c("Низкий", "Средний", "Высокий"))
disc_freq <- discretize(x, method = "frequency", categories = 3, labels = c("Низкая", "Средняя", "Высокая"))
disc_cluster <- discretize(x, method = "cluster", categories = 3, labels = c("Кластер 1", "Кластер 2", "Кластер 3"))
disc_fixed <- discretize(x, method = "fixed", breaks = c(1, 2.5, 5, 7), labels = c("Маленький", "Средний", "Большой"))
# Сравнительная таблица (первые 12 наблюдений)
comp <- data.frame(
Value = x[1:12],
Species = iris$Species[1:12],
Interval = disc_interval[1:12],
Frequency = disc_freq[1:12],
Cluster = disc_cluster[1:12],
Fixed = disc_fixed[1:12]
)
print(comp)
## Value Species Interval Frequency Cluster Fixed
## 1 1.4 setosa Низкий Низкая Кластер 1 Маленький
## 2 1.4 setosa Низкий Низкая Кластер 1 Маленький
## 3 1.3 setosa Низкий Низкая Кластер 1 Маленький
## 4 1.5 setosa Низкий Низкая Кластер 1 Маленький
## 5 1.4 setosa Низкий Низкая Кластер 1 Маленький
## 6 1.7 setosa Низкий Низкая Кластер 1 Маленький
## 7 1.4 setosa Низкий Низкая Кластер 1 Маленький
## 8 1.5 setosa Низкий Низкая Кластер 1 Маленький
## 9 1.4 setosa Низкий Низкая Кластер 1 Маленький
## 10 1.5 setosa Низкий Низкая Кластер 1 Маленький
## 11 1.5 setosa Низкий Низкая Кластер 1 Маленький
## 12 1.6 setosa Низкий Низкая Кластер 1 Маленький
# Визуализация гистограмм
plot_d <- function(vals, disc, title) {
df <- data.frame(x = vals, cat = disc)
ggplot(df, aes(x = x, fill = cat)) +
geom_histogram(bins = 30, color = "black", alpha = 0.75) +
labs(title = title, x = "Petal.Length", y = "Количество") +
theme_minimal(base_size = 12)
}
grid.arrange(
plot_d(x, disc_interval, "Равная ширина интервалов"),
plot_d(x, disc_freq, "Равная частота"),
plot_d(x, disc_cluster, "Кластеризация (k-means)"),
plot_d(x, disc_fixed, "Фиксированные границы"),
ncol = 2
)
4. Алгоритм Boruta (обёртка над Random Forest)
data(Ozone)
ozone_clean <- na.omit(Ozone)
cat("Строк до/после удаления NA:", nrow(Ozone), "→", nrow(ozone_clean), "\n")
## Строк до/после удаления NA: 366 → 203
# Бинарная целевая переменная
thresh <- median(ozone_clean$V4)
ozone_clean$level <- factor(ifelse(ozone_clean$V4 > thresh, "High", "Low"))
features <- setdiff(names(ozone_clean), c("V4", "level"))
frm <- as.formula(paste("level ~", paste(features, collapse = " + ")))
set.seed(123)
boruta_out <- Boruta(frm, data = ozone_clean, doTrace = 0)
boruta_final <- TentativeRoughFix(boruta_out)
print(boruta_final)
## Boruta performed 15 iterations in 0.7605681 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;
confirmed <- getSelectedAttributes(boruta_final, withTentative = FALSE)
cat("\nПодтверждённые важные признаки:\n")
##
## Подтверждённые важные признаки:
print(confirmed)
## [1] "V13" "V12" "V11" "V10" "V9" "V8" "V7" "V5" "V1"
plot(boruta_final, las = 2, cex.axis = 0.75,
main = "Boruta — важность признаков (Ozone)")
Заключение В работе были рассмотрены четыре разных подхода:
визуализация и унифицированный интерфейс → caret быстрые фильтры → FSelector дискретизация → arules надёжный wrapper-метод → Boruta
Каждый из этих инструментов полезен на своём этапе анализа данных.