```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

# Продвинутый tidyverse 

## Объединение нескольких датафреймов 

### Соединение структурно схожих датафреймов: bind_rows(), bind_cols() 

Загружаем датасет про супергероев:

```{r}
library("tidyverse")
heroes <- read_csv("https://raw.githubusercontent.com/Pozdniakov/tidy_stats/master/data/heroes_information.csv",
                   na = c("-", "-99"))
```

Теперь создадим следующие тибблы и сохраним их как `dc`, `marvel` и `other_publishers`:

```{r}
dc <- heroes %>%
  filter(Publisher == "DC Comics") %>%
  group_by(Gender) %>%
  summarise(weight_mean = mean(Weight, na.rm = TRUE))
dc

marvel <- heroes %>%
  filter(Publisher == "Marvel Comics") %>%
  group_by(Gender) %>%
  summarise(weight_mean = mean(Weight, na.rm = TRUE))
marvel

other_publishers <- heroes %>%
  filter(!(Publisher %in% c("DC Comics","Marvel Comics"))) %>%
  group_by(Gender) %>%
  summarise(weight_mean = mean(Weight, na.rm = TRUE))
other_publishers
```

Вертикально объединяем тибблы с помощью функции `bind_rows()`. 
Для корректного объединения тибблы должны иметь одинаковые названия колонок.

```{r}
bind_rows(dc, marvel)
```

Горизонтально объединяем тибблы с помощью функции `bind_cols()`.

```{r}
bind_cols(dc, marvel)
```

Функции `bind_rows()` и `bind_cols()` могут работать с тремя и более датафреймами.

```{r}
bind_rows(dc, marvel, other_publishers)
```

На входе в функции `bind_rows()` и `bind_cold()` можно подавать как сами датафреймы или тибблы через запятую, так и список из датафреймов/тибблов.

```{r}
heroes_list_of_df <- list(DC = dc, 
                          Marvel = marvel, 
                          Other = other_publishers)
bind_rows(heroes_list_of_df)
```

Чтобы не потерять, из какого датафрейма какие данные, можно указать любое строковое значение (название будущей колонки) для необязательного аргумента `.id =`.

```{r}
bind_rows(heroes_list_of_df, .id = "Publisher")
```

`bind_rows()` - если данные хранятся в разных файлах с одинаковой структурой. Читаем все таблицы, заводим их список и объединяем в единое целое.

### Реляционные данные: `*_join()` от `dplyr` 

![](images/joins.png){width="400"}

Функционал `left_join()`, `right_join()`, `full_join()` и `inner_join()` аналогичен pandas в Python и join-функциям в запросах к базам данным. 
**Ключ** - одна или несколько колонок в каждой из табличек, по которым мы можем объединить данные из табличек. Ключ должен однозначно идентифицировать наблюдения и содержать уникальные значения. Если ключи неуникальные, то функции `*_join()` не будут выдавать ошибку. Вместо этого они добавят в итоговую таблицу все возможные пересечения повторяющихся ключей. 

Возьмем тибблы `band_members` и `band_instruments`, встроенные в `dplyr` для демонстрации работы функций `*_join()`. Ключ - колонка `name`, одноименная в двух тибблах. 

```{r}
band_members
band_instruments
```

-   `left_join()`:
данные из левого тиббла дополняются информацией из правого тиббла. Все уникальные наблюдения в левом тиббле сохраняются, но отбрасываются строки в правом тиббле, не нашедшие соответствия в левой таблице. В ячейках, которым не нашлось соотвествия в правой таблице, ставится значение `NA`.
```{r}
band_members %>%
  left_join(band_instruments)
```

Чтобы явно задать колонки-ключи, используем параметр `by =`. По умолчанию объединение производится по всем колонкам с одинаковыми названиями в двух тибблах.

```{r}
band_members %>%
  left_join(band_instruments, by = "name")
```

Если колонки-ключи называются по-разному в двух тибблах, можно вручную прописать соответствия:

```{r}
band_members %>%
  left_join(band_instruments2, by = c("name" = "artist"))
```

-   `right_join()`:
Все с точностью наборот: строки левой таблицы, не нашедшие соответствия в правой таблице, отбрасываются. 
```{r}
band_members %>%
  right_join(band_instruments)
```

-   `full_join()`:
Сохраняет все строки из левой и правой таблицы, при несовпадении ключей вставляется значение `NA`.
```{r}
band_members %>%
  full_join(band_instruments)
```

-   `inner_join()`:
Сохраняет только строки, общие для левой и правой таблиц.
```{r}
band_members %>%
  inner_join(band_instruments)
```

-   `semi_join()`:
Функции `semi_join()` и `anti_join()` не присоединяют второй датафрейм/тиббл к первому. Вместо этого они используются как некоторый словарь-фильтр для отделения только тех значений в левой таблице, которые есть в правой (`semi_join()`) или, наоборот, которых нет в правой (`anti_join()`).

```{r}
band_members %>%
  semi_join(band_instruments)
```

-   `anti_join()`:

```{r}
band_members %>%
  anti_join(band_instruments)
```

## Tidy data: `tidyr::pivot_longer()`, `tidyr::pivot_wider()` 

Принцип tidy data предполагает, что каждая строчка содержит в себе одно наблюдение (измерение), а каждая колонка - одну характеристику. Но как именно хранить повторные измерения? 

-   `tidyr::pivot_longer()`: из *широкого* в *длинный* формат

-   `tidyr::pivot_wider()`: из *длинного* в *широкий* формат

![](images/tidyr-longer-wider.gif)
```{r}
new_diet <- tibble(
  student = c("Маша", "Рома", "Антонина"),
  before_r_course = c(70, 80, 86),
  after_r_course = c(63, 74, 71)
)
new_diet
```

Тиббл `new_diet` - это пример широкого формата данных.

Превратим тиббл `new_diet` длинный:

```{r}
new_diet %>%
  pivot_longer(cols = before_r_course:after_r_course,
               names_to = "measurement_time", 
               values_to = "weight_kg")
```

А теперь обратно в короткий:

```{r}
new_diet %>%
  pivot_longer(cols = before_r_course:after_r_course,
               names_to = "measurement_time", 
               values_to = "weight_kg") %>%
  pivot_wider(names_from = "measurement_time",
              values_from = "weight_kg")
```

## Трансформация нескольких колонок: `dplyr::across()`

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

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(height = mean(Height, na.rm = TRUE),
            weight = mean(Weight, na.rm = TRUE))
```

`dplyr::across()` - аналог `apply()` в tydyverse, использует tidyselect для выбора колонок.

Функция `across()` появилась в пакете `dplyr` относительно недавно, до этого для работы с множественными колонками в tidyverse использовались многочисленные функции `*_at()`, `*_if()`, `*_all()`, например, `summarise_at()`, `summarise_if()`, `summarize_all()`. Эти функции до сих пор присутствуют в `dplyr`, но считаются устаревшими. Другая альтернатива - использование пакета `purrr` (@sec-purrr) или семейства функций `apply()` (@sec-apply_f).

Таким образом, конструкции с функцией `across()` можно разбить на три части:

1.  Выбор колонок с помощью tidyselect. Здесь работают все те приемы, которые мы изучили при выборе колонок (@sec-tidyselect).
2.  Собственно применение функции `across()`. Первый аргумент `.col` -- колонки, выбранные на первом этапе с помощью tidyselect, по умолчанию это `everything()`, т.е. все колонки. Второй аргумент `.fns` -- это функция или целый список из функций, которые будут применены к выбранным колонкам. Если функции требуют дополнительных аргументов, то они могут быть перечислены внутри `across()`.
3.  Использование `summarise()` или другой функции `dplyr`. В этом случае в качестве аргумента для функции используется результат работы функции `across()`.

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(across(c(Height,Weight), mean))
```

Функция `mean()` при столкновении хотя бы с одним `NA` будет возвращать `NA`, если мы не изменим параметр `na.rm =`. Дополнительные для функции аргументы можно перечислить через запятую после названия функции:

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(across(c(Height, Weight), mean, na.rm = TRUE))
```

Посчитаем среднее для всех numeric колонок:

```{r}
heroes %>%
  drop_na(Height, Weight) %>%
  group_by(Gender) %>%
  summarise(across(where(is.numeric), mean, na.rm = TRUE))
```

Или длину строк для строковых колонок -- с помощью анонимной функции `function()`.

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(across(where(is.character), 
                   function(x) mean(nchar(x), na.rm = TRUE)))
```

Два `across()` внутри одного `summarise()`:

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(across(where(is.numeric), mean, na.rm = TRUE),
            across(where(is.character), 
                   function(x) mean(nchar(x), na.rm = TRUE)))
```

Внутри одного `across()` можно применить не одну функцию к каждой из выбранных колонок, а сразу несколько функций для каждой из колонок. Для этого нам нужно использовать список функций (желательно - проименованный).

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(across(c(Height, Weight), 
                   list(minimum = min,
                        average = mean,
                        maximum = max), 
                   na.rm = TRUE))
```

Cписок функций:

```{r}
heroes %>%
  group_by(Gender) %>%
  summarise(across(c(Height, Weight),
                   list(min = function(x) min(x, na.rm = TRUE),
                        mean = function(x) mean(x, na.rm = TRUE),
                        max = function(x) max(x, na.rm = TRUE),
                        na_n = function(x, ...) sum(is.na(x)))
                   )
            )
```

Хотя основное применение функции `across()` -- это массовое подытоживание с помощью `summarise()`, `across()` можно использовать и с другими функциями `dplyr`. 
Массовые операции с колонками с помощью `mutate()`:

```{r}
heroes %>%
  mutate(across(where(is.character), as.factor))
```

Внутри `count()` вместе с функцией `n_distinct()`, которая считает количество уникальных значений в векторе:

```{r}
heroes %>%
  count(across(where(function(x) n_distinct(x) <= 6)))
```

## Функциональное программирование: `purrr` 

`purrr` -- пакет для функционального программирования в tidyverse. 
Здесь речь пойдет об аналогах функций семейства `apply()` из базового R.

- `lapply()` 
в качестве первого аргумента функция `lapply()` принимает список (или то, что может быть в него превращено, например, датафрейм), в качестве второго - функцию, которая будет применена к каждому элементу списка. На выходе получается список такой же длины.

```{r}
lapply(heroes, class)
```

- `purrr::map()` 
работает по тому же принципу:

```{r}
map(heroes, class)
```

`map()` можно встроить в канал с пайпом (впрочем, как и `lapply()`):

```{r}
heroes %>%
  map(class)
```

-  `sapply()` 
из базового R упрощает результат до вектора, если это возможно. 
-  `vapply()` 
из базового R добавляет управление типом данных на выходе, но она не очень удобная. 

- `map_*()`
множество функций из `purrr`, где вместо звездочки - нужный формат на выходе.

  - `map_chr()`:

```{r}
heroes %>%
  map_chr(class)
```

  - `map_df()`
  возвращает результат как датафрейм:

```{r}
heroes %>%
  map_df(class)
```

Так же как и функции семейства `apply()`, функции `map_*()` сочетаются с анонимными функциями:

```{r}
heroes %>%
  map_int(function(x) sum(is.na(x)))
```

Более короткий способ записи анонимных функций: `function(arg)` заменяется на `~`, а `arg` на `.`.

```{r}
heroes %>%
  map_int(~sum(is.na(.)))
```

Если нужно итерироваться сразу по нескольким спискам, то есть функции `map2_*()` (для двух списков) и `pmap_*()` (для нескольких списков).

## Колонки-списки и нестинг: `nest()` 

Ранее мы говорили о том, что датафрейм -- это по своей сути список из векторов разной длины. На самом деле, это не совсем так: колонки обычного датафрейма вполне могут быть списками. Однако делать так обычно не рекомендуется, пусть R это и не запрещает создавать такие колонки: многие функции предполагают, что все колонки датафрейма являются векторами.

`tidyverse` лучше заточен на использование списков в качестве колонок (**колонок-списков** (list columns)). 
- `tidyr::nest()`
С помощью tidyselect нужно выбрать сжимаемые колонки, которые будут агрегированы по невыбранным колонками - это и есть нестинг.

```{r}
heroes %>%
  nest(!Gender)
```

Заметьте, у нас появилась колонка `data`, в которой содержатся тибблы. Туда и спрятались все наши данные.

Нестинг похож на агрегирование с помощью `group_by()`. Если сделать нестинг сгруппированного с помощью `group_by()` тиббла, то сожмутся все колонки кроме тех, которые выступают в качестве групп:

```{r}
heroes %>%
  group_by(Gender) %>%
  nest()
```

Теперь можно работать с колонкой-списком как с обычной колонкой. Например, применять функцию для каждой строчки (то есть для каждого тиббла) с помощью `map()` и записывать результат в новую колонку с помощью `mutate()`.

```{r}
heroes %>%
  group_by(Gender) %>%
  nest() %>%
  mutate(dim = map(data, dim))
```

В конце концов нам нужно "разжать" сжатую колонку-список. Сделать это можно с помощью `unnest()`, выбрав с помощью tidyselect нужные колонки.

```{r}
heroes %>%
  group_by(Gender) %>%
  nest() %>%
  mutate(dim = map(data, dim)) %>%
  unnest(dim)
```

Разжатая колонка обычно больше сжатой, поэтому разжатие привело к удлинению тиббла. Вместо удлинения тиббла, его можно расширить с помощью `unnest_wider()`.

```{r}
heroes %>%
  group_by(Gender) %>%
  nest() %>%
  mutate(dim = map(data, dim)) %>%
  unnest_wider(dim, names_sep = "_") 
```

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

```{r}
films <- tribble(
  ~film, ~genres,
  "Ирония Судьбы", "comedy, drama",
  "Большой Лебовски", "comedy, criminal",
  "Аватар", "fantasy, drama"
)

films
```

- `strsplit()`
разбивает значения вектора по выбранному разделителю. Поскольку результат -- список, перезаписанная колонка `genres` станет колонкой-списком.

```{r}
films %>%
  mutate(genres = strsplit(genres, ", "))
```

Теперь нам нужно сделать `unnest()`

```{r}
films %>%
  mutate(genres = strsplit(genres, ", ")) %>%
  unnest()
```

Теперь у нас данные в длинном виде! Результат можно расширить с помощью уже знакомого `pivot_wider()` и дополнительной колонки со значениями `TRUE`. Если соответствующей пары нет в тиббле, то в итоговой широкой таблице будет `NA`, мы можем поменять их на `FALSE` с помощью параметра `values_fill =`.

```{r}
films %>%
  mutate(genres = strsplit(genres, ", ")) %>%
  unnest() %>%
  mutate(value = TRUE) %>%
  pivot_wider(names_from = "genres",
              values_from = "value", values_fill = FALSE)
```

- `tidyr::separate_rows()`:
заменяет связку `strsplit()` с `unnest()`:

```{r}
films %>%
  separate_rows(genres, sep = ", ") %>%
  mutate(value = TRUE) %>%
  pivot_wider(names_from = "genres",
              values_from = "value", values_fill = FALSE)
```

Наибольшее распространение нестинг получил в смычке с пакетом `broom` для расчета множественных статистических моделей.

