#devtools::install_github("tidyverse/dplyr")
library(dplyr)

# Основные изменения
## теперь sunnarise может вернуть
### вектор любой длинны
### дата фрейм любой размерности

# #######################################################
# тестовые данные
# #######################################################
df <- tibble(
  grp = rep(1:2, each = 5), 
  x = c(rnorm(5, -0.25, 1), rnorm(5, 0, 1.5)),
  y = c(rnorm(5, 0.25, 1), rnorm(5, 0, 0.5)),
)

df

# получим минимальные и максимальные значения для каждой группы
# и поместим эти значения в строки
df %>% 
  group_by(grp) %>% 
  summarise(rng = range(x))

## функция range возвращает вектор длинны 2
range(df$x)
## но функция summarise разворачивает его, 
## приводя каждое из возвращаемых значений в новую строку

# тоже самое, но для столбцов
df %>% 
  group_by(grp) %>% 
  summarise(tibble(min = min(x), mean = mean(x)))

# #######################################################
# Расчёт квантилей
# #######################################################
df %>% 
  group_by(grp) %>% 
  summarise(x = quantile(x, c(0.25, 0.5, 0.75)), q = c(0.25, 0.5, 0.75))

# можем избежать дублирования кода и написать функцию для вычисления квантиля
quibble <- function(x, q = c(0.25, 0.5, 0.75)) {
  tibble(x = quantile(x, q), q = q)
}
# используем собственную функцию в summarise
df %>% 
  group_by(grp) %>% 
  summarise(quibble(x, c(0.25, 0.5, 0.75)))

# доработаем функцию таким образом 
# что бы названия столбца подтягивались из аргумена
quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
  tibble("{{ x }}" := quantile(x, q), "{{ x }}_q" := q)
}

df %>% 
  group_by(grp) %>% 
  summarise(quibble2(x, c(0.25, 0.5, 0.75)))

# мы не присваивали имена новых столбцов внутри summarise
# потому что если функция возвращает объект сложной стурктуры
# мы получим вложенные дата фреймы
out <- df %>% 
  group_by(grp) %>% 
  summarise(quantile = quibble2(y, c(0.25, 0.75)))

str(out)

# обращаемся к вложенному фрейму
out$y

# или к его столбцам
# по смыслу такая конструкция напоминает объяденённые имена стобцов в электронных таблицах
out$quantile$y_q

# summarise + rowwise
# эта комбинация функций теперь может заменить purrr и apply
tibble(path = dir(pattern = "\\.csv$")) %>% 
  rowwise(path) %>% 
  summarise(readr::read_csv(path))

# #######################################################
# Предыдущие подходы
# #######################################################
# вычисляем квантили
df %>% 
  group_by(grp) %>% 
  summarise(y = list(quibble(y, c(0.25, 0.75)))) %>% 
  tidyr::unnest(y)

df %>% 
  group_by(grp) %>% 
  do(quibble(.$y, c(0.25, 0.75)))

• Статья
• Код на GitHub
• Видео на YouTube

#devtools::install_github("tidyverse/dplyr")
library(dplyr, warn.conflicts = FALSE)

# rename
# Переименовать столбцы для устранение дублирования их имён
df1 <- tibble(a = 1:5, a = 5:1, .name_repair = "minimal")
df1

df1 %>% rename(b = 2)

# select
# обращение к столбцам по типу
df2 <- tibble(x1 = 1, x2 = "a", x3 = 2, y1 = "b", y2 = 3, y3 = "c", y4 = 4)

# числовые столбцы
df2 %>% select(is.numeric)
# НЕ текстовые столбцы
df2 %>% select(!is.character)

# смешанный тип обращения
# числовые стобцы, название которых начинается на X
df2 %>% select(starts_with("x") & is.numeric)

# выбор полей с помощью функций any_of и all_of
vars <- c("x1", "x2", "y1", "z")
df2 %>% select(any_of(vars))

df2 %>% select(all_of(vars))

# функция rename_with
df2 %>% rename_with(toupper)

df2 %>% rename_with(toupper, starts_with("x"))

df2 %>% rename_with(toupper, is.numeric)

# relocate для изменения порядка стобцов
df3 <- tibble(w = 0, x = 1, y = "a", z = "b")
# переместить столбцы y, z в начало
df3 %>% relocate(y, z)
# переместить текстовые столбцы вначало
df3 %>% relocate(is.character)

# поместить столбец w после y
df3 %>% relocate(w, .after = y)
# поместить столбец w перед y
df3 %>% relocate(w, .before = y)
# переместить w в конец
df3 %>% relocate(w, .after = last_col())

• Статья
• Код на GitHub
• Видео на YouTube

# devtools::install_github("tidyverse/dplyr")
library(dplyr, warn.conflicts = FALSE)

# тестовый дата фрейм
df <- tibble(g1 = as.factor(sample(letters[1:4],size = 10, replace = T )),
             g2 = as.factor(sample(LETTERS[1:3],size = 10, replace = T )),
             a  = runif(10, 1, 10),
             b  = runif(10, 10, 20),
             c  = runif(10, 15, 30),
             d  = runif(10, 1, 50))

# о чём пойдёт речь
## копирование кода, когда требуется 
## произвести одну и туже операцию с разными функциями
df %>% 
  group_by(g1, g2) %>% 
  summarise(a = mean(a), b = mean(b), c = mean(c), d = mean(c))

# новый способ
## теперь для таких преобразований можно
## использовать тот же синтаксис что и в select()
### посчитать среднее по столбцам от a до d
df %>% 
  group_by(g1, g2) %>% 
  summarise(across(a:d, mean))

### или посчитать среднее выбрав все числовые столбцы 
df %>% 
  group_by(g1, g2) %>% 
  summarise(across(is.numeric, mean))

# ##############################
# Простой пример
# аргументы функции accros

## .cols - выбор столбцов по позиции, имени, функцией, типу данных, или комбинируя любые перечисленные способы
## .fns - функция, или список функций которые необходимо применить к каждому столбцу

## считаем количество униклаьных значений в текстовых полях
starwars %>% 
  summarise(across(is.character, n_distinct))

## пример с фильтрацией данных
starwars %>% 
  group_by(species) %>% 
  filter(n() > 1) %>% 
  summarise(across(c(sex, gender, homeworld), n_distinct))

## комбинируем accross с другими вычислениями
starwars %>% 
  group_by(homeworld) %>% 
  filter(n() > 1) %>% 
  summarise(across(is.numeric, mean, na.rm = TRUE), 
            n = n())

# ##############################
# Чем accross лучше предыдущих функций с суфиксами _at, _if, _all

## 1. accross позволяет комбинировать различные вычисления внутри одной summarise 
## пример из статьи
df %>%
  group_by(g1, g2) %>% 
  summarise(
    across(is.numeric, mean), 
    across(is.factor, nlevels),
    n = n(), 
  )

## рабочий пример
starwars %>% 
  group_by(species) %>% 
  summarise(across(is.character, n_distinct), 
            across(is.numeric, mean), 
            across(is.list, length), 
            n = n()
  )

## 2. уменьшает количество необходимых функций в dplyr, что облегчает их запоминание
## 3. объединяет возможности функций с суфиксами if_, at_, и даёт возможность объединять их возможности
## 4. accross не требует от вас использования функции vars для указания нужных столбцлв, как это было раньше

# ##############################
# перевод старого кода на accross

## для перевода функций с суфиксами _at, _if, _all используйте следующие правила
### в accross первым агрументом будет:
### Для *_if() старый второй аргумент.
### Для *_at() старый второй аргумент с удаленным вызовом vars().
### Для *_all(), в качестве первого аргумента передайте функцию everything()

## примеры
df <- tibble(y_a  = runif(10, 1, 10),
             y_b  = runif(10, 10, 20),
             x    = runif(10, 15, 30),
             d    = runif(10, 1, 50))

### из _if в accross
df %>% mutate_if(is.numeric, mean, na.rm = TRUE)
# ->
df %>% mutate(across(is.numeric, mean, na.rm = TRUE))

### из _at в accross
df %>% mutate_at(vars(c(x, starts_with("y"))), mean, na.rm = TRUE)
# ->
df %>% mutate(across(c(x, starts_with("y")), mean, na.rm = TRUE))

### из _all в accroos
df %>% mutate_all(mean, na.rm = TRUE)
# ->
df %>% mutate(across(everything(), mean, na.rm = TRUE))

• Статья
• Код на GitHub
• Видео на YouTube

#devtools::install_github("tidyverse/dplyr")
library(dplyr)

# test data
df <- tibble(
  student_id = 1:4, 
  test1 = 10:13, 
  test2 = 20:23, 
  test3 = 30:33, 
  test4 = 40:43
)

df

# попытка посчитать среднюю оценку по студету
df %>% mutate(avg = mean(c(test1, test2, test3, test4)))

# используем rowwise для преобразования фрейма
rf <- rowwise(df, student_id)
rf

rf %>% mutate(avg = mean(c(test1, test2, test3, test4)))

# тоже самое с использованием c_across
rf %>% mutate(avg = mean(c_across(starts_with("test"))))

# ###########################
# некоторые арифметические операции векторизированы по умолчанию
df %>% mutate(total = test1 + test2 + test3 + test4)

# этот подход можно использовать для вычисления среднего
df %>% mutate(avg = (test1 + test2 + test3 + test4) / 4)

# так же вы можете использовать некоторые специальные функции
# для вычисления некоторых статистик
df %>% mutate(
  min = pmin(test1, test2, test3, test4), 
  max = pmax(test1, test2, test3, test4), 
  string = paste(test1, test2, test3, test4, sep = "-")
)
# все векторизированные функции будут работать быстрее чем rowwise
# но rowwise позволяет векторизировать любую функцию

# ##################################
# работа со столбцами списками
df <- tibble(
  x = list(1, 2:3, 4:6),
  y = list(TRUE, 1, "a"),
  z = list(sum, mean, sd)
)

# мы можем перебором обработать каждый список
df %>% 
  rowwise() %>% 
  summarise(
    x_length = length(x),
    y_type = typeof(y),
    z_call = z(1:5)
  )

# ##################################
# симуляция случайных данных
df <- tribble(
  ~id, ~ n, ~ min, ~ max,
  1,   3,     0,     1,
  2,   2,    10,   100,
  3,   2,   100,  1000,
)

# используем rowwise для симуляции данных
df %>%
  rowwise(id) %>%
  mutate(data = list(runif(n, min, max)))

df %>%
  rowwise(id) %>%
  summarise(x = runif(n, min, max))

# ##################################
# функция nest_by позволяет создавать столбцы списки
by_cyl <- mtcars %>% nest_by(cyl)
by_cyl

# такой подход удобно использовать при построении линейной модели
# используем mutate для подгонки моели под каждую группа данных
by_cyl <- by_cyl %>% mutate(model = list(lm(mpg ~ wt, data = data)))
by_cyl
# теперь с помощью summarise 
# можно извлекать сводки или коэфициенты построенной модели
by_cyl %>% summarise(broom::glance(model))
by_cyl %>% summarise(broom::tidy(model))

• Статья
• Код на GitHub
• Видео на YouTube

#devtools::install_github("tidyverse/dplyr")
library(dplyr)

# summarise + .groups
starwars %>% 
  group_by(homeworld, species) %>% 
  summarise(n = n())

## аргумент .groups
### .groups = "drop_last" удалит последнюю группу
### .groups = "drop" удалит всю группировку
### .groups = "keep" созранит всю группировку
### .groups = "rowwise" разобъёт фрейм на группы как rowwise()

# rows_*()
## rows_update(x, y) обновляет строки в таблице x найденные в таблице y
## rows_patch(x, y) работает аналогично rows_update() но заменяет только NA
## rows_insert(x, y) добавляет строки в таблицу x из таблицы y
## rows_upsert(x, y) обновляет найденные строки в x и добавляет не найденные из таблицы y
## rows_delete(x, y) удаляет строки из x найденные в таблице y.

# Создаём тестовые данные
df <- tibble(a = 1:3, b = letters[c(1:2, NA)], c = 0.5 + 0:2)
df

new <- tibble(a = c(4, 5), b = c("d", "e"), c = c(3.5, 4.5))
new

# Базовые примеры
## добавляем новые строки
df %>% rows_insert(new)

## row_insert вернёт ошибку если мы попытаемся добавить уже существующую строку
df %>% rows_insert(tibble(a = 3, b = "c"))

## если вы хотите обновить существующее значение необходимо использовать row_update
df %>% rows_update(tibble(a = 3, b = "c"))

## но rows_update вернёт ошибку если вы попытаетесь обновить несуществующее значание
df %>% rows_update(tibble(a = 4, b = "d"))

## rows_patch заполнит только пропущенные значения по ключу
df %>% 
  rows_patch(tibble(a = 2:3, b = "B"))

## rows_upsert также вы можете добавлять новые и заменять существуюие значения 
## функцией rows_upsert
df %>% 
  rows_upsert(tibble(a = 3, b = "c")) %>% 
  rows_upsert(tibble(a = 4, b = "d"))

# ################################
# РАЗБЕРЁМ Аргументы немного более подробно
set.seed(555)

# менеджеры
managers <- c("Paul", "Alex", "Tim", "Bill", "John")
# товары
products <- tibble(name  = paste0("product_", LETTERS), 
                   price = round(runif(n = length(LETTERS), 100, 400), 0))

# функция генерации купленных товаров
prod_list <- function(prod_list, size_min, size_max) {

  prod <- tibble(product = sample(prod_list, 
                                  size = round(runif(1, size_min, size_max), 0) ,
                                  replace = F))
    return(prod)
}

# генерируем продажи
sales <- tibble(id         = 1:200,
                manager_id = sample(managers, size = 200, replace = T),
                refund     = FALSE,
                refund_sum = 0)

# генерируем списки купленных товаров
sale_proucts <-
    sales %>%
      rowwise(id) %>%
      summarise(prod_list(products$name, 1, 6)) %>%
      left_join(products, by = c("product" = "name"))

# объединяем продажи с товарами
sales <- left_join(sales, sale_proucts, by = "id")

# возвраты
refund <- sample_n(sales, 25) %>%
          mutate( refund = TRUE,
                  refund_sum = price * 0.9) %>%
          select(-price, -manager_id) 

# отмечаем возвраты в таблице продаж
sales %>%
  rows_update(refund)

# аргумент by
result <-
  sales %>%
    rows_update(refund, by = c("id", "product"))

• Статья
• Код на GitHub
• Видео на YouTube