Лабораторная работа 2
Ольховский
2025-09-20
Задание 1: Установка CARET и графический анализ
Шаг 1: Установка и загрузка пакета CARET
# Устанавливаем пакет если еще не установлен
if(!require(caret)) {
install.packages("caret")
library(caret)
}
# Просмотр доступных методов
available_methods <- names(getModelInfo())
cat("Количество доступных методов:", length(available_methods), "\n")## Количество доступных методов: 239cat("Первые 10 методов:\n")## Первые 10 методов:print(available_methods[1:10])## [1] "ada" "AdaBag" "AdaBoost.M1" "adaboost" "amdai"
## [6] "ANFIS" "avNNet" "awnb" "awtan" "bag"Шаг 2: Создание данных и построение графиков
set.seed(123) # для воспроизводимости результатов
# Создание данных
x <- matrix(rnorm(50*5), ncol = 5)
y <- factor(rep(c("A", "B"), 25))
# Сохраняем данные в dataframe
data_df <- data.frame(x, y)
colnames(data_df) <- c("Feature1", "Feature2", "Feature3", "Feature4", "Feature5", "Class")
# Построение графиков
featurePlot(x = data_df[, 1:5],
y = data_df$Class,
plot = "density",
scales = list(x = list(relation = "free"),
y = list(relation = "free")),
adjust = 1.5,
pch = "|",
layout = c(5, 1),
auto.key = list(columns = 2))
# Сохранение графика в jpg
jpeg("feature_density.jpg", width = 1000, height = 600)
featurePlot(x = data_df[, 1:5],
y = data_df$Class,
plot = "density",
scales = list(x = list(relation = "free"),
y = list(relation = "free")),
adjust = 1.5,
pch = "|",
layout = c(5, 1),
auto.key = list(columns = 2))
dev.off()## png
## 2# Boxplot графики
jpeg("feature_boxplot.jpg", width = 1000, height = 600)
featurePlot(x = data_df[, 1:5],
y = data_df$Class,
plot = "box",
scales = list(y = list(relation = "free"),
x = list(rot = 90)),
layout = c(5, 1))
dev.off()## png
## 2Выводы по заданию 1: Графики density и boxplot показывают распределение признаков для двух классов A и B. Анализ позволяет визуально оценить, какие признаки лучше разделяют классы и могут быть наиболее информативными для классификации.
Задание 2: Определение важности признаков с Fselector
Шаг 1: Установка и загрузка пакета
# Установка пакета если необходимо
if(!require(FSelector)) {
install.packages("FSelector")
library(FSelector)
}
# Загрузка данных iris
data(iris)
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Шаг 2: Расчет важности признаков
# Используем информационный выигрыш (information gain) для оценки важности
weights <- information.gain(Species~., iris)
print("Важность признаков (information gain):")## [1] "Важность признаков (information gain):"print(weights)## attr_importance
## Sepal.Length 0.4521286
## Sepal.Width 0.2672750
## Petal.Length 0.9402853
## Petal.Width 0.9554360# Сортируем по важности
sorted_weights <- weights[order(-weights$attr_importance), , drop = FALSE]
print("Отсортированная важность признаков:")## [1] "Отсортированная важность признаков:"print(sorted_weights)## attr_importance
## Petal.Width 0.9554360
## Petal.Length 0.9402853
## Sepal.Length 0.4521286
## Sepal.Width 0.2672750# Визуализация важности признаков
barplot(weights$attr_importance,
names.arg = rownames(weights),
main = "Важность признаков для классификации ирисов",
xlab = "Признаки",
ylab = "Information Gain",
col = "lightblue")
Выводы по заданию 2: На основе анализа информации выигрыша можно сделать вывод, что признаки Petal.Length и Petal.Width являются наиболее важными для классификации видов ирисов, в то время как Sepal.Width имеет наименьшую важность.
Задание 3: Дискретизация переменных с пакетом arules
Шаг 1: Установка и загрузка пакета
if(!require(arules)) {
install.packages("arules")
library(arules)
}
data(iris)Шаг 2: Дискретизация различными методами
# Берем переменную Sepal.Length для дискретизации
sepal_length <- iris$Sepal.Length
# Метод "interval" - равная ширина интервала
disc_interval <- discretize(sepal_length, method = "interval", categories = 4)
table(disc_interval)## disc_interval
## [4.3,5.2) [5.2,6.1) [6.1,7) [7,7.9]
## 41 48 48 13# Метод "frequency" - равная частота
disc_frequency <- discretize(sepal_length, method = "frequency", categories = 4)
table(disc_frequency)## disc_frequency
## [4.3,5.1) [5.1,5.8) [5.8,6.4) [6.4,7.9]
## 32 41 35 42# Метод "cluster" - кластеризация
disc_cluster <- discretize(sepal_length, method = "cluster", categories = 4)
table(disc_cluster)## disc_cluster
## [4.3,4.89) [4.89,5.59) [5.59,6.49) [6.49,7.9]
## 16 43 56 35# Метод "fixed" - задаем границы вручную
disc_fixed <- discretize(sepal_length, method = "fixed",
breaks = c(-Inf, 5.0, 6.0, 7.0, Inf),
labels = c("Короткий", "Средний", "Длинный", "Очень длинный"))
table(disc_fixed)## disc_fixed
## Короткий Средний Длинный Очень длинный
## 22 61 54 13Шаг 3: Сравнение методов
# Создаем таблицу для сравнения
comparison <- data.frame(
Original = sepal_length[1:10],
Interval = disc_interval[1:10],
Frequency = disc_frequency[1:10],
Cluster = disc_cluster[1:10],
Fixed = disc_fixed[1:10]
)
print("Сравнение методов дискретизации (первые 10 наблюдений):")## [1] "Сравнение методов дискретизации (первые 10 наблюдений):"print(comparison)## Original Interval Frequency Cluster Fixed
## 1 5.1 [4.3,5.2) [5.1,5.8) [4.89,5.59) Средний
## 2 4.9 [4.3,5.2) [4.3,5.1) [4.89,5.59) Короткий
## 3 4.7 [4.3,5.2) [4.3,5.1) [4.3,4.89) Короткий
## 4 4.6 [4.3,5.2) [4.3,5.1) [4.3,4.89) Короткий
## 5 5.0 [4.3,5.2) [4.3,5.1) [4.89,5.59) Средний
## 6 5.4 [5.2,6.1) [5.1,5.8) [4.89,5.59) Средний
## 7 4.6 [4.3,5.2) [4.3,5.1) [4.3,4.89) Короткий
## 8 5.0 [4.3,5.2) [4.3,5.1) [4.89,5.59) Средний
## 9 4.4 [4.3,5.2) [4.3,5.1) [4.3,4.89) Короткий
## 10 4.9 [4.3,5.2) [4.3,5.1) [4.89,5.59) Короткий# Визуализация распределения по методам
par(mfrow = c(2, 2))
plot(disc_interval, main = "Метод: Interval", ylab = "Частота")
plot(disc_frequency, main = "Метод: Frequency", ylab = "Частота")
plot(disc_cluster, main = "Метод: Cluster", ylab = "Частота")
plot(disc_fixed, main = "Метод: Fixed", ylab = "Частота")
par(mfrow = c(1, 1))Выводы по заданию 3: Различные методы дискретизации дают разные результаты. Метод “interval” создает интервалы равной ширины, “frequency” - интервалы с равным количеством наблюдений, “cluster” группирует на основе кластеризации, а “fixed” позволяет задать границы вручную. Выбор метода зависит от конкретной задачи и распределения данных.
Задание 4: Выбор признаков с пакетом Boruta
Шаг 1: Установка и загрузка пакетов
# Пытаемся установить mlbench (необязательно)
tryCatch({
install.packages("mlbench", repos = "https://cloud.r-project.org/")
library(mlbench)
}, error = function(e) {
cat("Пакет mlbench не установлен, используем альтернативные данные\n")
})
# Установка Boruta
if(!require(Boruta)) {
install.packages("Boruta", repos = "https://cloud.r-project.org/")
library(Boruta)
}## Используем набор данных Iris для анализа Boruta## Целевая переменная: Species (переименована в Target)## Размер данных: 150 5## Столбцы: Sepal.Length Sepal.Width Petal.Length Petal.Width TargetШаг 2: Применение алгоритма Boruta
set.seed(123) # для воспроизводимости
cat("Запуск алгоритма Boruta...\n")## Запуск алгоритма Boruta...# Выполняем выбор признаков
boruta_result <- Boruta(Target ~ ., data = analysis_data, doTrace = 0)
# Выводим результаты
cat("\n=== РЕЗУЛЬТАТЫ BORUTA ===\n")##
## === РЕЗУЛЬТАТЫ BORUTA ===print(boruta_result)## Boruta performed 9 iterations in 0.1453919 secs.
## 4 attributes confirmed important: Petal.Length, Petal.Width,
## Sepal.Length, Sepal.Width;
## No attributes deemed unimportant.# Визуализация
plot(boruta_result,
las = 2,
cex.axis = 0.8,
main = "Важность признаков - Boruta (Iris dataset)",
xlab = "Признаки",
ylab = "Важность")
Шаг 3: Детальный анализ и сохранение графиков
# Сохраняем график в файл
jpeg("boruta_analysis.jpg", width = 1000, height = 700)
plot(boruta_result,
las = 2,
cex.axis = 0.8,
main = "Важность признаков для набора данных Iris (Boruta)")
dev.off()## png
## 2cat("График сохранен как 'boruta_analysis.jpg'\n")## График сохранен как 'boruta_analysis.jpg'# Детальная статистика
importance_stats <- attStats(boruta_result)
cat("\n=== ДЕТАЛЬНАЯ СТАТИСТИКА ВАЖНОСТИ ===\n")##
## === ДЕТАЛЬНАЯ СТАТИСТИКА ВАЖНОСТИ ===print(importance_stats)## meanImp medianImp minImp maxImp normHits decision
## Sepal.Length 15.38713 15.47046 14.628968 15.83942 1 Confirmed
## Sepal.Width 11.20967 11.42340 9.617839 12.02254 1 Confirmed
## Petal.Length 31.51468 31.56664 29.500303 33.77882 1 Confirmed
## Petal.Width 31.57005 31.56201 30.831324 32.55019 1 Confirmed# Получаем окончательные признаки
final_features <- getSelectedAttributes(boruta_result, withTentative = FALSE)
cat("\n=== ОКОНЧАТЕЛЬНЫЕ ПРИЗНАКИ ===\n")##
## === ОКОНЧАТЕЛЬНЫЕ ПРИЗНАКИ ===cat("Отобранные признаки:", paste(final_features, collapse = ", "), "\n")## Отобранные признаки: Sepal.Length, Sepal.Width, Petal.Length, Petal.Width# Создаем финальный набор данных
if(length(final_features) > 0) {
final_data <- analysis_data[, c(final_features, "Target")]
cat("Размер финального набора:", dim(final_data), "\n")
# Анализ важности
cat("\n=== РАНЖИРОВАНИЕ ПРИЗНАКОВ ПО ВАЖНОСТИ ===\n")
ranked_features <- importance_stats[order(-importance_stats$meanImp), ]
print(ranked_features)
} else {
cat("Не удалось отобрать значимые признаки\n")
}## Размер финального набора: 150 5
##
## === РАНЖИРОВАНИЕ ПРИЗНАКОВ ПО ВАЖНОСТИ ===
## meanImp medianImp minImp maxImp normHits decision
## Petal.Width 31.57005 31.56201 30.831324 32.55019 1 Confirmed
## Petal.Length 31.51468 31.56664 29.500303 33.77882 1 Confirmed
## Sepal.Length 15.38713 15.47046 14.628968 15.83942 1 Confirmed
## Sepal.Width 11.20967 11.42340 9.617839 12.02254 1 ConfirmedШаг 4: Дополнительная визуализация
# Альтернативная визуализация - горизонтальный barplot
importance_df <- attStats(boruta_result)
par(mfrow = c(1, 2))
# Barplot средней важности
barplot(importance_df$meanImp,
names.arg = rownames(importance_df),
horiz = TRUE,
las = 1,
main = "Средняя важность признаков",
xlab = "Важность",
col = ifelse(importance_df$decision == "Confirmed", "green",
ifelse(importance_df$decision == "Tentative", "yellow", "red")))
# Barplot медианной важности
barplot(importance_df$medianImp,
names.arg = rownames(importance_df),
horiz = TRUE,
las = 1,
main = "Медианная важность признаков",
xlab = "Важность",
col = ifelse(importance_df$decision == "Confirmed", "green",
ifelse(importance_df$decision == "Tentative", "yellow", "red")))
par(mfrow = c(1, 1))
# Сохраняем второй график
jpeg("boruta_importance_bars.jpg", width = 1200, height = 600)
par(mfrow = c(1, 2))
barplot(importance_df$meanImp,
names.arg = rownames(importance_df),
horiz = TRUE,
las = 1,
main = "Средняя важность признаков",
xlab = "Важность",
col = ifelse(importance_df$decision == "Confirmed", "green",
ifelse(importance_df$decision == "Tentative", "yellow", "red")))
barplot(importance_df$medianImp,
names.arg = rownames(importance_df),
horiz = TRUE,
las = 1,
main = "Медианная важность признаков",
xlab = "Важность",
col = ifelse(importance_df$decision == "Confirmed", "green",
ifelse(importance_df$decision == "Tentative", "yellow", "red")))
par(mfrow = c(1, 1))
dev.off()## png
## 2cat("Дополнительные графики сохранены как 'boruta_importance_bars.jpg'\n")## Дополнительные графики сохранены как 'boruta_importance_bars.jpg'Выводы по заданию 4:
На основе анализа алгоритмом Boruta можно сделать следующие выводы:
Важные признаки: Алгоритм идентифицировал наиболее значимые признаки для классификации видов ирисов. Признаки, отмеченные как “Confirmed”, имеют статистически значимую важность.
Распределение важности: Boxplot’ы показывают распределение важности каждого признака по сравнению с их “теневыми” копиями. Признаки, чья важность значительно превышает важность теневых признаков, считаются значимыми.
Принятие решений:
- Confirmed: Признаки, однозначно важные для модели
- Tentative: Признаки с неопределенной важностью
- Rejected: Признаки, которые можно исключить из модели
Практическое применение: Результаты Boruta помогают сократить размерность данных, ускорить обучение моделей и улучшить интерпретируемость результатов, удаляя неинформативные признаки.
Заключение
В ходе лабораторной работы были освоены различные методы выбора и преобразования признаков: - Визуальный анализ с помощью пакета CARET - Оценка важности признаков с FSelector - Дискретизация непрерывных переменных с arules - Комплексный выбор признаков с Boruta
Каждый метод имеет свои преимущества и области применения, и их комбинирование позволяет получить более надежные результаты при подготовке данных для машинного обучения.