Лабораторная работа №4 (R)

Обработка пропусков на наборе данных Palmer Penguins

Author

ФИО студента: Чигирев Яромир Алексеевич

Published

October 16, 2025

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

library(palmerpenguins)
Warning: пакет 'palmerpenguins' был собран под R версии 4.3.3

Набор данных о пингвинах с островов Палмер (Антарктика). Содержит измерения трёх видов: Adelie, Chinstrap, Gentoo.
Ключевые переменные (с пропусками в некоторых столбцах):
species - вид
island - остров
bill_length_mm - длина клюва (мм)
bill_depth_mm - глубина клюва (мм)
flipper_length_mm - длина плавника (мм)
body_mass_g - масса тела (г)
sex - пол
year - год наблюдения

colSums(is.na(penguins))
          species            island    bill_length_mm     bill_depth_mm 
                0                 0                 2                 2 
flipper_length_mm       body_mass_g               sex              year 
                2                 2                11                 0

Выше представлено количество пропущенных значений в каждом столбце датасета.

2. Ход работы

Проведена диагностика пропусков с визуализацией. Базовые подходы включали удаление NA и заполнение модой. Глобальная и групповая медиана сравнены после этапа заполнения статистиками, выявив преимущество второго варианта. Визуализация подтвердила корректность группового заполнения.

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

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

library(tidyverse)
Warning: пакет 'tidyverse' был собран под R версии 4.3.3
Warning: пакет 'ggplot2' был собран под R версии 4.3.3
Warning: пакет 'tibble' был собран под R версии 4.3.2
Warning: пакет 'tidyr' был собран под R версии 4.3.3
Warning: пакет 'readr' был собран под R версии 4.3.3
Warning: пакет 'purrr' был собран под R версии 4.3.2
Warning: пакет 'dplyr' был собран под R версии 4.3.2
Warning: пакет 'stringr' был собран под R версии 4.3.2
Warning: пакет 'forcats' был собран под R версии 4.3.2
Warning: пакет 'lubridate' был собран под R версии 4.3.2
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.0     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── 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(skimr)
library(naniar)
Warning: пакет 'naniar' был собран под R версии 4.3.3

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

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

    n_complete
arrange(miss_var_summary(penguins), desc(n_miss))
# A tibble: 8 × 3
  variable          n_miss pct_miss
  <chr>              <int>    <num>
1 sex                   11    3.20 
2 bill_length_mm         2    0.581
3 bill_depth_mm          2    0.581
4 flipper_length_mm      2    0.581
5 body_mass_g            2    0.581
6 species                0    0    
7 island                 0    0    
8 year                   0    0    
p1 <- gg_miss_var(penguins) +
  labs(title = "Доля пропусков по столбцам")
p2 <- vis_miss(penguins) +
  labs(title = "Карта пропусков")
print(p1)

print(p2)

3.2. Базовые подходы

clean_ds <- penguins |> drop_na(bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g)
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 ▇▁▇▁▇ 
skim(clean_ds)
Data summary
Name clean_ds
Number of rows 342
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: 151, Gen: 123, Chi: 68
island 0 1.00 FALSE 3 Bis: 167, Dre: 124, Tor: 51
sex 9 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 0 1 43.92 5.46 32.1 39.23 44.45 48.5 59.6 ▃▇▇▆▁
bill_depth_mm 0 1 17.15 1.97 13.1 15.60 17.30 18.7 21.5 ▅▅▇▇▂
flipper_length_mm 0 1 200.92 14.06 172.0 190.00 197.00 213.0 231.0 ▂▇▃▅▂
body_mass_g 0 1 4201.75 801.95 2700.0 3550.00 4050.00 4750.0 6300.0 ▃▇▆▃▂
year 0 1 2008.03 0.82 2007.0 2007.00 2008.00 2009.0 2009.0 ▇▁▇▁▇ 
mode_val <- function(x) { 
  ux <- na.omit(x); if (length(ux) == 0) return(NA)
  names(sort(table(ux), decreasing = TRUE))[1]
}
penguins_mode <- penguins |> 
  mutate(
    sex = if_else(is.na(sex), mode_val(sex), sex)
  )
p1 <- ggplot(penguins, aes(x = sex, fill = sex)) + 
  geom_bar() + labs(title = "До заполнения")
p2 <- ggplot(penguins_mode, aes(x = sex, fill = sex)) + 
  geom_bar() + labs(title = "После заполнения")
print(p1)

print(p2)

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

penguins_median <- penguins |> mutate(across(where(is.numeric), ~if_else(is.na(.), median(., na.rm = TRUE), .)))
pp <- bind_rows(
  penguins |> mutate(period = "До"),
  penguins_median |> mutate(period = "После")
)
ggplot(pp, aes(x = bill_length_mm, fill = period)) +
  geom_histogram(position = "identity", alpha = 0.7, bins = 30)
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()
penguins |> group_by(species) |> summarise(med_body_mass = median(body_mass_g, na.rm = TRUE))
# A tibble: 3 × 2
  species   med_body_mass
  <fct>             <dbl>
1 Adelie             3700
2 Chinstrap          3700
3 Gentoo             5000
penguins_group_med |> group_by(species) |> summarise(med_body_mass = median(body_mass_g, na.rm = TRUE))
# A tibble: 3 × 2
  species   med_body_mass
  <fct>             <dbl>
1 Adelie             3700
2 Chinstrap          3700
3 Gentoo             5000

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

penguins_global <- penguins |> mutate(bill_depth_mm = if_else(is.na(bill_depth_mm), median(bill_depth_mm, na.rm = TRUE), bill_depth_mm))
penguins_group <- penguins |> group_by(species) |>
  mutate(bill_depth_mm = if_else(is.na(bill_depth_mm), median(bill_depth_mm, na.rm = TRUE), bill_depth_mm)) |>
  ungroup()
bind_rows(
  penguins |> mutate(method = "original"),
  penguins_global |> mutate(method = "global"), 
  penguins_group |> mutate(method = "group")
) |>
  group_by(method, species) |>
  summarise(
    mean = mean(bill_depth_mm),
    median = median(bill_depth_mm),
    .groups = "drop"
  ) |>
  pivot_wider(
    names_from = method,
    values_from = c(mean, median)
  )
# A tibble: 3 × 7
  species   mean_global mean_group mean_original median_global median_group
  <fct>           <dbl>      <dbl>         <dbl>         <dbl>        <dbl>
1 Adelie           18.3       18.3          NA            18.4         18.4
2 Chinstrap        18.4       18.4          18.4          18.4         18.4
3 Gentoo           15.0       15.0          NA            15           15  
# ℹ 1 more variable: median_original <dbl>

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

pp <- penguins |>
  group_by(species) |>
  mutate(across(where(is.numeric), ~if_else(is.na(.), median(., na.rm = TRUE), .))) |>
  ungroup()
p1 <- ggplot(pp, aes(x = species, y = body_mass_g, fill = sex)) +
  geom_boxplot() +
  facet_wrap(~ species, scales = "free") + 
  labs(
    title = "Распределение массы тела по видам и полу",
    x = "Вид пингвинов",
    y = "Масса тела",
    fill = "Пол"
  )
print(p1)

ggsave("p1.png", p1, width = 8, height = 6, dpi = 300)
p2 <- ggplot(pp, aes(x = flipper_length_mm, y = body_mass_g, color = species)) +
  geom_point(alpha = 0.7) +
  labs(title = "Зависимость массы тела от длины ласта",
       x = "Длина ласта",
       y = "Масса тела",
       color = "Вид"
  )
print(p2)

ggsave("p2.png", p2, width = 8, height = 6, dpi = 300)
p3 <- ggplot(pp, aes(x = bill_length_mm, fill = species, color = species)) +
  geom_density(alpha = 0.5) +
  labs(
    title = "Распределение длины клюва по видам пингвинов",
    x = "Длина клюва",
    y = "Плотность",
    fill = "Вид",
    color = "Вид"
  ) +
  theme_minimal()
print(p3)

ggsave("p3.png", p3, width = 8, height = 6, dpi = 300)

4. Выводы

  1. Стратегия группового заполнения адекватнее для данного набора, так как необходимо учитывать биологические различия между видами пингвинов.
  2. Распределения сохранили форму после заполнения групповой медианой, подтверждая истинность первого тезиса.
  3. Зафиксировано значительное большинство пропусков в переменной пола (sex). Это можно объяснить возможной сложностью с определением гендера пингвинов.
  4. На одном из графиков наблюдается положительная корреляция между массой тела и длиной ласта пингвина, что соответствует биологическим ожиданиям. Из этой же статистики следует вывод о самом крупном виде - Gentoo.

5. Ссылки (если использовались)

https://ggplot2.tidyverse.org/
https://search.r-project.org/CRAN/refmans/ggplot2/html/ggsave.html