В данной лабораторной работе мы рассмотрим различные методы выбора признаков и выполним разведочный анализ данных с использованием пакетов CARET, FSelector, arules и Boruta в языке R. Выбор признаков является важным этапом в анализе данных, поскольку позволяет повысить эффективность моделей, уменьшить переобучение и сократить вычислительные затраты.
Первым шагом установим пакет CARET, и загрузим его.
Теперь ознакомимся со списком доступных методов выбора признаков в пакете CARET.
# Просмотр доступных методов выбора признаков
methods <- names(getModelInfo())
head(methods, 20) # Выводим первые 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"
В результате выполнения этой команды мы получаем список первых 20 методов из всех доступных в пакете CARET. Эти методы могут быть использованы для построения различных моделей машинного обучения и выбора признаков.
Создадим тестовые данные для анализа в соответствии с условием задания: - Матрица x размерности 50×5, заполненная случайными числами из нормального распределения - Фактор y с двумя уровнями (“A” и “B”), повторяющимися по 25 раз
# Создание тестовых данных
set.seed(123) # Для воспроизводимости результатов
x <- matrix(rnorm(50*5), ncol=5)
y <- factor(rep(c("A", "B"), 25))
# Преобразуем матрицу x в data.frame
df <- data.frame(x)
df$Class <- y
# Просмотрим первые несколько строк данных
head(df)## X1 X2 X3 X4 X5 Class
## 1 -0.56047565 0.25331851 -0.71040656 0.7877388 2.1988103 A
## 2 -0.23017749 -0.02854676 0.25688371 0.7690422 1.3124130 B
## 3 1.55870831 -0.04287046 -0.24669188 0.3322026 -0.2651451 A
## 4 0.07050839 1.36860228 -0.34754260 -1.0083766 0.5431941 B
## 5 0.12928774 -0.22577099 -0.95161857 -0.1194526 -0.4143399 A
## 6 1.71506499 1.51647060 -0.04502772 -0.2803953 -0.4762469 B
Создадим директорию для сохранения графиков.
Теперь выполним разведочный анализ данных с использованием функции
featurePlot(). Эта функция позволяет визуализировать данные
различными способами, что помогает понять распределение и взаимосвязи
между признаками.
# Создаем визуализацию
p1 <- featurePlot(x, y, plot = "pairs", auto.key = list(columns = 2))
print(p1)# Сохраняем график
jpeg("plots/scatterplot_matrix.jpg", width = 800, height = 800)
print(p1)
dev.off()## png
## 2
Диаграмма разброса показывает взаимосвязи между всеми парами признаков. Точки разных цветов соответствуют разным классам (A и B). Эта визуализация позволяет выявить: - Корреляции между признаками - Возможные кластеры - Особенности распределения данных для разных классов
# Создаем визуализацию
p2 <- featurePlot(x, y, plot = "density",
scales = list(x = list(relation = "free"),
y = list(relation = "free")),
auto.key = list(columns = 2))
print(p2)## png
## 2
График плотности распределения показывает, как распределены значения каждого признака для разных классов. Это позволяет: - Определить, насколько хорошо признаки разделяют классы - Выявить многомодальное распределение - Обнаружить сдвиги в распределении между классами
# Создаем визуализацию
p3 <- featurePlot(x, y, plot = "box",
scales = list(y = list(relation = "free")),
auto.key = list(columns = 2))
print(p3)## png
## 2
Ящики с усами (боксплоты) визуализируют: - Медиану (линия внутри ящика) - Первый и третий квартили (границы ящика) - Минимальные и максимальные значения в пределах 1,5 × IQR (усы) - Выбросы (точки вне усов)
Это помогает сравнить распределение признаков между классами и выявить потенциальные выбросы.
Проанализируем полученные результаты разведочного анализа:
# Проверка разделимости классов
# Вычисляем средние значения признаков для каждого класса
class_means <- aggregate(df[, 1:5], by = list(df$Class), FUN = mean)
print("Средние значения признаков по классам:")## [1] "Средние значения признаков по классам:"
## Group.1 X1 X2 X3 X4 X5
## 1 A 0.08666599 0.1343269 -0.2679904 0.070223932 0.1166058
## 2 B -0.01785890 0.1584897 -0.2398105 0.007389742 -0.1336469
# Проверка стандартных отклонений
class_sd <- aggregate(df[, 1:5], by = list(df$Class), FUN = sd)
print("Стандартные отклонения признаков по классам:")## [1] "Стандартные отклонения признаков по классам:"
## Group.1 X1 X2 X3 X4 X5
## 1 A 0.8395844 0.8063779 1.1758213 0.7024221 0.9785208
## 2 B 1.0196059 1.0115729 0.7844594 1.1287555 0.9178136
На основе проведенного разведочного анализа можно сделать следующие выводы:
Распределение признаков: Признаки в наборе данных представляют собой случайные нормально распределенные величины, что видно из графиков плотности.
Разделимость классов: Визуально не наблюдается четкого разделения между классами A и B по отдельным признакам. Это подтверждается близкими значениями средних и стандартных отклонений для обоих классов.
Выбросы: На боксплотах не наблюдается значительных выбросов, что указывает на однородность данных.
Корреляции между признаками: Диаграмма разброса не выявляет сильных корреляций между признаками.
В этом задании мы будем использовать пакет FSelector для определения важности признаков в наборе данных iris.
## 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa
## Sepal.Length Sepal.Width Petal.Length Petal.Width
## Min. :4.300 Min. :2.000 Min. :1.000 Min. :0.100
## 1st Qu.:5.100 1st Qu.:2.800 1st Qu.:1.600 1st Qu.:0.300
## Median :5.800 Median :3.000 Median :4.350 Median :1.300
## Mean :5.843 Mean :3.057 Mean :3.758 Mean :1.199
## 3rd Qu.:6.400 3rd Qu.:3.300 3rd Qu.:5.100 3rd Qu.:1.800
## Max. :7.900 Max. :4.400 Max. :6.900 Max. :2.500
## Species
## setosa :50
## versicolor:50
## virginica :50
##
##
##
Набор данных iris содержит измерения четырех признаков (длина и ширина чашелистика и лепестка) для трех видов ирисов (setosa, versicolor и virginica). Наша задача - определить, какие признаки наиболее важны для классификации видов.
FSelector предоставляет несколько методов для оценки важности признаков. Рассмотрим три из них:
# Вычисление важности признаков с использованием метода Information Gain
ig_weights <- information.gain(Species ~ ., iris)
print("Information Gain:")## [1] "Information Gain:"
## attr_importance
## Sepal.Length 0.4521286
## Sepal.Width 0.2672750
## Petal.Length 0.9402853
## Petal.Width 0.9554360
Information Gain (прирост информации) измеряет, насколько признак уменьшает энтропию (неопределенность) при предсказании целевой переменной. Чем выше значение, тем важнее признак.
# Вычисление важности признаков с использованием метода Gain Ratio
gr_weights <- gain.ratio(Species ~ ., iris)
print("Gain Ratio:")## [1] "Gain Ratio:"
## attr_importance
## Sepal.Length 0.4196464
## Sepal.Width 0.2472972
## Petal.Length 0.8584937
## Petal.Width 0.8713692
Gain Ratio (относительный прирост) - это нормализованный вариант Information Gain, который учитывает количество уникальных значений признака. Это помогает избежать предвзятости в пользу признаков с большим количеством уникальных значений.
# Вычисление важности признаков с использованием метода Chi-squared
chi_weights <- chi.squared(Species ~ ., iris)
print("Chi-squared:")## [1] "Chi-squared:"
## attr_importance
## Sepal.Length 0.6288067
## Sepal.Width 0.4922162
## Petal.Length 0.9346311
## Petal.Width 0.9432359
Метод Chi-squared (хи-квадрат) оценивает зависимость между признаком и целевой переменной на основе статистики хи-квадрат. Высокие значения указывают на сильную зависимость.
Сравним результаты всех трех методов визуально:
# Объединяем результаты в один data.frame
feature_names <- rownames(ig_weights)
importance_df <- data.frame(
Feature = rep(feature_names, 3),
Method = c(rep("Information Gain", length(feature_names)),
rep("Gain Ratio", length(feature_names)),
rep("Chi-squared", length(feature_names))),
Importance = c(ig_weights$attr_importance,
gr_weights$attr_importance,
chi_weights$attr_importance)
)
# Создаем график
ggplot(importance_df, aes(x = reorder(Feature, Importance), y = Importance, fill = Method)) +
geom_bar(stat = "identity", position = "dodge") +
coord_flip() +
labs(title = "Важность признаков для набора данных Iris",
x = "Признак", y = "Важность") +
theme_minimal() +
theme(legend.position = "top")# Сохраняем график
jpeg("plots/feature_importance.jpg", width = 1000, height = 600)
ggplot(importance_df, aes(x = reorder(Feature, Importance), y = Importance, fill = Method)) +
geom_bar(stat = "identity", position = "dodge") +
coord_flip() +
labs(title = "Важность признаков для набора данных Iris",
x = "Признак", y = "Важность") +
theme_minimal() +
theme(legend.position = "top")
dev.off()## png
## 2
# Ранжирование признаков по важности для каждого метода
ig_ranking <- feature_names[order(ig_weights$attr_importance, decreasing = TRUE)]
gr_ranking <- feature_names[order(gr_weights$attr_importance, decreasing = TRUE)]
chi_ranking <- feature_names[order(chi_weights$attr_importance, decreasing = TRUE)]
# Сравнение ранжирования
ranking_df <- data.frame(
Rank = 1:length(feature_names),
Information_Gain = ig_ranking,
Gain_Ratio = gr_ranking,
Chi_squared = chi_ranking
)
print("Ранжирование признаков по важности:")## [1] "Ранжирование признаков по важности:"
## Rank Information_Gain Gain_Ratio Chi_squared
## 1 1 Petal.Width Petal.Width Petal.Width
## 2 2 Petal.Length Petal.Length Petal.Length
## 3 3 Sepal.Length Sepal.Length Sepal.Length
## 4 4 Sepal.Width Sepal.Width Sepal.Width
На основе результатов анализа важности признаков можно сделать следующие выводы:
В этом задании мы выполним преобразование непрерывной переменной в категориальную с использованием различных методов дискретизации из пакета arules.
Из набора данных iris выберем переменную Sepal.Length для дискретизации:
# Используем набор данных iris
data(iris)
# Выбор переменной для дискретизации
variable <- iris$Sepal.Length
# Посмотрим на распределение переменной
summary(variable)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.300 5.100 5.800 5.843 6.400 7.900
hist(variable, breaks = 20, main = "Распределение Sepal.Length",
xlab = "Sepal.Length", col = "lightblue")Рассмотрим четыре метода дискретизации, доступных в пакете arules:
# Метод равных интервалов (разбивает диапазон на интервалы одинаковой ширины)
eq_interval <- discretize(variable, method = "interval", breaks = 4)
# Смотрим результаты
table(eq_interval)## eq_interval
## [4.3,5.2) [5.2,6.1) [6.1,7) [7,7.9]
## 41 48 48 13
## eq_interval
## [4.3,5.2) [5.2,6.1) [6.1,7) [7,7.9]
## 27.333333 32.000000 32.000000 8.666667
## Границы интервалов:
При использовании метода равных интервалов диапазон значений разбивается на интервалы одинаковой ширины. Это самый простой метод дискретизации, но он может быть не оптимальным, если данные распределены неравномерно.
# Метод равных частот (каждый интервал содержит примерно одинаковое количество наблюдений)
eq_frequency <- discretize(variable, method = "frequency", breaks = 4)
# Смотрим результаты
table(eq_frequency)## eq_frequency
## [4.3,5.1) [5.1,5.8) [5.8,6.4) [6.4,7.9]
## 32 41 35 42
## eq_frequency
## [4.3,5.1) [5.1,5.8) [5.8,6.4) [6.4,7.9]
## 21.33333 27.33333 23.33333 28.00000
## Границы интервалов:
Метод равных частот разбивает данные так, чтобы в каждом интервале оказалось примерно одинаковое количество наблюдений. Этот метод учитывает распределение данных и хорошо работает, когда важно иметь сбалансированные категории.
# Метод кластеризации (использует алгоритм k-means для определения границ)
clustering <- discretize(variable, method = "cluster", breaks = 4)
# Смотрим результаты
table(clustering)## clustering
## [4.3,4.89) [4.89,5.59) [5.59,6.49) [6.49,7.9]
## 16 43 56 35
## clustering
## [4.3,4.89) [4.89,5.59) [5.59,6.49) [6.49,7.9]
## 10.66667 28.66667 37.33333 23.33333
# Границы интервалов
cat("Границы интервалов:", c(min(variable), attr(cluster, "breaks"), max(variable)), "\n")## Границы интервалов: 4.3 7.9
Метод кластеризации использует алгоритм k-means для определения естественных групп в данных. Он может быть эффективен, когда данные образуют естественные кластеры.
# Метод фиксированных границ (границы задаются вручную)
fixed <- discretize(variable, method = "fixed", breaks = c(4.5, 5.5, 6.5, 7.5))
# Смотрим результаты
table(fixed)## fixed
## [4.5,5.5) [5.5,6.5) [6.5,7.5]
## 48 63 29
## fixed
## [4.5,5.5) [5.5,6.5) [6.5,7.5]
## 34.28571 45.00000 20.71429
# Границы интервалов
cat("Границы интервалов:", c(min(variable), attr(fixed, "breaks"), max(variable)), "\n")## Границы интервалов: 4.3 7.9
Метод фиксированных границ позволяет задать границы интервалов вручную. Это полезно, когда у вас есть предметная экспертиза или определенные пороговые значения, которые имеют смысл в контексте задачи.
Сравним результаты всех четырех методов дискретизации:
# Создаем data.frame с результатами
disc_df <- data.frame(
Original = variable,
Interval = eq_interval,
Frequency = eq_frequency,
Cluster = clustering,
Fixed = fixed
)
# Строим графики распределения для каждого метода
if (!require("reshape2")) install.packages("reshape2")
library(reshape2)
disc_long <- melt(disc_df, id.vars = "Original")
# Создаем график
ggplot(disc_long, aes(x = value)) +
geom_bar(fill = "steelblue") +
facet_wrap(~ variable, scales = "free") +
theme_minimal() +
labs(title = "Сравнение методов дискретизации для Sepal.Length",
x = "Категории", y = "Частота") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))# Сохраняем график
jpeg("plots/discretization.jpg", width = 1200, height = 800)
ggplot(disc_long, aes(x = value)) +
geom_bar(fill = "steelblue") +
facet_wrap(~ variable, scales = "free") +
theme_minimal() +
labs(title = "Сравнение методов дискретизации для Sepal.Length",
x = "Категории", y = "Частота") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
dev.off()## png
## 2
Оценим, насколько хорошо дискретизированные признаки помогают в задаче классификации:
# Создаем новые наборы данных с дискретизированным признаком
iris_interval <- iris
iris_interval$Sepal.Length <- eq_interval
iris_frequency <- iris
iris_frequency$Sepal.Length <- eq_frequency
iris_cluster <- iris
iris_cluster$Sepal.Length <- clustering
iris_fixed <- iris
iris_fixed$Sepal.Length <- fixed
# Функция для расчета информативности признака
calculate_information_gain <- function(dataset) {
information.gain(Species ~ Sepal.Length, dataset)$attr_importance
}
# Сравнение информативности дискретизированных признаков
ig_original <- information.gain(Species ~ Sepal.Length, iris)$attr_importance
ig_interval <- calculate_information_gain(iris_interval)
ig_frequency <- calculate_information_gain(iris_frequency)
ig_cluster <- calculate_information_gain(iris_cluster)
ig_fixed <- calculate_information_gain(iris_fixed)
# Создаем таблицу для сравнения
ig_comparison <- data.frame(
Method = c("Original", "Interval", "Frequency", "Cluster", "Fixed"),
Information_Gain = c(ig_original, ig_interval, ig_frequency, ig_cluster, ig_fixed)
)
print("Сравнение информативности признаков после дискретизации:")## [1] "Сравнение информативности признаков после дискретизации:"
## Method Information_Gain
## 1 Original 0.4521286
## 2 Interval 0.4254350
## 3 Frequency 0.4225108
## 4 Cluster 0.4531165
## 5 Fixed 0.4058162
# Визуализация сравнения
ggplot(ig_comparison, aes(x = reorder(Method, Information_Gain), y = Information_Gain)) +
geom_bar(stat = "identity", fill = "orange") +
coord_flip() +
labs(title = "Информативность Sepal.Length после дискретизации",
x = "Метод дискретизации", y = "Information Gain")На основе результатов дискретизации можно сделать следующие выводы:
В этом задании мы будем использовать алгоритм Boruta для выбора значимых признаков на наборе данных Ozone.
# Установка и загрузка пакета mlbench
if (!require("mlbench")) install.packages("mlbench")
library(mlbench)
# Загрузка набора данных Ozone
data("Ozone", package = "mlbench")
# Просмотр структуры данных
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 ...
# Проверка наличия пропущенных значений
missing_values <- colSums(is.na(Ozone))
print("Количество пропущенных значений по столбцам:")## [1] "Количество пропущенных значений по столбцам:"
## V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13
## 0 0 0 5 12 0 15 2 139 15 1 14 0
# Удаляем строки с пропущенными значениями
Ozone_clean <- na.omit(Ozone)
print(paste("Количество строк до удаления пропущенных значений:", nrow(Ozone)))## [1] "Количество строк до удаления пропущенных значений: 366"
## [1] "Количество строк после удаления пропущенных значений: 203"
Набор данных Ozone содержит информацию о ежедневных измерениях загрязнения атмосферы в Лос-Анджелесе. Переменная V4 представляет максимальную дневную концентрацию озона, а остальные переменные - различные метеорологические параметры (температура, влажность, скорость ветра и т.д.).
Наша целевая переменная - V4 (концентрация озона). Давайте посмотрим на её распределение:
# Гистограмма целевой переменной
hist(Ozone_clean$V4, breaks = 20, main = "Распределение концентрации озона (V4)",
xlab = "Концентрация озона", col = "lightgreen")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 5.00 9.00 11.37 16.00 38.00
Алгоритм Boruta основан на алгоритме Random Forest и определяет важность признаков путем сравнения их с “теневыми” случайно перемешанными копиями. Признаки, которые показывают значимость выше, чем лучшие из “теневых” признаков, считаются важными.
# Установка seed для воспроизводимости результатов
set.seed(123)
# Запуск алгоритма Boruta
# Указываем целевую переменную V4 и все остальные переменные как предикторы
boruta_result <- Boruta(V4 ~ ., data = Ozone_clean)
# Выводим результаты
print(boruta_result)## Boruta performed 24 iterations in 1.166595 secs.
## 9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
## 3 attributes confirmed unimportant: V2, V3, V6;
# Получение подтвержденных (важных) признаков
confirmed_features <- getSelectedAttributes(boruta_result, withTentative = FALSE)
print("Подтвержденные важные признаки:")## [1] "Подтвержденные важные признаки:"
## [1] "V1" "V5" "V7" "V8" "V9" "V10" "V11" "V12" "V13"
# Получение отвергнутых признаков
rejected_features <- names(boruta_result$finalDecision[boruta_result$finalDecision == "Rejected"])
print("Отвергнутые признаки:")## [1] "Отвергнутые признаки:"
## [1] "V2" "V3" "V6"
# Получение неопределенных признаков
tentative_features <- names(boruta_result$finalDecision[boruta_result$finalDecision == "Tentative"])
print("Неопределенные признаки:")## [1] "Неопределенные признаки:"
## character(0)
# Получение важности признаков
feature_importance <- attStats(boruta_result)
print("Статистика важности признаков:")## [1] "Статистика важности признаков:"
## meanImp medianImp minImp maxImp normHits decision
## V9 19.2281405 19.0627349 17.5889826 20.9190449 1.0000000 Confirmed
## V8 17.1647491 17.2255744 16.0336735 18.5525852 1.0000000 Confirmed
## V12 14.6326841 14.6095338 13.5595253 16.0775580 1.0000000 Confirmed
## V11 11.8977619 11.8484607 10.9347533 13.6520570 1.0000000 Confirmed
## V7 11.7026875 11.5169965 10.5127703 13.4896943 1.0000000 Confirmed
## V10 9.8662368 9.7266893 8.6477478 11.3131795 1.0000000 Confirmed
## V1 9.5563296 9.7071000 8.4255686 10.7247899 1.0000000 Confirmed
## V13 9.4438214 9.5489762 8.1005306 10.7881019 1.0000000 Confirmed
## V5 9.2426781 9.2313179 8.1108460 10.5140883 1.0000000 Confirmed
## V2 1.1557680 1.1576551 -0.2474598 2.7423660 0.1666667 Rejected
## V6 0.9886679 1.3615721 -1.1013954 1.9852132 0.0000000 Rejected
## V3 -0.9877372 -0.7333367 -3.4162909 0.3794342 0.0000000 Rejected
# Визуализация результатов Boruta
plot(boruta_result, xlab = "", xaxt = "n", main = "Важность признаков (Boruta)")
lz <- lapply(1:ncol(boruta_result$ImpHistory), function(i)
boruta_result$ImpHistory[is.finite(boruta_result$ImpHistory[,i]),i])
names(lz) <- colnames(boruta_result$ImpHistory)
Labels <- sort(sapply(lz, median))
axis(side = 1, at = 1:ncol(boruta_result$ImpHistory), labels = names(Labels))# Сохраняем график
jpeg("plots/boruta_importance.jpg", width = 1200, height = 800)
plot(boruta_result, xlab = "", xaxt = "n", main = "Важность признаков (Boruta)")
lz <- lapply(1:ncol(boruta_result$ImpHistory), function(i)
boruta_result$ImpHistory[is.finite(boruta_result$ImpHistory[,i]),i])
names(lz) <- colnames(boruta_result$ImpHistory)
Labels <- sort(sapply(lz, median))
axis(side = 1, at = 1:ncol(boruta_result$ImpHistory), labels = names(Labels))
dev.off()## png
## 2
На графике показана важность каждого признака. Зеленые боксплоты соответствуют подтвержденным важным признакам, желтые - неопределенным, а красные - отвергнутым. Синие боксплоты представляют “теневые” признаки, которые используются как эталон для сравнения.
# Выбираем значимые признаки и целевую переменную
selected_data <- Ozone_clean[, c("V4", confirmed_features)]
# Преобразование данных для boxplot
selected_long <- melt(selected_data, id.vars = "V4")
# Создаем boxplot
ggplot(selected_long, aes(x = variable, y = value)) +
geom_boxplot(fill = "lightblue") +
theme_minimal() +
labs(title = "Boxplot значимых признаков",
x = "Признак", y = "Значение") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))# Сохраняем график
jpeg("plots/selected_features_boxplot.jpg", width = 1200, height = 800)
ggplot(selected_long, aes(x = variable, y = value)) +
geom_boxplot(fill = "lightblue") +
theme_minimal() +
labs(title = "Boxplot значимых признаков",
x = "Признак", y = "Значение") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
dev.off()## png
## 2
## 'data.frame': 203 obs. of 10 variables:
## $ V4 : num 5 6 4 4 6 6 5 4 4 7 ...
## $ V1 : Factor w/ 12 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ V5 : num 5760 5720 5790 5790 5700 5720 5760 5780 5830 5870 ...
## $ 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 ...
# Преобразуем все колонки в числовой формат (кроме первой, которая является целевой)
selected_data_numeric <- selected_data
for (i in 1:ncol(selected_data_numeric)) {
selected_data_numeric[[i]] <- as.numeric(as.character(selected_data_numeric[[i]]))
}
# Вычисляем корреляции между значимыми признаками и целевой переменной
correlation_with_target <- cor(selected_data_numeric, use = "pairwise.complete.obs")["V4", ]
# Исключаем корреляцию V4 с самой собой
correlation_with_target <- correlation_with_target[correlation_with_target != 1]
print("Корреляция значимых признаков с целевой переменной (V4):")## [1] "Корреляция значимых признаков с целевой переменной (V4):"
## V8 V9 V12 V5 V10 V7
## 0.77246956 0.75902225 0.71756579 0.59442132 -0.55392523 0.48108120
## V13 V11 V1
## -0.47604005 0.17315141 0.04242353
# Визуализация корреляций
corr_data <- data.frame(
Feature = names(correlation_with_target),
Correlation = as.numeric(correlation_with_target)
)
ggplot(corr_data, aes(x = reorder(Feature, abs(Correlation)), y = Correlation)) +
geom_bar(stat = "identity", fill = ifelse(corr_data$Correlation > 0, "blue", "red")) +
coord_flip() +
labs(title = "Корреляция значимых признаков с концентрацией озона (V4)",
x = "Признак", y = "Корреляция (Pearson)") +
theme_minimal() +
geom_hline(yintercept = 0, linetype = "dashed", color = "black")# Установка и загрузка пакета corrplot
if (!require("corrplot")) install.packages("corrplot")
library(corrplot)
# Создаем корреляционную матрицу для выбранных признаков
corr_matrix <- cor(selected_data_numeric, use = "pairwise.complete.obs")
corrplot::corrplot(corr_matrix, method = "circle", type = "upper",
tl.col = "black", tl.srt = 45,
title = "Корреляционная матрица значимых признаков")На основе результатов анализа с использованием алгоритма Boruta можно сделать следующие выводы:
В ходе лабораторной работы мы выполнили комплексный анализ данных с использованием различных методов выбора признаков и разведочного анализа: