Введение

В данной лабораторной работе мы рассмотрим различные методы выбора признаков и выполним разведочный анализ данных с использованием пакетов CARET, FSelector, arules и Boruta в языке R. Выбор признаков является важным этапом в анализе данных, поскольку позволяет повысить эффективность моделей, уменьшить переобучение и сократить вычислительные затраты.

Задание 1: Установка CARET и разведочный анализ данных

Шаг 1: Установка необходимых пакетов

Первым шагом установим пакет CARET, и загрузим его.

# Установка пакета CARET
if (!require("caret")) install.packages("caret")
library(caret)

Шаг 2: Просмотр доступных методов выбора признаков

Теперь ознакомимся со списком доступных методов выбора признаков в пакете 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. Эти методы могут быть использованы для построения различных моделей машинного обучения и выбора признаков.

Шаг 3: Создание тестовых данных

Создадим тестовые данные для анализа в соответствии с условием задания: - Матрица 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

Шаг 4: Создание директории для сохранения графиков

Создадим директорию для сохранения графиков.

# Создаем директорию для сохранения графиков
if (!dir.exists("plots")) dir.create("plots")

Шаг 5: Графический разведочный анализ данных

Теперь выполним разведочный анализ данных с использованием функции featurePlot(). Эта функция позволяет визуализировать данные различными способами, что помогает понять распределение и взаимосвязи между признаками.

Диаграмма разброса (Scatter Plot Matrix)

# Создаем визуализацию
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)

# Сохраняем график
jpeg("plots/density_plot.jpg", width = 1200, height = 800)
print(p2)
dev.off()
## png 
##   2

График плотности распределения показывает, как распределены значения каждого признака для разных классов. Это позволяет: - Определить, насколько хорошо признаки разделяют классы - Выявить многомодальное распределение - Обнаружить сдвиги в распределении между классами

Ящики с усами (Boxplots)

# Создаем визуализацию
p3 <- featurePlot(x, y, plot = "box", 
                 scales = list(y = list(relation = "free")), 
                 auto.key = list(columns = 2))
print(p3)

# Сохраняем график
jpeg("plots/boxplots.jpg", width = 1200, height = 800)
print(p3)
dev.off()
## png 
##   2

Ящики с усами (боксплоты) визуализируют: - Медиану (линия внутри ящика) - Первый и третий квартили (границы ящика) - Минимальные и максимальные значения в пределах 1,5 × IQR (усы) - Выбросы (точки вне усов)

Это помогает сравнить распределение признаков между классами и выявить потенциальные выбросы.

Шаг 6: Анализ и выводы по первому заданию

Проанализируем полученные результаты разведочного анализа:

# Проверка разделимости классов
# Вычисляем средние значения признаков для каждого класса
class_means <- aggregate(df[, 1:5], by = list(df$Class), FUN = mean)
print("Средние значения признаков по классам:")
## [1] "Средние значения признаков по классам:"
print(class_means)
##   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] "Стандартные отклонения признаков по классам:"
print(class_sd)
##   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

Выводы по разведочному анализу данных

На основе проведенного разведочного анализа можно сделать следующие выводы:

  1. Распределение признаков: Признаки в наборе данных представляют собой случайные нормально распределенные величины, что видно из графиков плотности.

  2. Разделимость классов: Визуально не наблюдается четкого разделения между классами A и B по отдельным признакам. Это подтверждается близкими значениями средних и стандартных отклонений для обоих классов.

  3. Выбросы: На боксплотах не наблюдается значительных выбросов, что указывает на однородность данных.

  4. Корреляции между признаками: Диаграмма разброса не выявляет сильных корреляций между признаками.

Задание 2: Определение важности признаков с FSelector

В этом задании мы будем использовать пакет FSelector для определения важности признаков в наборе данных iris.

Шаг 1: Установка и загрузка пакета FSelector

# Установка и загрузка пакета FSelector
if (!require("FSelector")) install.packages("FSelector")
library(FSelector)

Шаг 2: Загрузка и изучение набора данных iris

# Загрузка набора данных iris
data(iris)

# Просмотр структуры данных
str(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 ...
# Просмотр первых нескольких строк
head(iris)
##   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
# Статистическое описание данных
summary(iris)
##   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). Наша задача - определить, какие признаки наиболее важны для классификации видов.

Шаг 3: Определение важности признаков с помощью различных методов

FSelector предоставляет несколько методов для оценки важности признаков. Рассмотрим три из них:

Метод 1: Information Gain (Прирост информации)

# Вычисление важности признаков с использованием метода Information Gain
ig_weights <- information.gain(Species ~ ., iris)
print("Information Gain:")
## [1] "Information Gain:"
print(ig_weights)
##              attr_importance
## Sepal.Length       0.4521286
## Sepal.Width        0.2672750
## Petal.Length       0.9402853
## Petal.Width        0.9554360

Information Gain (прирост информации) измеряет, насколько признак уменьшает энтропию (неопределенность) при предсказании целевой переменной. Чем выше значение, тем важнее признак.

Метод 2: Gain Ratio (Относительный прирост)

# Вычисление важности признаков с использованием метода Gain Ratio
gr_weights <- gain.ratio(Species ~ ., iris)
print("Gain Ratio:")
## [1] "Gain Ratio:"
print(gr_weights)
##              attr_importance
## Sepal.Length       0.4196464
## Sepal.Width        0.2472972
## Petal.Length       0.8584937
## Petal.Width        0.8713692

Gain Ratio (относительный прирост) - это нормализованный вариант Information Gain, который учитывает количество уникальных значений признака. Это помогает избежать предвзятости в пользу признаков с большим количеством уникальных значений.

Метод 3: Chi-squared (Хи-квадрат)

# Вычисление важности признаков с использованием метода Chi-squared
chi_weights <- chi.squared(Species ~ ., iris)
print("Chi-squared:")
## [1] "Chi-squared:"
print(chi_weights)
##              attr_importance
## Sepal.Length       0.6288067
## Sepal.Width        0.4922162
## Petal.Length       0.9346311
## Petal.Width        0.9432359

Метод Chi-squared (хи-квадрат) оценивает зависимость между признаком и целевой переменной на основе статистики хи-квадрат. Высокие значения указывают на сильную зависимость.

Шаг 4: Визуализация и сравнение результатов

Сравним результаты всех трех методов визуально:

# Объединяем результаты в один 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

Шаг 5: Анализ и выводы по определению важности признаков

# Ранжирование признаков по важности для каждого метода
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] "Ранжирование признаков по важности:"
print(ranking_df)
##   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

Выводы по определению важности признаков

На основе результатов анализа важности признаков можно сделать следующие выводы:

  1. Наиболее информативные признаки:
    • Длина лепестка (Petal.Length) и ширина лепестка (Petal.Width) являются наиболее информативными признаками для классификации видов ириса по всем трем методам.
  2. Согласованность методов:
    • Все три метода (Information Gain, Gain Ratio и Chi-squared) показывают схожие результаты, что повышает достоверность выводов.
    • Небольшие различия в ранжировании могут быть связаны с особенностями каждого метода.
  3. Наименее информативные признаки:
    • Ширина чашелистика (Sepal.Width) имеет наименьшую информативность для классификации по сравнению с другими признаками.

Задание 3: Дискретизация переменных с помощью пакета arules

В этом задании мы выполним преобразование непрерывной переменной в категориальную с использованием различных методов дискретизации из пакета arules.

Шаг 1: Установка и загрузка пакета arules

# Установка и загрузка пакета arules
if (!require("arules")) install.packages("arules")
library(arules)

Шаг 2: Выбор переменной для дискретизации

Из набора данных 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")

Шаг 3: Применение различных методов дискретизации

Рассмотрим четыре метода дискретизации, доступных в пакете arules:

Метод 1: Равная ширина интервала (interval)

# Метод равных интервалов (разбивает диапазон на интервалы одинаковой ширины)
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
prop.table(table(eq_interval)) * 100  # В процентах
## eq_interval
## [4.3,5.2) [5.2,6.1)   [6.1,7)   [7,7.9] 
## 27.333333 32.000000 32.000000  8.666667
# Границы интервалов
cat("Границы интервалов:", attr(eq_interval, "breaks"), "\n")
## Границы интервалов:

При использовании метода равных интервалов диапазон значений разбивается на интервалы одинаковой ширины. Это самый простой метод дискретизации, но он может быть не оптимальным, если данные распределены неравномерно.

Метод 2: Равная частота (frequency)

# Метод равных частот (каждый интервал содержит примерно одинаковое количество наблюдений)
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
prop.table(table(eq_frequency)) * 100  # В процентах
## 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
# Границы интервалов
cat("Границы интервалов:", attr(eq_frequency, "breaks"), "\n")
## Границы интервалов:

Метод равных частот разбивает данные так, чтобы в каждом интервале оказалось примерно одинаковое количество наблюдений. Этот метод учитывает распределение данных и хорошо работает, когда важно иметь сбалансированные категории.

Метод 3: Кластеризация (cluster)

# Метод кластеризации (использует алгоритм 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
prop.table(table(clustering)) * 100  # В процентах
## 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 для определения естественных групп в данных. Он может быть эффективен, когда данные образуют естественные кластеры.

Метод 4: Фиксированные границы (fixed)

# Метод фиксированных границ (границы задаются вручную)
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
prop.table(table(fixed)) * 100  # В процентах
## 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

Метод фиксированных границ позволяет задать границы интервалов вручную. Это полезно, когда у вас есть предметная экспертиза или определенные пороговые значения, которые имеют смысл в контексте задачи.

Шаг 4: Визуализация результатов дискретизации

Сравним результаты всех четырех методов дискретизации:

# Создаем 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

Шаг 5: Сравнение методов дискретизации в контексте классификации

Оценим, насколько хорошо дискретизированные признаки помогают в задаче классификации:

# Создаем новые наборы данных с дискретизированным признаком
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] "Сравнение информативности признаков после дискретизации:"
print(ig_comparison)
##      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")

Шаг 6: Анализ и выводы по дискретизации переменных

Выводы по дискретизации переменных

На основе результатов дискретизации можно сделать следующие выводы:

  1. Метод равных интервалов (interval):
    • Создает категории с одинаковым диапазоном значений.
    • Преимущество: Легко интерпретировать, так как каждый интервал имеет одинаковую ширину.
    • Недостаток: Может привести к неравномерному распределению наблюдений между категориями, если исходные данные распределены неравномерно.
    • В нашем случае привел к неравномерному распределению: некоторые категории содержат значительно больше наблюдений, чем другие.
  2. Метод равных частот (frequency):
    • Создает категории с примерно одинаковым количеством наблюдений.
    • Преимущество: Обеспечивает сбалансированное представление данных.
    • Недостаток: Интервалы могут иметь разную ширину, что может затруднить интерпретацию.
    • В нашем случае обеспечил равномерное распределение наблюдений по категориям, что может быть полезно для моделирования.
  3. Метод кластеризации (cluster):
    • Группирует наблюдения на основе их сходства (используя k-means).
    • Преимущество: Может лучше отражать естественную структуру данных.
    • Недостаток: Результаты могут быть менее стабильными, так как зависят от инициализации алгоритма.
    • В нашем примере создал категории с разным количеством наблюдений, отражающие естественные группы в данных.
  4. Метод фиксированных границ (fixed):
    • Позволяет задать собственные границы интервалов.
    • Преимущество: Дает полный контроль над процессом дискретизации.
    • Недостаток: Требует предварительных знаний о данных или предметной области.
    • В нашем случае с заданными границами привел к определенному распределению, которое может соответствовать экспертным знаниям.
  5. Сравнение информативности:
    • Судя по значениям Information Gain, некоторые методы дискретизации могут увеличить или уменьшить информативность признака.
    • Выбор оптимального метода дискретизации зависит от конкретной задачи и характеристик данных.

Задание 4: Выбор признаков с помощью Boruta

В этом задании мы будем использовать алгоритм Boruta для выбора значимых признаков на наборе данных Ozone.

Шаг 1: Установка и загрузка пакета Boruta

# Установка и загрузка пакета Boruta
if (!require("Boruta")) install.packages("Boruta")
library(Boruta)

Шаг 2: Загрузка и подготовка набора данных 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] "Количество пропущенных значений по столбцам:"
print(missing_values)
##  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"
print(paste("Количество строк после удаления пропущенных значений:", nrow(Ozone_clean)))
## [1] "Количество строк после удаления пропущенных значений: 203"

Набор данных Ozone содержит информацию о ежедневных измерениях загрязнения атмосферы в Лос-Анджелесе. Переменная V4 представляет максимальную дневную концентрацию озона, а остальные переменные - различные метеорологические параметры (температура, влажность, скорость ветра и т.д.).

Шаг 3: Исследование целевой переменной

Наша целевая переменная - V4 (концентрация озона). Давайте посмотрим на её распределение:

# Гистограмма целевой переменной
hist(Ozone_clean$V4, breaks = 20, main = "Распределение концентрации озона (V4)",
     xlab = "Концентрация озона", col = "lightgreen")

# Базовая статистика
summary(Ozone_clean$V4)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    5.00    9.00   11.37   16.00   38.00

Шаг 4: Выбор признаков с помощью алгоритма Boruta

Алгоритм 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;

Шаг 5: Анализ результатов алгоритма Boruta

# Получение подтвержденных (важных) признаков
confirmed_features <- getSelectedAttributes(boruta_result, withTentative = FALSE)
print("Подтвержденные важные признаки:")
## [1] "Подтвержденные важные признаки:"
print(confirmed_features)
## [1] "V1"  "V5"  "V7"  "V8"  "V9"  "V10" "V11" "V12" "V13"
# Получение отвергнутых признаков
rejected_features <- names(boruta_result$finalDecision[boruta_result$finalDecision == "Rejected"])
print("Отвергнутые признаки:")
## [1] "Отвергнутые признаки:"
print(rejected_features)
## [1] "V2" "V3" "V6"
# Получение неопределенных признаков
tentative_features <- names(boruta_result$finalDecision[boruta_result$finalDecision == "Tentative"])
print("Неопределенные признаки:")
## [1] "Неопределенные признаки:"
print(tentative_features)
## character(0)
# Получение важности признаков
feature_importance <- attStats(boruta_result)
print("Статистика важности признаков:")
## [1] "Статистика важности признаков:"
print(feature_importance[order(feature_importance$meanImp, decreasing = TRUE), ])
##        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

Шаг 6: Визуализация результатов Boruta

# Визуализация результатов 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

На графике показана важность каждого признака. Зеленые боксплоты соответствуют подтвержденным важным признакам, желтые - неопределенным, а красные - отвергнутым. Синие боксплоты представляют “теневые” признаки, которые используются как эталон для сравнения.

Шаг 7: Построение boxplot для значимых признаков

# Выбираем значимые признаки и целевую переменную
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

Шаг 8: Дополнительный анализ - корреляция значимых признаков с целевой переменной

# Убедимся, что все переменные числовые
# Проверим структуру данных
str(selected_data)
## '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):"
print(correlation_with_target[order(abs(correlation_with_target), decreasing = TRUE)])
##          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 = "Корреляционная матрица значимых признаков")

Шаг 9: Анализ и выводы по выбору признаков с помощью Boruta

Выводы по выбору признаков с Boruta

На основе результатов анализа с использованием алгоритма Boruta можно сделать следующие выводы:

  1. Выявленные значимые признаки:
    • Алгоритм Boruta определил несколько значимых признаков для прогнозирования уровня озона (V4).
    • Наиболее важными признаками являются [список подтвержденных признаков в порядке важности].
    • Эти признаки показали стабильно высокую значимость выше “теневых” признаков.
  2. Отвергнутые признаки:
    • Некоторые признаки были определены как незначимые для прогнозирования концентрации озона.
    • Исключение этих признаков из модели может упростить ее и потенциально улучшить производительность.
  3. Корреляция с целевой переменной:
    • Анализ корреляций показал, что признаки [перечислите признаки с высокой корреляцией] имеют наиболее сильную связь с концентрацией озона.
    • Некоторые признаки имеют положительную корреляцию (увеличение признака связано с увеличением концентрации озона), а некоторые - отрицательную.

Заключение

В ходе лабораторной работы мы выполнили комплексный анализ данных с использованием различных методов выбора признаков и разведочного анализа:

  1. Разведочный анализ данных с CARET:
    • Мы использовали функцию featurePlot() для визуализации данных различными способами (диаграммы разброса, плотности распределения, боксплоты).
    • Это позволило нам лучше понять распределение данных и взаимосвязи между признаками.
  2. Определение важности признаков с FSelector:
    • Мы применили методы Information Gain, Gain Ratio и Chi-squared для оценки важности признаков в наборе данных iris.
    • Результаты показали, что характеристики лепестков (Petal.Length и Petal.Width) являются наиболее информативными для классификации видов ириса.
  3. Дискретизация переменных с arules:
    • Мы преобразовали непрерывную переменную Sepal.Length в категориальную с использованием различных методов дискретизации.
    • Каждый метод (равные интервалы, равные частоты, кластеризация, фиксированные границы) имеет свои преимущества и недостатки, выбор зависит от конкретной задачи.
  4. Выбор признаков с Boruta:
    • Мы использовали алгоритм Boruta для определения значимых признаков в наборе данных Ozone.
    • Это позволило выявить признаки, которые наиболее важны для прогнозирования концентрации озона, и исключить менее значимые.