03-data_visualisation.Rmd

---
output: html_document
editor_options: 
  chunk_output_type: console
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(warning = FALSE)
ggplot2::theme_set(ggplot2::theme_bw())
```

# Визуализация данных {#viz_1}

```{r, message = FALSE}
library("tidyverse")
```

## Зачем визуализировать данные?
### Квартет Анскомба
В работе Anscombe, F. J. (1973). "Graphs in Statistical Analysis" представлен следующий датасет:

```{r, message= FALSE}
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)
```

```{r, echo = FALSE, message=FALSE}
library(ggplot2)
quartet %>% 
  ggplot(aes(x, y))+
  geom_point()+
  geom_smooth(method = "lm", se = F)+
  facet_wrap(~dataset)+
  theme_bw()
```

### Датазаурус
В работе [Matejka and Fitzmaurice (2017) "Same Stats, Different Graphs"](https://www.autodeskresearch.com/sites/default/files/SameStats-DifferentGraphs.pdf) были представлены следующие датасеты:

```{r, message= FALSE}
datasaurus <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/datasaurus.csv")
datasaurus
```

```{r, echo=FALSE, message= FALSE}
datasaurus %>% 
  ggplot(aes(x, y))+
  geom_point()+
  facet_wrap(~dataset)+
  theme_bw()
```

```{r}
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)
```

## Основы `ggplot2`
Пакет `ggplot2` -- современный стандарт для создания графиков в R. Для этого пакета пишут [массу расширений](https://exts.ggplot2.tidyverse.org/). В сжатом виде информация про ggplot2 [содержиться здесь](https://github.com/rstudio/cheatsheets/raw/master/data-visualization-2.1.pdf).

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

* ggplot2
```{r, cache=TRUE}
ggplot(data = diamonds, aes(carat, price)) +
  geom_point()
```

* dplyr, ggplot2
```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price))+
  geom_point()
```

### Слои

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price))+
  geom_point()+
  geom_smooth()
```

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price))+
  geom_smooth()+
  geom_point()
```


### `aes()`

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price, color = cut))+
  geom_point()
```

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price))+
  geom_point(color = "green")
```

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price))+
  geom_point(aes(color = cut))
```

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price, shape = cut))+
  geom_point()
```

```{r, cache=TRUE}
diamonds %>%
  ggplot(aes(carat, price, label = color))+
  geom_text()
```

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

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

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

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

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

### Оформление

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

### Логарифмические шкалы
![](images/log_scales.png)

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

```{r freqdict_download, cache=TRUE}
freqdict <- read_tsv("https://github.com/agricolamz/DS_for_DH/raw/master/data/freq_dict_2011.csv")
freqdict %>% 
  arrange(desc(freq_ipm)) %>% 
  mutate(id = 1:n()) %>% 
  slice(1:150) %>% 
  ggplot(aes(id, freq_ipm))+
  geom_point()
```

```{r freqdict_visualise, cache=TRUE}
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()
```

### `annotate()`
Функция `annotate` добавляет `geom` к графику.
```{r, cache=TRUE}
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квадратике")
```

```{block, type = "rmdtask"}
Скачайте [вот этот датасет](https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/first_scatterplot.csv) и постройте диаграмму рассеяния.
```

```{r, include = FALSE}
read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/first_scatterplot.csv") %>% 
  ggplot(aes(x, y))+
  geom_point()
```


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

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

```{r}
misspelling <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/misspelling_dataset.csv")
misspelling 
```

* переменные spelling **аггрегирована**: для каждого значения представлено значение в столбце count, которое обозначает количество каждого из написаний
* переменные correct **неаггрегированы**: в этом столбце она повторяется, для того, чтобы сделать вывод, нужно отдельно посчитать количество вариантов


Для аггрегированных данных используется `geom_col()`
```{r}
misspelling %>% 
  slice(1:20) %>% 
  ggplot(aes(spelling, count))+
  geom_col()
```

Перевернем оси:
```{r}
misspelling %>% 
  slice(1:20) %>% 
  ggplot(aes(spelling, count))+
  geom_col()+
  coord_flip()
```

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

```{r}
misspelling %>% 
  ggplot(aes(correct))+
  geom_bar()
```

Перевернем оси:
```{r}
misspelling %>% 
  ggplot(aes(correct))+
  geom_bar()+
  coord_flip()
```


Неаггрегированный вариант можно перевести в аггрегированный:
```{r}
diamonds %>% 
  count(cut)
```

Аггрегированный вариант можно перевести в неаггрегированный:
```{r}
diamonds %>% 
  count(cut) %>% 
  uncount(n)
```

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

```{r}
my_factor <- factor(misspelling$correct)
head(my_factor)
levels(my_factor)
levels(my_factor) <- rev(levels(my_factor))
head(my_factor)

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](https://github.com/rstudio/cheatsheets/raw/master/factors.pdf)).

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

```{r}
misspelling %>% 
  count(correct)

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

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

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

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

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

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

```{block, type = "rmdtask"}
На Pudding вышла [статья про английские пабы](https://pudding.cool/2019/10/pubs/). [Здесь](https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/UK_pubs.csv) лежит немного обработанный датасет, которые они использовали. Визуализируйте 30 самых частотоных названий пабов в Великобритании. 
```

```{r, echo=FALSE, message = FALSE}
read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/UK_pubs.csv") %>% 
  count(pub_name, sort = TRUE) %>% 
  mutate(pub_name = reorder(pub_name, n)) %>% 
  slice(1:30) %>% 
  ggplot(aes(pub_name, n, label = n))+
  geom_col()+
  geom_text(nudge_y = 10)+
  coord_flip()+
  labs(x = "", y = "", caption = "data from https://pudding.cool/2019/10/pubs/")
```


<details> <summary> 📋 список подсказок ➡ </summary> 

<details> <summary> 👁 Как получить нужный датафрейм, где все поссчитано? ➡ </summary>
Этомо моо сделать функцией `count`. <br>
</details>

<details> <summary> 👁 Стоп, а почему у меня нарисовалось так много значений? ➡ </summary>
Может быть нужно было, как написано в задании, взять лишь 30 наблюдений? Полезная функция для этого `slice()`. <br>
</details> 

<details> <summary> 👁 Почему нарисовались лишь бары с частотностью 1?. ➡ </summary>
По умолчанию `count` не сортирует вообще, так что в `slice()` попали бары с частотностью 1. Надо отсортировать от большего к меньшему, перед тем как делать `slice()`. Это можно сделать при помощи функции `arrange()` или использовать аргумент `sort = TRUE` в функции `count()` <br>
</details> 

<details> <summary> 👁 Кажется все? ➡ </summary>
А Вы убрали подписи осей x и y? А подпись добавили?
<br>
</details>
</details>

```{block, type = "rmdtask"}
На новостном портале meduza.io недавно вышла [новость о применения закона "о неуважении к власти в интернете"](https://meduza.io/short/2019/09/30/pervye-polgoda-primeneniya-zakona-o-neuvazhenii-k-vlasti-v-internete-doklad-agory). Постройте графики из этой новости. При построении графиков я использовал цвет `"tan3"`.
```
![](images/visualisation_task.png)

```{r, echo=FALSE}
months <- c("апрель", "май", "июнь", "июль", "август", "сентябрь")
tibble(month = factor(months, levels = months),
       value = c(2, 12, 14, 8, 5, 4),
       type = 1) %>% 
  ggplot(aes(month, value, label = value, group = type))+
  geom_line(color = "tan3")+
  geom_point(color = "white", size = 4)+
  geom_point(color = "tan3")+
  geom_text(nudge_y = 1)+
  labs(title = "Сколько дел возбудили по новому закону", x = "", y = "") ->
  p1

tibble(words = c("Путин", "общество", "губернаторы", "силовики", '"Единая Россия"', "местные чиновники", "судьи", "депутаты", "конституция", "Росатом"),
       values = c(26, 4, 3, 3, 2, 2, 2, 1, 1, 1)) %>%
  ggplot(aes(fct_reorder(words, values), values, label = values))+
  geom_col(fill = "tan3")+
  geom_text(nudge_y = 0.6)+
  coord_flip()+
  labs(title = "Кто был объектом неуважения", x = "", y = "", caption = "данные meduza.io") ->
  p2

plot(gridExtra::arrangeGrob(p1, p2, nrow = 2))
```

<details> <summary> 📋 список подсказок ➡ </summary> 

<details> <summary> 👁 А ссылка на датафрейм, где все посчитано? ➡ </summary>
А ее нет. Вам надо самим создать датафрейм. Вспоммнайте функцию `tibble()` <br>
</details>

<details> <summary> 👁 Не понятно, а что это за `geom_` такой линия с точкой? ➡ </summary>
Такого `geom_`-а нет. Нужно использовать три `geom_`-а: `geom_point()`, `geom_text()` и `geom_line()`. <br>
</details> 

<details> <summary> 👁 Почему все рисуется в алфавитном порядке? ➡ </summary>
Здесь нужно использовать функцию `factor()`, чтобы задать эксплицитный порядок. <br>
</details> 

<details> <summary> 👁 Почему точки рисуются, а линия не хочет? Спойлер: самим тут не справиться. ➡ </summary>
Действительно, здесь спрятана хитрость: `ggplot` не знает как ему соединить имеющиеся точки, поэтому чтобы все заработало нужно создать новую переменную в датафрейме (например, `type = 1`), а в функции `aes()` вставить аргумент `group = type`. Тогда `ggplot` объединит линией все, что имеет одно и то же значение в аргументе `group`.
 <br>
</details> 

<details> <summary> 👁 Ой, а как добавить белое окружение вокруг точек?  ➡ </summary>
Нужно пойти на военную хитрость: добавить еще один `geom_point()` белого цвета и большего размера, а потом уже наложить обычные точки. Тут и возникают проблемы с порядокм: сначала нужно нарисовать линию, потом белые точки, а потом уже коричневые. А где должен быть `geom_text()`?
 <br>
</details> 

<details> <summary> 👁 Кажется все? ➡ </summary>
А Вы убрали подписи осей x и y? А подпись добавили?
<br>
</details>
</details>


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

```{r}
mtcars %>% 
  ggplot(aes(mpg)) +
  geom_dotplot(method = "histodot")
```

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

```{r}
mtcars %>% 
  ggplot(aes(mpg)) +
  geom_rug()+
  geom_dotplot(method = "histodot")
```


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

```{r}
mtcars %>% 
  mutate(cyl = factor(cyl)) %>% 
  ggplot(aes(mpg, fill = cyl)) +
  geom_rug()+
  geom_dotplot(method = "histodot")+
  scale_y_continuous(NULL, breaks = NULL) # чтобы убрать ось y
```
Как видно, на графике, одна синяя точка попала под одну зеленую: значит они имеют общее наблюдение.

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

```{r}
diamonds %>% 
  ggplot(aes(price)) +
  geom_dotplot(method = "histodot")+
  scale_y_continuous(NULL, breaks = NULL) # чтобы убрать ось y

diamonds %>% 
  ggplot(aes(price)) +
  geom_histogram()
```

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

```{r}
mtcars %>% 
  ggplot(aes(mpg))+
  geom_rug()+
  geom_histogram()
```

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

```{r}
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)`

```{r}
mtcars %>% 
  ggplot(aes(mpg)) +
  geom_histogram(bins = nclass.FD(mtcars$mpg))
```

```{block, type = "rmdtask"}
Какой из методов использовался при создании следующего графика на основе встроенного датасета `iris`?
```

```{r, echo = FALSE}
iris %>% 
  ggplot(aes(Petal.Length)) +
  geom_histogram(bins = nclass.scott(iris$Petal.Length))
```

В этом типе графика точно так же можно раскрашивать на основании другой переменной:
```{r}
iris %>% 
  ggplot(aes(Petal.Length, fill = Species)) +
  geom_rug()+
  geom_histogram()
```

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

Кроме того, существует способ использовать не такой рубленный график, а его сглаженную вариант, ыйторый строиться при помои функции плотядерной оценки ности. Важное свойство, которое стоит понимать про функцию плотности --- что кривая, получаемая ядерной оценкой плотности, не зависит от величины коробки гистделения (хотя есть аргумент, который от `adjust`вечает за степень "близости" функции плотности к гистограмме).
```{r}
iris %>% 
  ggplot(aes(Petal.Length)) +
  geom_rug()+
  geom_density()
```

Таким образом мы можем сравнивать распределения:
```{r}
iris %>% 
  ggplot(aes(Petal.Length, fill = Species)) +
  geom_rug()+
  geom_density()
```

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

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

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

```{block, type = "rmdtask"}
В длинный список "2015 Kantar Information is Beautiful Awards" попала [визуализация Perceptions of Probability](https://www.informationisbeautifulawards.com/showcase/818-perceptions-of-probability), сделанная пользователем [zonination](https://github.com/zonination) в `ggplot2`. Попробуйте воспроизвести ее [с этими данными](https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/perceptions_of_probability.csv).
```

```{r, echo=FALSE, message=FALSE}
read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/perceptions_of_probability.csv") %>% 
  pivot_longer(names_to = "word", values_to = "ass_prob", `Almost Certainly`:`Chances Are Slight`) %>% 
  mutate(word = fct_reorder(word, ass_prob, mean)) %>% 
  ggplot(aes(ass_prob, word, fill = word))+
  geom_density_ridges_gradient(show.legend = FALSE)+
  labs(y = "", x = "assigned probability")
```

<details> <summary> 📋 список подсказок ➡ </summary> 

<details> <summary> 👁 как преобразовать в нужный формат? ➡ </summary>
Я делал это при помощи функции `pivot_longer()`. <br>
</details>

<details> <summary> 👁 не получается обратиться к колонкам ➡ </summary>
Да, если в названиях столбцов есть пробел или цифры, то к ним можно обратиться, воспользовавшись обратынми ковычками **`**. <br>
</details> 

<details> <summary> 👁 получается, но порядок неправильный... ➡ </summary>
Ага, мы обсуждали факторы. Функция `fct_reorder()` позволяяет менять порядок и даже задавать функцию, вроде среднего или медианы, которая должна быть применена к каждой группе. <br>
</details> 

<details> <summary> 👁 а как убрать легенду? ➡ </summary>
Легенду можно убрать добавив `show.legend = FALSE` в соответствующий `geom_...`.
<br>
</details>
</details>

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

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

```{r, cache=TRUE}
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()
```

![](images/boxplot.png)

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

```{r, cache=TRUE}
diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_wrap(~cut)
```
При этом иногда так бывает, что наличие какой-то одного значение в одном из фасетов, заставляет иметь одну и ту же шкалу для всех остальных. Это можно изменить при помощи аргумента `scales`:

```{r, cache=TRUE}
diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_wrap(~cut, scales = "free")
```

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

```{r, fig.height=15}
diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_wrap(~cut+color)
```

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

```{r, cache=TRUE}
diamonds %>% 
  ggplot(aes(carat, price))+
  geom_point(size = 0.3)+
  facet_grid(cut~color, scales = "free")
```

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


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


## Визуализация комбинаций признаков
### Потоковая Диаграмма (Sankey diagram)

Один из способов визуализации отношений между признаками называется [потоковая диаграмма](https://en.wikipedia.org/wiki/Sankey_diagram).

```{r, warning=FALSE}
library("ggforce")
zhadina <- read_csv("https://raw.githubusercontent.com/agricolamz/DS_for_DH/master/data/zhadina.csv")
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")
```

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

```{r, warning=FALSE}
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()`.

### UpSet Plot

Если диаграмма Sankey визуализирует попарные отношения между переменными, то график UpSet потенциально может визуализировать все возможные комбинации и является хорошей альтернативой диаграмме Вена, с большим количеством переменных (см. [эту статью Лауры Эллис](https://www.littlemissdata.com/blog/set-analysis)).

```{r, fig.height=9}
library(UpSetR)
movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=TRUE, sep=";" )
str(movies)
upset(movies[,3:19], nsets = 16, order.by = "freq")
```