Шаблон отчёта по ЛР №4 (R)

Обработка пропусков — Palmer Penguins

Author

ФИО студента: Капустинский Артём Евгеньевич

Published

October 31, 2025

1. Краткое описание данных

(Кто/что измеряется, какие основные поля, где пропуски.)

library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.1     ✔ stringr   1.5.2
✔ ggplot2   4.0.0     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.1.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(palmerpenguins)

Присоединяю пакет: 'palmerpenguins'

Следующие объекты скрыты от 'package:datasets':

    penguins, penguins_raw
library(skimr)
library(naniar)

Присоединяю пакет: 'naniar'

Следующий объект скрыт от 'package:skimr':

    n_complete
library(ggplot2)
library(dplyr)
library(tidyr)
data(penguins)
penguins |> head()
# A tibble: 6 × 8
  species island    bill_length_mm bill_depth_mm flipper_length_mm body_mass_g
  <fct>   <fct>              <dbl>         <dbl>             <int>       <int>
1 Adelie  Torgersen           39.1          18.7               181        3750
2 Adelie  Torgersen           39.5          17.4               186        3800
3 Adelie  Torgersen           40.3          18                 195        3250
4 Adelie  Torgersen           NA            NA                  NA          NA
5 Adelie  Torgersen           36.7          19.3               193        3450
6 Adelie  Torgersen           39.3          20.6               190        3650
# ℹ 2 more variables: sex <fct>, year <int>
skimr::skim(penguins)
Data summary
Name penguins
Number of rows 344
Number of columns 8
_______________________
Column type frequency:
factor 3
numeric 5
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
species 0 1.00 FALSE 3 Ade: 152, Gen: 124, Chi: 68
island 0 1.00 FALSE 3 Bis: 168, Dre: 124, Tor: 52
sex 11 0.97 FALSE 2 mal: 168, fem: 165

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
bill_length_mm 2 0.99 43.92 5.46 32.1 39.23 44.45 48.5 59.6 ▃▇▇▆▁
bill_depth_mm 2 0.99 17.15 1.97 13.1 15.60 17.30 18.7 21.5 ▅▅▇▇▂
flipper_length_mm 2 0.99 200.92 14.06 172.0 190.00 197.00 213.0 231.0 ▂▇▃▅▂
body_mass_g 2 0.99 4201.75 801.95 2700.0 3550.00 4050.00 4750.0 6300.0 ▃▇▆▃▂
year 0 1.00 2008.03 0.82 2007.0 2007.00 2008.00 2009.0 2009.0 ▇▁▇▁▇

2. Ход работы

(Кратко: диагностика → базовые подходы → заполнение медианой → групповая медиана → сравнение → визуализация.)

3. Результаты

3.1. Диагностика

  • Таблица/рисунки с пропусками…
naniar::gg_miss_var(penguins) + ggtitle("Доля пропусков по столбцам")

naniar::vis_miss(penguins) + ggtitle("Карта пропусков (NA)")

sort(colSums(is.na(penguins)), decreasing=TRUE)
              sex    bill_length_mm     bill_depth_mm flipper_length_mm 
               11                 2                 2                 2 
      body_mass_g           species            island              year 
                2                 0                 0                 0

Пропусков больше всего в колонке sex. ### 3.2. Базовые подходы

  • Размерность после drop_na, распределение sex до/после…
mode_val <- function(x) { 
  ux <- na.omit(x); if (length(ux) == 0) return(NA)
  names(sort(table(ux), decreasing = TRUE))[1]
}

penguins_drop <- penguins |> drop_na(bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g)
dim(penguins)
[1] 344   8
dim(penguins_drop)
[1] 342   8
penguins_mode <- penguins |> 
  mutate(
    sex = if_else(is.na(sex), mode_val(sex), sex)
  )
ggplot(penguins, aes(x = sex)) +
  geom_bar(fill = "skyblue") +
  labs(title = "Распределение переменной sex (до преобразований)",
       x = "Пол", y = "Количество") +
  theme_minimal()

ggplot(penguins_mode, aes(x = sex)) +
  geom_bar(fill = "skyblue") +
  labs(title = "Распределение переменной sex (до преобразований)",
       x = "Пол", y = "Количество") +
  theme_minimal()

3.3. Заполнение статистиками

  • Гистограмма/таблица до/после заполнения медианой…
medians <- penguins |> summarise(across(where(is.numeric), ~median(.x, na.rm = TRUE)))
penguins_med <- penguins |> mutate(across(where(is.numeric), ~replace_na(.x, medians[[cur_column()]])))
penguins_original = penguins

penguins_original$state <- "До заполнения"
penguins_med$state <- "После заполнения"

penguins_combined <- bind_rows(penguins_original, penguins_med)

facet_hist = ggplot(penguins_combined, aes(x = bill_length_mm)) +
  geom_histogram(bins = 30, fill = "steelblue", color = "white") +
  facet_wrap(~ state, ncol = 1) +
  labs(title = "Распределение bill_length_mm до и после заполнения",
       x = "bill_length_mm",
       y = "Количество наблюдений") +
  theme_minimal()
facet_hist
Warning: Removed 2 rows containing non-finite outside the scale range
(`stat_bin()`).

penguins_group_med <- penguins |>
  group_by(species) |>
  mutate(across(where(is.numeric), ~if_else(is.na(.x), median(.x, na.rm = TRUE), .x))) |>
  ungroup()

# медианы в оригинальных данных
med_original <- penguins %>%
  group_by(species) %>%
  summarise(across(where(is.numeric), ~median(.x, na.rm = TRUE), .names = "orig_{.col}"))

# медианы в обработанных данных
med_filled <- penguins_group_med %>%
  group_by(species) %>%
  summarise(across(where(is.numeric), ~median(.x, na.rm = TRUE), .names = "filled_{.col}"))

# объединяем в одну таблицу
comparison_table <- med_original %>%
  left_join(med_filled, by = "species")

comparison_table %>% select(species, orig_body_mass_g, filled_body_mass_g)
# A tibble: 3 × 3
  species   orig_body_mass_g filled_body_mass_g
  <fct>                <dbl>              <dbl>
1 Adelie                3700               3700
2 Chinstrap             3700               3700
3 Gentoo                5000               5000
#penguins

3.4. Сравнение стратегий

# penguins penguins_med penguins_group_med

# Создаем обобщенную таблицу со всеми статистиками
summary_table <- bind_rows(
  # Оригинальные данные
  penguins %>% 
    group_by(species) %>% 
    summarise(
      mean_value = mean(bill_depth_mm, na.rm = TRUE),
      median_value = median(bill_depth_mm, na.rm = TRUE),
      dataset = "orig"
    ),
  
  # penguins_med
  penguins_med %>% 
    group_by(species) %>% 
    summarise(
      mean_value = mean(bill_depth_mm, na.rm = TRUE),
      median_value = median(bill_depth_mm, na.rm = TRUE),
      dataset = "med"
    ),
  
  # penguins_group_med
  penguins_group_med %>% 
    group_by(species) %>% 
    summarise(
      mean_value = mean(bill_depth_mm, na.rm = TRUE),
      median_value = median(bill_depth_mm, na.rm = TRUE),
      dataset = "group_med"
    )
) %>% 
  pivot_wider(
    names_from = dataset,
    values_from = c(mean_value, median_value),
    names_glue = "{dataset}_{.value}"
  )

print(summary_table)
# A tibble: 3 × 7
  species  orig_mean_value med_mean_value group_med_mean_value orig_median_value
  <fct>              <dbl>          <dbl>                <dbl>             <dbl>
1 Adelie              18.3           18.3                 18.3              18.4
2 Chinstr…            18.4           18.4                 18.4              18.4
3 Gentoo              15.0           15.0                 15.0              15  
# ℹ 2 more variables: med_median_value <dbl>, group_med_median_value <dbl>
  • Сводная таблица mean/median по видам…

3.5. Визуализация

  • Boxplot по видам/полу (вставьте сохранённые изображения).
box_plot = ggplot(penguins_group_med, aes(x = species, y = body_mass_g, fill = sex)) +
  geom_boxplot() +
  labs(
    title = "Распределение массы тела пингвинов",
    subtitle = "После группового заполнения пропущенных значений",
    x = "Вид пингвина",
    y = "Масса тела (г)",
    fill = "Пол"
  ) +
  theme_minimal()
box_plot

4. Выводы

(2–5 тезисов: какая стратегия адекватнее для набора, как изменились распределения и т.п.)

ggsave("my_ggplot_box_plot.png", plot = box_plot, width = 8, height = 6, dpi = 300)
ggsave("my_ggplot_facet_hist.png", plot=facet_hist, width=8, height=6, dpi=300)
Warning: Removed 2 rows containing non-finite outside the scale range
(`stat_bin()`).

-наиболее эффективная стратегия - заполнять медианами по группам, в этом случае можно получить наиболее вероятные заполенния в данных(my_ggplot_facet_hist.png) -после заполнений распределения изменились незначительно, так как пропусков было мало(my_ggplot_box_plot.png) ## 5. Ссылки (если использовались)

(Документация, статьи, заметки.)