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

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

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

Набор Palmer Penguins: измерения пингвинов (Adélie, Chinstrap, Gentoo) с различных островов Антарктики. Основные столбцы: species, island, bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g, sex, year.

2. Ход работы

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

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

• Загружаемые библиотеки

  library(tidyverse)

  ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
  ✔ dplyr     1.1.4     ✔ readr     2.1.5
  ✔ forcats   1.0.0     ✔ 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

  data(penguins)

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

1

• Таблица пропусков:

  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 

2

• Визуализация пропусков:

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

  

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

  

  Много пропусков в столбце “sex”

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

3

• drop_na для основных признаков:

  dim(penguins)

  [1] 344   8

  penguins_drop <- penguins |> drop_na(bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g)
  dim(penguins_drop)

  [1] 342   8

  После удаления — теряется небольшая часть строк (размерность уменьшается).

4

• Заполнение sex модой:

  ggplot(penguins, aes(sex)) + geom_bar(fill="steelblue") + ggtitle("sex до заполнения модой")

  

  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))
  ggplot(penguins_mode, aes(sex)) + geom_bar(fill="steelblue") + ggtitle("sex после заполнения модой")

  

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

5

• Заполнение медианой по столбцам:

  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()]])))
  ggplot(bind_rows(penguins |> mutate(source="orig"), penguins_med |> mutate(source="med")), aes(bill_length_mm, fill=source)) + geom_histogram(alpha=0.5, position='identity')

  `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

  Warning: Removed 2 rows containing non-finite outside the scale range
  (`stat_bin()`).

  

  Распределения практически не меняются. ## 6

• Групповая медиана:

  penguins |> group_by(species) |> summarise(med_body_mass = median(body_mass_g, na.rm=FALSE))

  # A tibble: 3 × 2
    species   med_body_mass
    <fct>             <dbl>
  1 Adelie               NA
  2 Chinstrap          3700
  3 Gentoo               NA

  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

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

7

• Сводная таблица mean/median по видам:

  table_a <- penguins |> group_by(species) |> summarise(mean_bd = mean(bill_depth_mm, na.rm=TRUE), med_bd = median(bill_depth_mm, na.rm=TRUE)) |> mutate(version = "orig")
  table_b <- penguins_med |> group_by(species) |> summarise(mean_bd = mean(bill_depth_mm, na.rm=TRUE), med_bd = median(bill_depth_mm, na.rm=TRUE)) |> mutate(version = "mediana")
  table_c <- penguins_group_med |> group_by(species) |> summarise(mean_bd = mean(bill_depth_mm, na.rm=TRUE), med_bd = median(bill_depth_mm, na.rm=TRUE)) |> mutate(version = "group_med")
  
  library(tidyr)
  full_tab <- bind_rows(table_a, table_b, table_c) |>
    pivot_wider(names_from = version, values_from = c(mean_bd, med_bd))
  full_tab

  # A tibble: 3 × 7
    species   mean_bd_orig mean_bd_mediana mean_bd_group_med med_bd_orig
    <fct>            <dbl>           <dbl>             <dbl>       <dbl>
  1 Adelie            18.3            18.3              18.3        18.4
  2 Chinstrap         18.4            18.4              18.4        18.4
  3 Gentoo            15.0            15.0              15.0        15  
  # ℹ 2 more variables: med_bd_mediana <dbl>, med_bd_group_med <dbl>

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

8 9

• Boxplot по видам/полу (после группового заполнения):

  ggplot(filter(penguins_group_med, !is.na(sex)), aes(x=species, y=body_mass_g, fill=sex)) + geom_boxplot() + labs(title="Body mass по species и sex") + theme_minimal()

  

  ggsave("plot_boxplot.png")

  Saving 7 x 5 in image

  ggsave("plot_hist_mediana.png")

  Saving 7 x 5 in image

4. Выводы

• drop_na удаляет строки с NA и уменьшает выборку, медиана сохраняет данные.
• Заполнение модой опасно при большом числе пропусков — может исказить статистику.
• Для оценки эффективности используются гистограммы, boxplot, визуализация пропусков
• случайные пропуски (MCAR), зависящие от наблюдаемых переменных (MAR), или неслучайные (MNAR)
• сохранены гистограма заполнения медианой и boxplot после группового заполнения

5. Ссылки

-https://rpubs.com/Golubnichiy/da_lab_4