Лабораторная работа №4 Способы подготовки исходных данных
Анализ данных
Быков Александр
2026-02-22
Введение
В данной лабораторной работе рассматриваются различные способы подготовки исходных данных в языке R. Будут изучены методы очистки данных от пропущенных значений (NA), обработки выбросов, удаления дублируемых записей, а также методы заполнения пропусков с помощью статистических моделей.
Задание 1
Задание: Сформируйте свой собственный датасет с помощью функции c (конкатенация), в котором содержатся числовые данные и NA значения.
# Создаем числовой вектор с NA значениями
x <- c(7, 2, NA, 8, NA, 9, 1, 15, NA, 12, 4, NA, 6)
# Выводим созданный датасет
print("Созданный датасет с NA значениями:")## [1] "Созданный датасет с NA значениями:"## [1] 7 2 NA 8 NA 9 1 15 NA 12 4 NA 6##
## Количество NA значений: 4## Общее количество элементов: 13Задание 2
Задание: Проведите очистку данных с использованием
функции is.na() и выведите “чистый” датасет.
## [1] "Исходный датасет:"## [1] 7 2 NA 8 NA 9 1 15 NA 12 4 NA 6# Определяем позиции NA значений
bad <- is.na(x)
cat("\nЛогический вектор is.na(x) - TRUE означает NA:\n")##
## Логический вектор is.na(x) - TRUE означает NA:## [1] FALSE FALSE TRUE FALSE TRUE FALSE FALSE FALSE TRUE FALSE FALSE TRUE
## [13] FALSE# Извлекаем только "хорошие" значения (не NA)
clean_x <- x[!bad]
cat("\n'Чистый' датасет (без NA):\n")##
## 'Чистый' датасет (без NA):## [1] 7 2 8 9 1 15 12 4 6# Альтернативный способ - использование na.omit()
clean_x_alt <- na.omit(x)
cat("\nАльтернативный способ (na.omit):\n")##
## Альтернативный способ (na.omit):## [1] 7 2 8 9 1 15 12 4 6Задание 3
Задание: Сгенерируйте таблицу данных с числовыми и
текстовыми столбцами. Очистите данные с помощью функции
complete.cases().
# Создаем текстовый вектор с NA
x <- c("a", "b", NA, "d", NA, "f", "r", NA, "ya")
# Создаем числовой вектор с NA
y <- c(1, 2, NA, 5, NA, 7, NA, 29, 31)
# Создаем таблицу данных
df <- data.frame(text_col = x, number_col = y)
print("Исходная таблица данных:")## [1] "Исходная таблица данных:"## text_col number_col
## 1 a 1
## 2 b 2
## 3 <NA> NA
## 4 d 5
## 5 <NA> NA
## 6 f 7
## 7 r NA
## 8 <NA> 29
## 9 ya 31# Применяем complete.cases() для определения полных строк
good <- complete.cases(df)
cat("\nЛогический вектор complete.cases() - TRUE означает полную строку:\n")##
## Логический вектор complete.cases() - TRUE означает полную строку:## [1] TRUE TRUE FALSE TRUE FALSE TRUE FALSE FALSE TRUE# Извлекаем только полные строки
df_clean <- df[good, ]
cat("\n'Чистая' таблица данных (только полные строки):\n")##
## 'Чистая' таблица данных (только полные строки):## text_col number_col
## 1 a 1
## 2 b 2
## 4 d 5
## 6 f 7
## 9 ya 31##
## --- Очистка отдельных векторов ---## Чистый текстовый вектор:## [1] "a" "b" "d" "f" "ya"## Чистый числовой вектор:## [1] 1 2 5 7 31Задание 4
Задание: Проанализируйте датасет airquality с
пропусками. С использованием функции preProcess из пакета
caret, заполните пропуски предсказанными значениями (среднее,
медиана).
# Загружаем необходимые пакеты
library(caret)
# Загружаем датасет airquality
data(airquality)
# Просматриваем структуру данных
print("Структура датасета airquality:")## [1] "Структура датасета airquality:"## 'data.frame': 153 obs. of 6 variables:
## $ Ozone : int 41 36 12 18 NA 28 23 19 8 NA ...
## $ Solar.R: int 190 118 149 313 NA NA 299 99 19 194 ...
## $ Wind : num 7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ...
## $ Temp : int 67 72 74 62 56 66 65 59 61 69 ...
## $ Month : int 5 5 5 5 5 5 5 5 5 5 ...
## $ Day : int 1 2 3 4 5 6 7 8 9 10 ...## [1] "\nПервые 10 строк датасета:"## Ozone Solar.R Wind Temp Month Day
## 1 41 190 7.4 67 5 1
## 2 36 118 8.0 72 5 2
## 3 12 149 12.6 74 5 3
## 4 18 313 11.5 62 5 4
## 5 NA NA 14.3 56 5 5
## 6 28 NA 14.9 66 5 6
## 7 23 299 8.6 65 5 7
## 8 19 99 13.8 59 5 8
## 9 8 19 20.1 61 5 9
## 10 NA 194 8.6 69 5 10## [1] "\nКоличество NA в каждом столбце:"## Ozone Solar.R Wind Temp Month Day
## 37 7 0 0 0 0# Определяем строки с пропусками
ind <- apply(airquality, 1, function(x) sum(is.na(x))) > 0
cat("\nСтроки с пропущенными значениями (до заполнения):\n")##
## Строки с пропущенными значениями (до заполнения):## Ozone Solar.R Wind Temp Month Day
## 5 NA NA 14.3 56 5 5
## 6 28 NA 14.9 66 5 6
## 10 NA 194 8.6 69 5 10
## 11 7 NA 6.9 74 5 11
## 25 NA 66 16.6 57 5 25
## 26 NA 266 14.9 58 5 26
## 27 NA NA 8.0 57 5 27
## 32 NA 286 8.6 78 6 1
## 33 NA 287 9.7 74 6 2
## 34 NA 242 16.1 67 6 3
## 35 NA 186 9.2 84 6 4
## 36 NA 220 8.6 85 6 5
## 37 NA 264 14.3 79 6 6
## 39 NA 273 6.9 87 6 8
## 42 NA 259 10.9 93 6 11
## 43 NA 250 9.2 92 6 12
## 45 NA 332 13.8 80 6 14
## 46 NA 322 11.5 79 6 15
## 52 NA 150 6.3 77 6 21
## 53 NA 59 1.7 76 6 22
## 54 NA 91 4.6 76 6 23
## 55 NA 250 6.3 76 6 24
## 56 NA 135 8.0 75 6 25
## 57 NA 127 8.0 78 6 26
## 58 NA 47 10.3 73 6 27
## 59 NA 98 11.5 80 6 28
## 60 NA 31 14.9 77 6 29
## 61 NA 138 8.0 83 6 30
## 65 NA 101 10.9 84 7 4
## 72 NA 139 8.6 82 7 11
## 75 NA 291 14.9 91 7 14
## 83 NA 258 9.7 81 7 22
## 84 NA 295 11.5 82 7 23
## 96 78 NA 6.9 86 8 4
## 97 35 NA 7.4 85 8 5
## 98 66 NA 4.6 87 8 6
## 102 NA 222 8.6 92 8 10
## 103 NA 137 11.5 86 8 11
## 107 NA 64 11.5 79 8 15
## 115 NA 255 12.6 75 8 23
## 119 NA 153 5.7 88 8 27
## 150 NA 145 13.2 77 9 27##
## Заполнение медианой (medianImpute)# Сохраняем копию данных
airquality_median <- airquality
# Создаем препроцессор для числовых столбцов
pPmI <- preProcess(airquality_median[, c("Ozone", "Solar.R")],
method = "medianImpute"
)
# Применяем препроцессор
airquality_median[, c("Ozone", "Solar.R")] <- predict(
pPmI,
airquality_median[, c("Ozone", "Solar.R")]
)
print("Строки после заполнения медианой:")## [1] "Строки после заполнения медианой:"## Ozone Solar.R Wind Temp Month Day
## 5 31.5 205 14.3 56 5 5
## 6 28.0 205 14.9 66 5 6
## 10 31.5 194 8.6 69 5 10
## 11 7.0 205 6.9 74 5 11
## 25 31.5 66 16.6 57 5 25
## 26 31.5 266 14.9 58 5 26
## 27 31.5 205 8.0 57 5 27
## 32 31.5 286 8.6 78 6 1
## 33 31.5 287 9.7 74 6 2
## 34 31.5 242 16.1 67 6 3
## 35 31.5 186 9.2 84 6 4
## 36 31.5 220 8.6 85 6 5
## 37 31.5 264 14.3 79 6 6
## 39 31.5 273 6.9 87 6 8
## 42 31.5 259 10.9 93 6 11
## 43 31.5 250 9.2 92 6 12
## 45 31.5 332 13.8 80 6 14
## 46 31.5 322 11.5 79 6 15
## 52 31.5 150 6.3 77 6 21
## 53 31.5 59 1.7 76 6 22
## 54 31.5 91 4.6 76 6 23
## 55 31.5 250 6.3 76 6 24
## 56 31.5 135 8.0 75 6 25
## 57 31.5 127 8.0 78 6 26
## 58 31.5 47 10.3 73 6 27
## 59 31.5 98 11.5 80 6 28
## 60 31.5 31 14.9 77 6 29
## 61 31.5 138 8.0 83 6 30
## 65 31.5 101 10.9 84 7 4
## 72 31.5 139 8.6 82 7 11
## 75 31.5 291 14.9 91 7 14
## 83 31.5 258 9.7 81 7 22
## 84 31.5 295 11.5 82 7 23
## 96 78.0 205 6.9 86 8 4
## 97 35.0 205 7.4 85 8 5
## 98 66.0 205 4.6 87 8 6
## 102 31.5 222 8.6 92 8 10
## 103 31.5 137 11.5 86 8 11
## 107 31.5 64 11.5 79 8 15
## 115 31.5 255 12.6 75 8 23
## 119 31.5 153 5.7 88 8 27
## 150 31.5 145 13.2 77 9 27##
## Количество NA после заполнения медианой:## Ozone Solar.R Wind Temp Month Day
## 0 0 0 0 0 0##
## Сравнение исходных и заполненных значений:comparison <- data.frame(
Строка = which(ind),
Ozone_исходный = airquality[ind, "Ozone"],
Ozone_заполненный = airquality_median[ind, "Ozone"],
Solar_R_исходный = airquality[ind, "Solar.R"],
Solar_R_заполненный = airquality_median[ind, "Solar.R"]
)
print(head(comparison, 10))## Строка Ozone_исходный Ozone_заполненный Solar_R_исходный Solar_R_заполненный
## 1 5 NA 31.5 NA 205
## 2 6 28 28.0 NA 205
## 3 10 NA 31.5 194 194
## 4 11 7 7.0 NA 205
## 5 25 NA 31.5 66 66
## 6 26 NA 31.5 266 266
## 7 27 NA 31.5 NA 205
## 8 32 NA 31.5 286 286
## 9 33 NA 31.5 287 287
## 10 34 NA 31.5 242 242Задание 5
Задание: Сгенерируйте два числовых набора данных и
добавьте в них выбросы. С использованием функции boxplot,
обнаружьте выбросы и удалить их.
# Создаем два числовых набора данных с выбросами
x <- c(
2.633213, 2.654674, 2.746650, 2.657763, 2.525229, 2.549804, 2.537088,
1.974909, 1.838017, 1.791683, 1.782088, 1.664908, 1.689402, 1.688826,
1.661763, 1.734322, 1.744875, 1.710471, 1.735690, 1.800677, 1.607354,
1.896810, 2.294757
)
y <- c(
4.358015, 4.489513, 4.560919, 4.613810, 4.599738, 4.621614, 4.633119,
4.616862, 4.754681, 4.849953, 4.945791, 5.019631, 4.805033, 4.989170,
5.024305, 5.065325, 4.970247, 4.998086, 5.096887, 4.977657, 4.888269,
3.479053, 2.878145
)
# Создаем DataFrame
df_outliers <- data.frame(x = x, y = y)
print("Исходные данные:")## [1] "Исходные данные:"## x y
## 1 2.633213 4.358015
## 2 2.654674 4.489513
## 3 2.746650 4.560919
## 4 2.657763 4.613810
## 5 2.525229 4.599738
## 6 2.549804 4.621614
## 7 2.537088 4.633119
## 8 1.974909 4.616862
## 9 1.838017 4.754681
## 10 1.791683 4.849953
## 11 1.782088 4.945791
## 12 1.664908 5.019631
## 13 1.689402 4.805033
## 14 1.688826 4.989170
## 15 1.661763 5.024305
## 16 1.734322 5.065325
## 17 1.744875 4.970247
## 18 1.710471 4.998086
## 19 1.735690 5.096887
## 20 1.800677 4.977657
## 21 1.607354 4.888269
## 22 1.896810 3.479053
## 23 2.294757 2.878145# Визуализация исходных данных
par(mfrow = c(2, 2))
# Scatter plot исходных данных
plot(x, y,
main = "Исходные данные",
xlab = "X", ylab = "Y", pch = 19, col = "blue"
)
# Boxplot для x
boxplot(x, main = "Boxplot для X", col = "lightblue")
# Boxplot для y
boxplot(y, main = "Boxplot для Y", col = "lightgreen")
# Получаем выбросы
outliers_x <- boxplot.stats(x)$out
outliers_y <- boxplot.stats(y)$out
cat("\nВыбросы в X:\n")##
## Выбросы в X:## numeric(0)## Выбросы в Y:## [1] 3.479053 2.878145# Находим индексы выбросов в Y
ind <- which(y %in% boxplot.stats(y)$out)
cat("\nИндексы выбросов в Y:\n")##
## Индексы выбросов в Y:## [1] 22 23# Сохраняем координаты точек-выбросов
vybrosy <- data.frame(x = x[ind], y = y[ind])
cat("\nКоординаты точек-выбросов:\n")##
## Координаты точек-выбросов:## x y
## 1 1.896810 3.479053
## 2 2.294757 2.878145
plot(x, y,
col = "green", pch = 18, ylim = c(0, max(y)),
main = "Данные с выделенными\nвыбросами",
xlab = "X", ylab = "Y"
)
points(vybrosy$x, vybrosy$y, col = "red", pch = 18, cex = 2)
legend("topright",
legend = c("Нормальные", "Выбросы"),
col = c("green", "red"), pch = 18
)
# Удаляем выбросы
x_clean <- x[-ind]
y_clean <- y[-ind]
# Визуализация очищенных данных
plot(x_clean, y_clean,
col = "purple", pch = 16, ylim = c(0, max(y)),
main = "Очищенные данные\n(без выбросов)",
xlab = "X", ylab = "Y"
)
par(mfrow = c(1, 1))
# Boxplot после удаления выбросов
boxplot(y_clean, main = "Boxplot Y после удаления выбросов", col = "lightgreen")
##
## Размер данных до очистки: 23## Размер данных после очистки: 21Задание 6
Задание: Сгенерируйте таблицу данных, в которой
дублируются строки. Удалите строки с использованием функций
unique() и duplicated(). Сравните
результаты.
# Создаем данные с дублируемыми строками
a <- c(rep("A", 3), rep("B", 3), rep("C", 2))
b <- c(1, 1, 2, 4, 1, 1, 2, 2)
df <- data.frame(category = a, value = b)
print("Исходный датафрейм:")## [1] "Исходный датафрейм:"## category value
## 1 A 1
## 2 A 1
## 3 A 2
## 4 B 4
## 5 B 1
## 6 B 1
## 7 C 2
## 8 C 2##
## Метод duplicated()# duplicated() возвращает TRUE для дублирующихся строк (кроме первого вхождения)
dup_mask <- duplicated(df)
print("Маска дубликатов (TRUE = дубликат):")## [1] "Маска дубликатов (TRUE = дубликат):"## [1] FALSE TRUE FALSE FALSE FALSE TRUE FALSE TRUE##
## Дублирующиеся строки:## category value
## 2 A 1
## 6 B 1
## 8 C 2# Удаляем дубликаты (оставляем только уникальные)
df_clean_dup <- df[!duplicated(df), ]
cat("\nДатафрейм после удаления дубликатов (!duplicated):\n")##
## Датафрейм после удаления дубликатов (!duplicated):## category value
## 1 A 1
## 3 A 2
## 4 B 4
## 5 B 1
## 7 C 2##
## Метод unique()## [1] "Датафрейм после применения unique():"## category value
## 1 A 1
## 3 A 2
## 4 B 4
## 5 B 1
## 7 C 2##
## Сравнение результатов## Исходное количество строк: 8## После !duplicated(): 5## После unique(): 5# Проверяем идентичность результатов
identical_result <- identical(df_clean_dup, df_clean_unique)
cat("\nРезультаты идентичны:", identical_result, "\n")##
## Результаты идентичны: TRUE# Дополнительно: поиск дубликатов по конкретному столбцу
cat("\n Дубликаты по столбцу 'category' \n")##
## Дубликаты по столбцу 'category'## [1] "Маска дубликатов по category:"## [1] FALSE TRUE TRUE FALSE TRUE TRUE FALSE TRUEdf_unique_category <- df[!duplicated(df$category), ]
cat("\nУникальные записи по category (первое вхождение):\n")##
## Уникальные записи по category (первое вхождение):## category value
## 1 A 1
## 4 B 4
## 7 C 2Задание 7
Задание: Обработайте пропуски в данных с
использованием пакета mice.
# Проверяем наличие пакета mice
mice_available <- requireNamespace("mice", quietly = TRUE)
# Создаем датасет с пропущенными значениями
set.seed(123)
dataset <- data.frame(
var1 = rnorm(20, 0, 1),
var2 = rnorm(20, 5, 1)
)
# Вносим пропущенные значения
dataset[c(2, 5, 7, 10), 1] <- NA
dataset[c(4, 8, 19), 2] <- NA
print("Исходный датасет с пропусками:")## [1] "Исходный датасет с пропусками:"## var1 var2
## 1 -0.56047565 3.932176
## 2 NA 4.782025
## 3 1.55870831 3.973996
## 4 0.07050839 NA
## 5 NA 4.374961
## 6 1.71506499 3.313307
## 7 NA 5.837787
## 8 -1.26506123 NA
## 9 -0.68685285 3.861863
## 10 NA 6.253815
## 11 1.22408180 5.426464
## 12 0.35981383 4.704929
## 13 0.40077145 5.895126
## 14 0.11068272 5.878133
## 15 -0.55584113 5.821581
## 16 1.78691314 5.688640
## 17 0.49785048 5.553918
## 18 -1.96661716 4.938088
## 19 0.70135590 NA
## 20 -0.47279141 4.619529##
## Статистика по датасету:## var1 var2
## Min. :-1.9666 Min. :3.313
## 1st Qu.:-0.5570 1st Qu.:4.375
## Median : 0.2352 Median :4.938
## Mean : 0.1824 Mean :4.992
## 3rd Qu.: 0.8320 3rd Qu.:5.822
## Max. : 1.7869 Max. :6.254
## NA's :4 NA's :3##
## Паттерн пропущенных значенийna_pattern <- data.frame(
var1_missing = is.na(dataset$var1),
var2_missing = is.na(dataset$var2)
)
print("Строки с пропусками в var1:")## [1] "Строки с пропусками в var1:"## [1] 2 5 7 10## [1] "Строки с пропусками в var2:"## [1] 4 8 19if (mice_available) {
# Используем пакет mice если он доступен
library(mice)
# Визуализация паттерна пропусков
cat("\nПаттерн пропущенных значений (mice):\n")
md.pattern(dataset, rotate.names = TRUE)
# Применяем MICE для заполнения пропусков
imp <- mice(dataset,
method = "pmm", m = 5, maxit = 50, seed = 500,
print = FALSE
)
cat("\nИнформация об импутации:\n")
print(imp)
# Получаем заполненный датасет
dataset_complete <- complete(imp, 1)
cat("\nДатасет после заполнения пропусков (MICE - PMM):\n")
print(dataset_complete)
} else {
# Альтернативный метод без mice
cat("\n Пакет mice недоступен. Используем альтернативные методы \n")
# Сохраняем исходные данные
dataset_original <- dataset
# --- Метод 1: Заполнение средним ---
cat("\n--- Метод 1: Заполнение средним значением ---\n")
dataset_mean <- dataset
dataset_mean$var1[is.na(dataset_mean$var1)] <- mean(dataset$var1, na.rm = TRUE)
dataset_mean$var2[is.na(dataset_mean$var2)] <- mean(dataset$var2, na.rm = TRUE)
print(dataset_mean)
# --- Метод 2: Заполнение медианой ---
cat("\n--- Метод 2: Заполнение медианой ---\n")
dataset_median <- dataset
dataset_median$var1[is.na(dataset_median$var1)] <- median(dataset$var1, na.rm = TRUE)
dataset_median$var2[is.na(dataset_median$var2)] <- median(dataset$var2, na.rm = TRUE)
print(dataset_median)
# --- Метод 3: Hot-Deck Imputation (ближайшее наблюдение) ---
cat("\n--- Метод 3: Hot-Deck Imputation (случайное из наблюдаемых) ---\n")
dataset_hotdeck <- dataset
set.seed(42)
# Заменяем NA случайным значением из непропущенных
dataset_hotdeck$var1[is.na(dataset_hotdeck$var1)] <-
sample(na.omit(dataset$var1), sum(is.na(dataset$var1)), replace = TRUE)
dataset_hotdeck$var2[is.na(dataset_hotdeck$var2)] <-
sample(na.omit(dataset$var2), sum(is.na(dataset$var2)), replace = TRUE)
print(dataset_hotdeck)
# --- Метод 4: Линейная интерполяция ---
cat("\n--- Метод 4: Простая регрессионная импутация ---\n")
dataset_reg <- dataset
# Для var1: используем var2 как предиктор (если var2 не NA)
lm_var1 <- lm(var1 ~ var2, data = dataset, na.action = na.omit)
na_idx_var1 <- which(is.na(dataset$var1) & !is.na(dataset$var2))
if (length(na_idx_var1) > 0) {
dataset_reg$var1[na_idx_var1] <- predict(lm_var1,
newdata = dataset[na_idx_var1, ]
)
}
# Оставшиеся NA заполняем средним
dataset_reg$var1[is.na(dataset_reg$var1)] <- mean(dataset$var1, na.rm = TRUE)
# Для var2: используем var1 как предиктор
lm_var2 <- lm(var2 ~ var1, data = dataset_reg, na.action = na.omit)
na_idx_var2 <- which(is.na(dataset_reg$var2))
if (length(na_idx_var2) > 0) {
dataset_reg$var2[na_idx_var2] <- predict(lm_var2,
newdata = dataset_reg[na_idx_var2, ]
)
}
print(dataset_reg)
dataset_complete <- dataset_reg
}##
## Паттерн пропущенных значений (mice):
##
## Информация об импутации:
## Class: mids
## Number of multiple imputations: 5
## Imputation methods:
## var1 var2
## "pmm" "pmm"
## PredictorMatrix:
## var1 var2
## var1 0 1
## var2 1 0
##
## Датасет после заполнения пропусков (MICE - PMM):
## var1 var2
## 1 -0.56047565 3.932176
## 2 -0.55584113 4.782025
## 3 1.55870831 3.973996
## 4 0.07050839 5.426464
## 5 0.49785048 4.374961
## 6 1.71506499 3.313307
## 7 0.11068272 5.837787
## 8 -1.26506123 5.688640
## 9 -0.68685285 3.861863
## 10 -0.55584113 6.253815
## 11 1.22408180 5.426464
## 12 0.35981383 4.704929
## 13 0.40077145 5.895126
## 14 0.11068272 5.878133
## 15 -0.55584113 5.821581
## 16 1.78691314 5.688640
## 17 0.49785048 5.553918
## 18 -1.96661716 4.938088
## 19 0.70135590 5.426464
## 20 -0.47279141 4.619529##
## Статистика после заполнения:## var1 var2
## Min. :-1.9666 Min. :3.313
## 1st Qu.:-0.5558 1st Qu.:4.558
## Median : 0.1107 Median :5.426
## Mean : 0.1207 Mean :5.070
## 3rd Qu.: 0.5487 3rd Qu.:5.722
## Max. : 1.7869 Max. :6.254##
## Количество NA после импутации:## var1 var2
## 0 0##
## Сравнение статистик до и после импутацииcomparison <- data.frame(
Показатель = c("Среднее var1", "Медиана var1", "Среднее var2", "Медиана var2"),
До_импутации = c(
round(mean(dataset$var1, na.rm = TRUE), 4),
round(median(dataset$var1, na.rm = TRUE), 4),
round(mean(dataset$var2, na.rm = TRUE), 4),
round(median(dataset$var2, na.rm = TRUE), 4)
),
После_импутации = c(
round(mean(dataset_complete$var1), 4),
round(median(dataset_complete$var1), 4),
round(mean(dataset_complete$var2), 4),
round(median(dataset_complete$var2), 4)
)
)
print(comparison)## Показатель До_импутации После_импутации
## 1 Среднее var1 0.1824 0.1207
## 2 Медиана var1 0.2352 0.1107
## 3 Среднее var2 4.9915 5.0699
## 4 Медиана var2 4.9381 5.4265Задание 8
Задание: Разберите пример с мультиколлинеарностью.
# Загружаем необходимые пакеты
library(car)
# Создаем синтетические данные для демонстрации мультиколлинеарности
set.seed(42)
n <- 100
# Базовые переменные
age <- round(runif(n, 20, 60))
education <- round(runif(n, 8, 18)) # годы образования
# experience сильно коррелирует с age (это типичная проблема)
experience <- age - education - 6 + rnorm(n, 0, 2)
experience <- pmax(0, experience) # не отрицательный опыт
# Зависимая переменная
wage <- 10 + 0.5 * age + 2 * education + 1.5 * experience + rnorm(n, 0, 5)
# Создаем датафрейм
data_mc <- data.frame(
wage = wage,
age = age,
education = education,
experience = experience
)
print("Структура данных:")## [1] "Структура данных:"## 'data.frame': 100 obs. of 4 variables:
## $ wage : num 115.6 124.8 70.8 128.8 92.6 ...
## $ age : num 57 57 31 53 46 41 49 25 46 48 ...
## $ education : num 14 10 10 12 17 18 15 15 13 8 ...
## $ experience: num 39.4 43.1 13 38.7 21.7 ...##
## Описательная статистика:## wage age education experience
## Min. : 38.43 Min. :20.00 Min. : 8.00 Min. : 0.00
## 1st Qu.: 69.82 1st Qu.:30.00 1st Qu.:10.75 1st Qu.:12.85
## Median : 89.51 Median :41.50 Median :14.00 Median :21.90
## Mean : 89.34 Mean :40.95 Mean :13.15 Mean :21.74
## 3rd Qu.:110.01 3rd Qu.:50.25 3rd Qu.:16.00 3rd Qu.:32.38
## Max. :138.59 Max. :60.00 Max. :18.00 Max. :43.97##
## Корреляционная матрица## wage age education experience
## wage 1.000 0.966 0.050 0.936
## age 0.966 1.000 -0.031 0.966
## education 0.050 -0.031 1.000 -0.244
## experience 0.936 0.966 -0.244 1.000# Визуализация корреляций
pairs(data_mc,
main = "Scatter Plot Matrix",
pch = 19, col = rgb(0, 0, 1, 0.5)
)
# --- Оценка модели с мультиколлинеарностью ---
cat("\n Модель с потенциальной мультиколлинеарностью \n")##
## Модель с потенциальной мультиколлинеарностью##
## Call:
## lm(formula = wage ~ age + education + experience, data = data_mc)
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.3531 -3.4515 -0.0532 3.3745 11.9631
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.2700 3.4989 2.935 0.00417 **
## age 0.1842 0.2815 0.654 0.51457
## education 2.4064 0.3218 7.478 3.55e-11 ***
## experience 1.8342 0.2842 6.455 4.42e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.118 on 96 degrees of freedom
## Multiple R-squared: 0.9583, Adjusted R-squared: 0.957
## F-statistic: 735.8 on 3 and 96 DF, p-value: < 2.2e-16##
## Variance Inflation Factor (VIF)## age education experience
## 43.690257 3.141184 46.417828##
## Интерпретация VIF:## VIF = 1: Нет корреляции между переменной и другими## VIF > 5: Умеренная мультиколлинеарность (требует внимания)## VIF > 10: Сильная мультиколлинеарность (нужно решать)# Определяем проблемные переменные
problematic <- names(vif_values[vif_values > 5])
if (length(problematic) > 0) {
cat("Переменные с VIF > 5:", paste(problematic, collapse = ", "), "\n")
} else {
cat("Нет переменных с VIF > 5\n")
}## Переменные с VIF > 5: age, experience# --- Решение проблемы: удаление коррелированной переменной ---
cat("\n Модель после удаления experience (коррелирует с age) \n")##
## Модель после удаления experience (коррелирует с age)##
## Call:
## lm(formula = wage ~ age + education, data = data_mc)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.494 -4.531 -0.385 4.051 16.434
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.85974 3.62698 -0.237 0.81313
## age 1.98049 0.05077 39.013 < 2e-16 ***
## education 0.69190 0.21640 3.197 0.00187 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.098 on 97 degrees of freedom
## Multiple R-squared: 0.9402, Adjusted R-squared: 0.939
## F-statistic: 763 on 2 and 97 DF, p-value: < 2.2e-16##
## VIF для модели без experience:## age education
## 1.000948 1.000948##
## Сравнение моделейcomparison_models <- data.frame(
Model = c("С experience", "Без experience"),
R_squared = c(summary(fit1)$r.squared, summary(fit2)$r.squared),
Adj_R_squared = c(summary(fit1)$adj.r.squared, summary(fit2)$adj.r.squared),
Max_VIF = c(max(vif_values), max(vif(fit2)))
)
print(comparison_models)## Model R_squared Adj_R_squared Max_VIF
## 1 С experience 0.9583218 0.9570194 46.417828
## 2 Без experience 0.9402329 0.9390006 1.000948# --- Дополнительный метод: анализ собственных значений ---
cat("\n Анализ числа обусловленности \n")##
## Анализ числа обусловленностиX <- model.matrix(fit1)[, -1] # матрица предикторов без intercept
eigenvalues <- eigen(cor(X))$values
condition_number <- sqrt(max(eigenvalues) / min(eigenvalues))
cat("Число обусловленности:", round(condition_number, 2), "\n")## Число обусловленности: 13.56## Если > 30, то серьезная мультиколлинеарностьЗаключение
В данной лабораторной работе были рассмотрены основные методы подготовки данных:
- Создание датасета с NA: использование функции
c()для создания векторов с пропущенными значениями - Очистка данных с
is.na(): идентификация и удаление пропущенных значений - Функция
complete.cases(): работа с таблицами данных и удаление неполных строк - Пакет caret и
preProcess(): заполнение пропусков с помощью медианы - Обнаружение выбросов с
boxplot(): визуализация и удаление аномальных значений - Удаление дубликатов: функции
unique()иduplicated()для работы с повторяющимися записями - Пакет mice: множественная импутация для заполнения пропусков
- Мультиколлинеарность: диагностика с помощью VIF и методы решения проблемы
Все эти методы являются необходимыми инструментами для предварительной обработки данных перед проведением статистического анализа и построения моделей машинного обучения.
Информация о сессии
## R version 4.5.2 (2025-10-31)
## Platform: x86_64-pc-linux-gnu
## Running under: CachyOS
##
## Matrix products: default
## BLAS: /usr/lib/libblas.so.3.12.0
## LAPACK: /usr/lib/liblapack.so.3.12.0 LAPACK version 3.12.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## time zone: Europe/Moscow
## tzcode source: system (glibc)
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] car_3.1-5 carData_3.0-6 mice_3.19.0 caret_7.0-1 lattice_0.22-7
## [6] ggplot2_4.0.2
##
## loaded via a namespace (and not attached):
## [1] tidyselect_1.2.1 timeDate_4052.112 dplyr_1.2.0
## [4] farver_2.1.2 S7_0.2.1 fastmap_1.2.0
## [7] pROC_1.19.0.1 digest_0.6.39 rpart_4.1.24
## [10] timechange_0.4.0 lifecycle_1.0.5 survival_3.8-3
## [13] magrittr_2.0.4 compiler_4.5.2 rlang_1.1.7
## [16] sass_0.4.10 tools_4.5.2 yaml_2.3.12
## [19] data.table_1.18.2.1 knitr_1.51 plyr_1.8.9
## [22] RColorBrewer_1.1-3 abind_1.4-8 withr_3.0.2
## [25] purrr_1.2.1 nnet_7.3-20 grid_4.5.2
## [28] stats4_4.5.2 jomo_2.7-6 future_1.69.0
## [31] globals_0.19.0 scales_1.4.0 iterators_1.0.14
## [34] MASS_7.3-65 cli_3.6.5 rmarkdown_2.30
## [37] reformulas_0.4.4 generics_0.1.4 future.apply_1.20.1
## [40] reshape2_1.4.5 minqa_1.2.8 cachem_1.1.0
## [43] stringr_1.6.0 splines_4.5.2 parallel_4.5.2
## [46] vctrs_0.7.1 hardhat_1.4.2 boot_1.3-32
## [49] glmnet_4.1-10 Matrix_1.7-4 jsonlite_2.0.0
## [52] mitml_0.4-5 Formula_1.2-5 listenv_0.10.0
## [55] foreach_1.5.2 gower_1.0.2 jquerylib_0.1.4
## [58] tidyr_1.3.2 recipes_1.3.1 glue_1.8.0
## [61] parallelly_1.46.1 pan_1.9 nloptr_2.2.1
## [64] codetools_0.2-20 lubridate_1.9.5 stringi_1.8.7
## [67] gtable_0.3.6 shape_1.4.6.1 lme4_1.1-38
## [70] tibble_3.3.1 pillar_1.11.1 htmltools_0.5.9
## [73] ipred_0.9-15 lava_1.8.2 R6_2.6.1
## [76] Rdpack_2.6.5 evaluate_1.0.5 rbibutils_2.4.1
## [79] backports_1.5.0 broom_1.0.12 bslib_0.10.0
## [82] class_7.3-23 Rcpp_1.1.1 nlme_3.1-168
## [85] prodlim_2025.04.28 xfun_0.56 ModelMetrics_1.2.2.2
## [88] pkgconfig_2.0.3