4 Визуализация данных

library("tidyverse")

4.1 Зачем визуализировать данные?

4.1.1 Квартет Анскомба

В работе Anscombe, F. J. (1973). “Graphs in Statistical Analysis” представлен следующий датасет:

quartet <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/anscombe.csv")
quartet
quartet %>% 
  group_by(dataset) %>% 
  summarise(mean_X = mean(x),
            mean_Y = mean(y),
            sd_X = sd(x),
            sd_Y = sd(y),
            cor = cor(x, y),
            n_obs = n()) %>% 
  select(-dataset) %>% 
  round(2)

4.1.2 Датазаурус

В работе Matejka and Fitzmaurice (2017) “Same Stats, Different Graphs” были представлены следующие датасеты:

datasaurus <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/datasaurus.csv")
datasaurus

datasaurus %>% 
  group_by(dataset) %>% 
  summarise(mean_X = mean(x),
            mean_Y = mean(y),
            sd_X = sd(x),
            sd_Y = sd(y),
            cor = cor(x, y),
            n_obs = n()) %>% 
  select(-dataset) %>% 
  round(1)
## `summarise()` ungrouping output (override with `.groups` argument)

4.2 Основы ggplot2

Пакет ggplot2 – современный стандарт для создания графиков в R. Для этого пакета пишут массу расширений. В сжатом виде информация про ggplot2 содержиться здесь.

4.2.1 Диаграмма рассеяния (Scaterplot)

  • ggplot2
ggplot(data = diamonds, aes(carat, price)) +
  geom_point()

  • dplyr, ggplot2
diamonds %>%
  ggplot(aes(carat, price))+
  geom_point()

4.2.2 Слои

diamonds %>%
  ggplot(aes(carat, price))+
  geom_point()+
  geom_smooth()
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

diamonds %>%
  ggplot(aes(carat, price))+
  geom_smooth()+
  geom_point()
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

4.2.3 aes()

diamonds %>%
  ggplot(aes(carat, price, color = cut))+
  geom_point()

diamonds %>%
  ggplot(aes(carat, price))+
  geom_point(color = "green")

diamonds %>%
  ggplot(aes(carat, price))+
  geom_point(aes(color = cut))

diamonds %>%
  ggplot(aes(carat, price, shape = cut))+
  geom_point()

diamonds %>%
  ggplot(aes(carat, price, label = color))+
  geom_text()

diamonds %>%
  slice(1:100) %>% 
  ggplot(aes(carat, price, label = color))+
  geom_label()

Иногда аннотации налезают друг на друга:

library(ggrepel)
diamonds %>%
  slice(1:100) %>% 
  ggplot(aes(carat, price, label = color))+
  geom_text_repel()

diamonds %>%
  slice(1:100) %>% 
  ggplot(aes(carat, price, label = color))+
  geom_text_repel()+
  geom_point()

diamonds %>%
  slice(1:100) %>% 
  ggplot(aes(carat, price, label = color, fill = cut))+ # fill отвечает за закрашивание
  geom_label_repel(alpha = 0.5)+ # alpha отвечает за прозрачность
  geom_point()

4.2.4 Оформление

diamonds %>%
  ggplot(aes(carat, price, color = cut))+
  geom_point() + 
  labs(x = "вес (в каратах)",
       y = "цена (в долларах)",
       title = "Связь цены и веса бриллиантов",
       subtitle = "Данные взяты из датасеты diamonds",
       caption = "график сделан при помощи пакета ggplot2")+
  theme(legend.position = "bottom") # у функции theme() огромный функционал

4.2.5 Логарифмические шкалы

Рассмотрим словарь [Ляшевской, Шарова 2011]

freqdict <- read_tsv("https://github.com/agricolamz/DS_for_DH/raw/master/data/freq_dict_2011.csv")
## Parsed with column specification:
## cols(
##   lemma = col_character(),
##   pos = col_character(),
##   freq_ipm = col_double()
## )
freqdict %>% 
  arrange(desc(freq_ipm)) %>% 
  mutate(id = 1:n()) %>% 
  slice(1:150) %>% 
  ggplot(aes(id, freq_ipm))+
  geom_point()

freqdict %>% 
  arrange(desc(freq_ipm)) %>% 
  mutate(id = 1:n()) %>% 
  slice(1:150) %>% 
  ggplot(aes(id, freq_ipm, label = lemma))+
  geom_point()+
  geom_text_repel()+
  scale_y_log10()

4.2.6 annotate()

Функция annotate добавляет geom к графику.

diamonds %>%
  ggplot(aes(carat, price, color = cut))+
  geom_point()+
  annotate(geom = "rect", xmin = 4.8, xmax = 5.2,
           ymin = 17500, ymax = 18500, fill = "red", alpha = 0.2) + 
  annotate(geom = "text", x = 4.7, y = 16600,
           label = "помогите...\n я в розовом\nквадратике")

Скачайте вот этот датасет и постройте диаграмму рассеяния.

4.3 Столбчатые диаграммы (barplots)

Одна и та же информация может быть представлена в агрегированном и не агрегированном варианте:

misspelling <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/misspelling_dataset.csv")
## Parsed with column specification:
## cols(
##   correct = col_character(),
##   spelling = col_character(),
##   count = col_double()
## )
misspelling 
  • переменные spelling аггрегирована: для каждого значения представлено значение в столбце count, которое обозначает количество каждого из написаний
  • переменные correct неаггрегированы: в этом столбце она повторяется, для того, чтобы сделать вывод, нужно отдельно посчитать количество вариантов

Для аггрегированных данных используется geom_col()

misspelling %>% 
  slice(1:20) %>% 
  ggplot(aes(spelling, count))+
  geom_col()

Перевернем оси:

misspelling %>% 
  slice(1:20) %>% 
  ggplot(aes(spelling, count))+
  geom_col()+
  coord_flip()

Для неаггрегированных данных используется geom_bar()

misspelling %>% 
  ggplot(aes(correct))+
  geom_bar()

Перевернем оси:

misspelling %>% 
  ggplot(aes(correct))+
  geom_bar()+
  coord_flip()

Неаггрегированный вариант можно перевести в аггрегированный:

diamonds %>% 
  count(cut)

Аггрегированный вариант можно перевести в неаггрегированный:

diamonds %>% 
  count(cut) %>% 
  uncount(n)

4.4 Факторы

Как можно заметить по предыдущему разделу, переменные на графике упорядочены по алфавиту. Чтобы это исправить нужно обсудить факторы:

my_factor <- factor(misspelling$correct)
head(my_factor)
## [1] deschanel deschanel deschanel deschanel deschanel deschanel
## 15 Levels: deschanel galifianakis johansson kaepernick labeouf ... shyamalan
levels(my_factor)
##  [1] "deschanel"    "galifianakis" "johansson"    "kaepernick"   "labeouf"     
##  [6] "macaulay"     "mcconaughey"  "mcgwire"      "mclachlan"    "minaj"       
## [11] "morissette"   "palahniuk"    "picabo"       "poehler"      "shyamalan"
levels(my_factor) <- rev(levels(my_factor))
head(my_factor)
## [1] shyamalan shyamalan shyamalan shyamalan shyamalan shyamalan
## 15 Levels: shyamalan poehler picabo palahniuk morissette minaj ... deschanel
misspelling %>% 
  mutate(correct = factor(correct, levels = c("deschanel",
                                              "galifianakis",
                                              "johansson",
                                              "kaepernick",
                                              "labeouf",
                                              "macaulay",
                                              "mcgwire",
                                              "mclachlan",
                                              "minaj",
                                              "morissette",
                                              "palahniuk",
                                              "picabo",
                                              "poehler",
                                              "shyamalan",
                                              "mcconaughey"))) %>% 
  ggplot(aes(correct))+
  geom_bar()+
  coord_flip()

Для работы с факторами удобно использовать пакет forcats (входит в tidyverse, вот ссылка на cheatsheet).

Иногда полезной бывает функция fct_reorder():

misspelling %>% 
  count(correct)
misspelling %>% 
  count(correct) %>% 
  ggplot(aes(fct_reorder(correct, n), n))+
  geom_col()+
  coord_flip()

Кроме того, в функцию fct_reorder() можно добавит функцию, которая будет считаться на векторе, по которому группируют:

diamonds %>% 
  mutate(cut = fct_reorder(cut, price, mean)) %>% 
  ggplot(aes(cut)) +
  geom_bar()

В этом примере переменная cut упорядочена по средней mean цене price. Естественно, вместо mean можно использовать другие функции (median, min, max или даже собственные функции).

Можно совмещать разные geom_...:

misspelling %>% 
  count(correct) %>% 
  ggplot(aes(fct_reorder(correct, n), n, label = n))+
  geom_col()+
  geom_text(nudge_y = 150)+
  coord_flip()

На Pudding вышла статья про английские пабы. Здесь лежит немного обработанный датасет, которые они использовали. Визуализируйте 30 самых частотоных названий пабов в Великобритании.

📋 список подсказок ➡

👁 Как получить нужный датафрейм, где все поссчитано? ➡ Этомо моо сделать функцией count.
👁 Стоп, а почему у меня нарисовалось так много значений? ➡ Может быть нужно было, как написано в задании, взять лишь 30 наблюдений? Полезная функция для этого slice().
👁 Почему нарисовались лишь бары с частотностью 1?. ➡ По умолчанию count не сортирует вообще, так что в slice() попали бары с частотностью 1. Надо отсортировать от большего к меньшему, перед тем как делать slice(). Это можно сделать при помощи функции arrange() или использовать аргумент sort = TRUE в функции count()
👁 Кажется все? ➡ А Вы убрали подписи осей x и y? А подпись добавили?

На новостном портале meduza.io недавно вышла новость о применения закона “о неуважении к власти в интернете”. Постройте графики из этой новости. При построении графиков я использовал цвет “tan3”.

📋 список подсказок ➡

👁 А ссылка на датафрейм, где все посчитано? ➡ А ее нет. Вам надо самим создать датафрейм. Вспоммнайте функцию tibble()
👁 Не понятно, а что это за geom_ такой линия с точкой? ➡ Такого geom_-а нет. Нужно использовать три geom_-а: geom_point(), geom_text() и geom_line().
👁 Почему все рисуется в алфавитном порядке? ➡ Здесь нужно использовать функцию factor(), чтобы задать эксплицитный порядок.
👁 Почему точки рисуются, а линия не хочет? Спойлер: самим тут не справиться. ➡ Действительно, здесь спрятана хитрость: ggplot не знает как ему соединить имеющиеся точки, поэтому чтобы все заработало нужно создать новую переменную в датафрейме (например, type = 1), а в функции aes() вставить аргумент group = type. Тогда ggplot объединит линией все, что имеет одно и то же значение в аргументе group.
👁 Ой, а как добавить белое окружение вокруг точек? ➡ Нужно пойти на военную хитрость: добавить еще один geom_point() белого цвета и большего размера, а потом уже наложить обычные точки. Тут и возникают проблемы с порядокм: сначала нужно нарисовать линию, потом белые точки, а потом уже коричневые. А где должен быть geom_text()?
👁 Кажется все? ➡ А Вы убрали подписи осей x и y? А подпись добавили?

4.5 Дотплот

Иногда для случаев, когда мы исследуем числовую переменную подходит простой график, который отображает распределение наших наблюдений на одной соответствующей числовой шкале.

mtcars %>% 
  ggplot(aes(mpg)) +
  geom_dotplot(method = "histodot")
## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

По оси x отложена наша переменная, каждая точка – одно наблюдение, а отложенное по оси y стоит игнорировать – оно появляется из-за ограничений пакета ggplot2. Возможно чуть понятнее будет, если добавить geom_rug(), который непосредственно отображает каждое наблюдение.

mtcars %>% 
  ggplot(aes(mpg)) +
  geom_rug()+
  geom_dotplot(method = "histodot")
## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

Больший смысл имеет раскрашенный вариант:

mtcars %>% 
  mutate(cyl = factor(cyl)) %>% 
  ggplot(aes(mpg, fill = cyl)) +
  geom_rug()+
  geom_dotplot(method = "histodot")+
  scale_y_continuous(NULL, breaks = NULL) # чтобы убрать ось y
## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

Как видно, на графике, одна синяя точка попала под одну зеленую: значит они имеют общее наблюдение.

4.6 Гистограммы

Если наблюдений слишком много, дотплот не имеем много смысла:

diamonds %>% 
  ggplot(aes(price)) +
  geom_dotplot(method = "histodot")+
  scale_y_continuous(NULL, breaks = NULL) # чтобы убрать ось y
## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

diamonds %>% 
  ggplot(aes(price)) +
  geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Обсудим на предыдущем примере

mtcars %>% 
  ggplot(aes(mpg))+
  geom_rug()+
  geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

По оси x отложена наша переменная, а высота столбца говорит, сколько наблюдений имеют такое же наблюдение. Однако многое зависит от того, что мы считаем одинаковым значением:

mtcars %>% 
  ggplot(aes(mpg)) +
  geom_rug()+
  geom_histogram(bins = 100)

mtcars %>% 
  ggplot(aes(mpg)) +
  geom_rug()+
  geom_histogram(bins = 5)

Существует три алгоритма встроенные в R, которые можно использовать и снимать с себя ответственность:

  • [Sturgers 1926] nclass.Sturges(mtcars$mpg)
  • [Scott 1979] nclass.scott(mtcars$mpg)
  • [Freedman, Diaconis 1981] nclass.FD(mtcars$mpg)
mtcars %>% 
  ggplot(aes(mpg)) +
  geom_histogram(bins = nclass.FD(mtcars$mpg))

Какой из методов использовался при создании следующего графика на основе встроенного датасета iris?

В этом типе графика точно так же можно раскрашивать на основании другой переменной:

iris %>% 
  ggplot(aes(Petal.Length, fill = Species)) +
  geom_rug()+
  geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

4.7 Функции плотности

Кроме того, существует способ использовать не такой рубленный график, а его сглаженную вариант, ыйторый строиться при помои функции плотядерной оценки ности. Важное свойство, которое стоит понимать про функцию плотности — что кривая, получаемая ядерной оценкой плотности, не зависит от величины коробки гистделения (хотя есть аргумент, который от adjustвечает за степень “близости” функции плотности к гистограмме).

iris %>% 
  ggplot(aes(Petal.Length)) +
  geom_rug()+
  geom_density()

Таким образом мы можем сравнивать распределения:

iris %>% 
  ggplot(aes(Petal.Length, fill = Species)) +
  geom_rug()+
  geom_density()

Часто имеет смысл настроить прозрачность:

iris %>% 
  ggplot(aes(Petal.Length, fill = Species)) +
  geom_rug()+
  geom_density(alpha = 0.6) # значение прозрачности изменяется от 0 до 1

Кроме того, иногда удобно разделять группы на разные уровни:

# install.packages(ggridges)
library(ggridges)
iris %>% 
  ggplot(aes(Petal.Length, Species, fill = Species)) +
  geom_density_ridges(alpha = 0.6) # значение прозрачности изменяется от 0 до 1
## Picking joint bandwidth of 0.155

В длинный список “2015 Kantar Information is Beautiful Awards” попала визуализация Perceptions of Probability, сделанная пользователем zonination в ggplot2. Попробуйте воспроизвести ее с этими данными.

📋 список подсказок ➡

👁 как преобразовать в нужный формат? ➡ Я делал это при помощи функции pivot_longer().
👁 не получается обратиться к колонкам ➡ Да, если в названиях столбцов есть пробел или цифры, то к ним можно обратиться, воспользовавшись обратынми ковычками `.
👁 получается, но порядок неправильный… ➡ Ага, мы обсуждали факторы. Функция fct_reorder() позволяяет менять порядок и даже задавать функцию, вроде среднего или медианы, которая должна быть применена к каждой группе.
👁 а как убрать легенду? ➡ Легенду можно убрать добавив show.legend = FALSE в соответствующий geom_....

4.8 Точки, джиттер (jitter), вайолинплот (violinplot), ящики с усами (boxplot),

Вот другие способы показать распределение числовой переменной:

iris %>% 
  ggplot(aes(Species, Petal.Length))+
  geom_point()

iris %>% 
  ggplot(aes(Species, Petal.Length))+
  geom_jitter()

iris %>% 
  ggplot(aes(Species, Petal.Length))+
  geom_jitter(width = 0.3)

library("ggbeeswarm")
iris %>% 
  ggplot(aes(Species, Petal.Length))+
  geom_quasirandom()

diamonds %>% 
  ggplot(aes(cut, price))+
  geom_violin()

diamonds %>% 
  ggplot(aes(cut, price))+
  geom_boxplot()

4.9 Фасетизация

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

diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_wrap(~cut)

При этом иногда так бывает, что наличие какой-то одного значение в одном из фасетов, заставляет иметь одну и ту же шкалу для всех остальных. Это можно изменить при помощи аргумента scales:

diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_wrap(~cut, scales = "free")

Кроме того, можно добавлять дополнительные аргументы:

diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_wrap(~cut+color)

Кроме того, можно создавать сетки переменных используя geom_grid(), они facet_grid()ньше места, чем facet_wrap():

diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_grid(cut~color, scales = "free")

Кроме того facet_grid() позволяет делать обощающие поля, где представлены все данные по какой-то строчке или столбцу:

diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_grid(cut~color, scales = "free", margins = TRUE)

4.10 Визуализация комбинаций признаков

4.10.1 Потоковая Диаграмма (Sankey diagram)

Один из способов визуализации отношений между признаками называется потоковая диаграмма.

library("ggforce")
zhadina <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/zhadina.csv")
## Parsed with column specification:
## cols(
##   word_1 = col_character(),
##   word_2 = col_character(),
##   word_3 = col_character(),
##   type = col_character(),
##   n = col_double()
## )
zhadina %>% 
  gather_set_data(1:3) %>% 
  ggplot(aes(x, id = id, split = y, value = n))+
  geom_parallel_sets(aes(fill = type), alpha = 0.6, axis.width = 0.5) +
  geom_parallel_sets_axes(axis.width = 0.5, color = "lightgrey", fill = "white") +
  geom_parallel_sets_labels(angle = 0) +
  theme_no_axes()+
  theme(legend.position = "bottom")

А как поменять порядок? Снова факторы.

zhadina %>% 
  gather_set_data(1:3) %>% 
  mutate(y = fct_reorder(y, n, mean)) %>% 
  ggplot(aes(x, id = id, split = y, value = n))+
  geom_parallel_sets(aes(fill = type), alpha = 0.6, axis.width = 0.5) +
  geom_parallel_sets_axes(axis.width = 0.5, color = "lightgrey", fill = "white") +
  geom_parallel_sets_labels(angle = 0) +
  theme_no_axes()+
  theme(legend.position = "bottom")

Можно донастроить, задав собственный порядок в аргументе levels функции factor().

4.10.2 UpSet Plot

Если диаграмма Sankey визуализирует попарные отношения между переменными, то график UpSet потенциально может визуализировать все возможные комбинации и является хорошей альтернативой диаграмме Вена, с большим количеством переменных (см. эту статью Лауры Эллис).

library(UpSetR)
movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=TRUE, sep=";" )
str(movies)
## 'data.frame':	3883 obs. of  21 variables:
##  $ Name       : chr  "Toy Story (1995)" "Jumanji (1995)" "Grumpier Old Men (1995)" "Waiting to Exhale (1995)" ...
##  $ ReleaseDate: int  1995 1995 1995 1995 1995 1995 1995 1995 1995 1995 ...
##  $ Action     : int  0 0 0 0 0 1 0 0 1 1 ...
##  $ Adventure  : int  0 1 0 0 0 0 0 1 0 1 ...
##  $ Children   : int  1 1 0 0 0 0 0 1 0 0 ...
##  $ Comedy     : int  1 0 1 1 1 0 1 0 0 0 ...
##  $ Crime      : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ Documentary: int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Drama      : int  0 0 0 1 0 0 0 0 0 0 ...
##  $ Fantasy    : int  0 1 0 0 0 0 0 0 0 0 ...
##  $ Noir       : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Horror     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Musical    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Mystery    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Romance    : int  0 0 1 0 0 0 1 0 0 0 ...
##  $ SciFi      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Thriller   : int  0 0 0 0 0 1 0 0 0 1 ...
##  $ War        : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Western    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ AvgRating  : num  4.15 3.2 3.02 2.73 3.01 3.88 3.41 3.01 2.66 3.54 ...
##  $ Watches    : int  2077 701 478 170 296 940 458 68 102 888 ...
upset(movies[,3:19], nsets = 16, order.by = "freq")