5. Продвинутые диаграммы рассеяния

R
Автор

Е. Тымченко

Дата публикации

9 января 2024 г.

В этой заметке мы выучим новые геометрии, научимся их комбинировать, попробуем разнообразить скучнейший тип графика - scatterplot. Нам понадобятся библиотеки:

library(tidyverse)
library(httr)
library(readxl)
library(ggExtra) # Красивые типы  графиков
library(showtext) # Рендер шрифтов в ggplot2
library(sysfonts) # загрузка шрифтов в R

showtext_auto()

Шрифт, на случай, если его нет под рукой.

GET('https://github.com/ETymch/Econometrics_2023/raw/main/Plotting/HSESans-Regular.otf', write_disk('HSESans-Regular.otf', overwrite = T))
GET('https://github.com/ETymch/Econometrics_2023/raw/main/Plotting/HSESans-Bold.otf', write_disk('HSESans-Bold.otf', overwrite = T))
GET('https://github.com/ETymch/Econometrics_2023/raw/main/Plotting/HSESans-Italic.otf', write_disk('HSESans-Italic.otf', overwrite = T))
GET('https://github.com/ETymch/Econometrics_2023/raw/main/Plotting/HSESans-SemiBold.otf', write_disk('HSESans-SemiBlod.otf', overwrite = T))
font_add(family = 'HSE Sans',
         regular = "HSESans-Regular.otf",
         bold = 'HSESans-Bold.otf',
         italic = 'HSESans-Italic.otf',
         bolditalic = 'HSESans-SemiBlod.otf'
)

Данные:

GET("https://github.com/ETymch/Econometrics_2023/raw/main/Datasets/data_expenditures.xlsx",
    write_disk('data_expenditures.xlsx', overwrite = T)
    )
data <- read_excel('data_expenditures.xlsx') %>%
  mutate(`Мусульманская страна` = ifelse(`Мусульманская страна` == 0, 'Нет', 'Да')
         )

Посмотрим на данные.

data %>% head %>% kableExtra::kable()
Страна Траты на еду, % Траты на алкоголь, % Мусульманская страна
Algeria 37.255870 1.024986 Да
Angola 49.737928 1.502935 Нет
Argentina 23.198097 1.907243 Нет
Australia 9.974969 4.239678 Нет
Austria 11.312785 3.608416 Нет
Azerbaijan 43.555817 2.024452 Да

Идея графика - проста. Мы хотим посмотреть на разницу в распределении расходов для разных групп стран.

Предустановки для всех графиков:

color_1 <- c('#412A29', '#F6B20E')
alpha_default <- 0.7
density_size = 7

Делайте графики с кастомными цветами! Палитры на любой вкус можно сгенерировать или выбрать, например, на Data color picker или Pigment

Самый простой график. Такой вы уже видели 10 миллиардов раз. Возможно, он вам даже наскучил.

a <- data %>%
  ggplot(aes(x = `Траты на алкоголь, %`, y = `Траты на еду, %`)) +
  geom_jitter(color = color_1[2], size = 3.0, alpha = alpha_default) +
  theme_minimal(base_family = 'HSE Sans', base_size = 16) +
  theme(panel.grid.minor.x = element_blank(),
        panel.grid.minor.y = element_blank()
        )
a

Добавим функции плотности. Они помогают лучше ориентироваться в том, как распределены данные. ggMarginal - полезная функция из библиотеки ggExtra, которая автоматически строит функции распределения.

ggMarginal(a, type="density", size = density_size, fill = color_1[2], alpha = alpha_default, color = NA) # Поэкспериментируйте. Вместо type = 'density' выберите type = 'histogram'. Выберите цвет границы color = 'black'.

Теперь разделим выборку на две группы. В одной будут страны с долей мусульманского населения менее 20%, в другой - более 20%.

b <- data %>%
  ggplot(aes(x = `Траты на алкоголь, %`, y = `Траты на еду, %`, color = `Мусульманская страна`, fill = `Мусульманская страна`)) +
  geom_jitter(size = 3.0, alpha = alpha_default) +
  scale_color_manual(values = color_1) +
  theme_minimal(base_family = 'HSE Sans', base_size = 16) +
  theme(legend.position = 'bottom',
        panel.grid.minor.x = element_blank(),
        panel.grid.minor.y = element_blank()
  )

ggMarginal(b, type="density", size = density_size, alpha = alpha_default, groupFill = T, color = NA)

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

c <- 
  b + 
  geom_hline(yintercept = data %>% # Создадим горизонтальные и вертикальные линии, показывающие средние значения трат на еду и на алкоголь
               filter(`Мусульманская страна` == 'Да') %>% # Всё это можно сделать не создавая дополнительных таблиц, а просто добавив слой
               pull(`Траты на еду, %`) %>% mean(), # с другим источником данных, которые вы обработали уже внутри графика
             linetype = 'dashed', # тип линии
             color = color_1[1], # правильный цвет
             alpha = alpha_default + 0.2,
             size = 0.8
             ) +
  geom_hline(yintercept = data %>%
               filter(`Мусульманская страна` == 'Нет') %>%
               pull(`Траты на еду, %`) %>% mean(),
             linetype = 'dashed',
             color = color_1[2],
             alpha = alpha_default + 0.2,
             size = 0.8
  ) +
  geom_vline(xintercept = data %>%
               filter(`Мусульманская страна` == 'Да') %>%
               pull(`Траты на алкоголь, %`) %>% mean(),
             linetype = 'dashed',
             color = color_1[1],
             alpha = alpha_default + 0.2,
             size = 0.8
  ) +
  geom_vline(xintercept = data %>%
               filter(`Мусульманская страна` == 'Нет') %>%
               pull(`Траты на алкоголь, %`) %>% mean(),
             linetype = 'dashed',
             color = color_1[2],
             alpha = alpha_default + 0.2,
             size = 0.8
  )

ggMarginal(c, type="density", size = density_size, alpha = alpha_default, groupFill = T, color = NA)

На мой взгляд, график кажется перегруженным. Линии занимают слишком много места. Да и кода для такой пустяковой задачи написано многовато. Попробуем другой способ - нарисуем крестики.

size_cross <- 5

# Для этого нам понадобится создать ещё одну табличку

summary_data <- data %>% 
  group_by(`Мусульманская страна`) %>%
  summarize(`Медиана, алк` = median(`Траты на алкоголь, %`),
            `Медиана, еда` = median(`Траты на еду, %`)
  )
  
# Обновлённый график

d <- 
  b +
  geom_errorbar(data = summary_data,# geom_errorbar - уже встроенная в ggplot2 функция. Она очень гибкая и помогает строить крестики разных форм, с разными содержательными смыслами.
    aes(
      x = `Медиана, алк`,# Крестик состоит из двух пересекающихся линий. Первая - вертикальная. Её центр - x
      ymin = `Медиана, еда` - size_cross, # Длина линии
      ymax = `Медиана, еда` + size_cross,
      color = `Мусульманская страна`),
    inherit.aes = F,
    width = .3,# попробуйте изменить этот параметр
    size = .8,# попробуйте изменить этот параметр
    show.legend = F,
    alpha = alpha_default + 0.3
  ) +
  geom_errorbar(data = summary_data,# Горизонтальная часть.
    aes(y = `Медиана, еда`,
      xmin = `Медиана, алк` - size_cross * 0.25,
      xmax = `Медиана, алк` + size_cross * 0.25,
      color = `Мусульманская страна`),
    inherit.aes = F,
    width = 0.8,
    size = 1,
    show.legend = F,# попробуйте изменить этот параметр
    alpha = alpha_default + 0.3 # попробуйте изменить этот параметр
  )

# Как лучше сохранить такой график?

ggsave(file = "density_multilevel.png", dpi = 500,
       ggMarginal(d, type="density", size = density_size, alpha = alpha_default, groupFill = T, color = NA),
)

plot

Улучшать графики можно бесконечно, но на этом, думаю, можно остановиться. Такой график выглядит уже достаточно профессионально и хорошо сообщает читателю графика нашу основную идею. Экспериментируйте с различными комбинациями слоёв, размерами, цветом, осваивайте лучшую библиотеку для визуализации данных, ggplot2!