Возвращаем тиббл: как векторизовать с помощью case_when?

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

Это работает независимо от того, есть ли у вас rowwise группа или нет.

Вы можете сделать это с switch, завернутым в map2:

Вот представитель:

library(tidyverse)

tibTest <- tibble(argX = 1:4, argY = 7:4)

square_it <- function(xx, yy) {
  map2(xx, yy, function(x, y){
    switch(which(c(x >= 4, 
                   x == 3, 
                   x == 2, 
                   x < 4 & x != 3 & x != 2)),
           tibble(x = NA, y = NA),
           tibble(x = as.integer(), y = as.integer()),
           tibble(x = x^2 - 1, y = y^2 -1),
           tibble(x = x^2, y = y^2))})
}

tibTest %>% mutate(sq =  square_it(argX, argY)) %>% unnest(cols = sq)
#> # A tibble: 3 x 4
#>    argX  argY     x     y
#>   <int> <int> <dbl> <dbl>
#> 1     1     7     1    49
#> 2     2     6     3    35
#> 3     4     4    NA    NA

^{Создано 16 мая 2020 г. пакетом REPEX (v0.3.0)}

Мы определяем row_case_when, который имеет аналогичный интерфейс формулы, что и case_when, за исключением того, что он имеет первый аргумент .data, действует построчно и ожидает, что значение каждого отрезка будет фреймом данных. Он возвращает data.frame / tibble. Обтекание списком, rowwise и unnest не нужны.

case_when2 <- function (.data, ...) {
    fs <- dplyr:::compact_null(rlang:::list2(...))
    n <- length(fs)
    if (n == 0) {
        abort("No cases provided")
    }
    query <- vector("list", n)
    value <- vector("list", n)
    default_env <- rlang:::caller_env()
    quos_pairs <- purrr::map2(fs, seq_along(fs), dplyr:::validate_formula,
        rlang:::default_env, rlang:::current_env())
    for (i in seq_len(n)) {
        pair <- quos_pairs[[i]]
        query[[i]] <- rlang::eval_tidy(pair$lhs, data = .data, env = default_env)
        value[[i]] <- rlang::eval_tidy(pair$rhs, data = .data, env = default_env)
        if (!is.logical(query[[i]])) {
            abort_case_when_logical(pair$lhs, i, query[[i]])
        }
        if (query[[i]]) return(value[[i]])
    }
}

row_case_when <- function(.data, ...) {
  .data %>% 
    group_by(.group = 1:n(), !!!.data) %>%
    do(case_when2(., ...)) %>%
    mutate %>%
    ungroup %>%
    select(-.group)
}

Тестовый забег

Он используется так:

library(dplyr)

tibTest <- tibble(argX = 1:4, argY = 7:4) # test data from question

tibTest %>%
  row_case_when(argX >= 4 ~ tibble(x = NA, y = NA),
    argX == 3 ~ tibble(x = as.integer(), y = as.integer()),
    argX == 2 ~ tibble(x = argX^2 - 1, y = argY^2 -1),
    TRUE   ~ tibble(x = argX^2,     y = argY^2)
  )

давая:

# A tibble: 3 x 4
   argX  argY     x     y
  <int> <int> <dbl> <dbl>
1     1     7     1    49
2     2     6     3    35
3     4     4    NA    NA

mutate_cond и mutate_when

Это не совсем то же самое, что row_case_when, поскольку они не проходят через условия, принимающие первое истинное, но, используя взаимоисключающие условия, их можно использовать для определенных аспектов этой проблемы. Они не обрабатывают изменение количества строк в результате, но мы можем использовать dplyr::filter для удаления строк для определенного условия.

mutate_cond определено в dplyr изменяет / заменяет несколько столбцы в подмножестве строк похожи на mutate, за исключением того, что второй аргумент является условием, а последующие аргументы применяются только к строкам, для которых это условие ИСТИНА.

mutate_when, определенный в dplyr для изменения / замены нескольких столбцы в подмножестве строк аналогичен case_when, за исключением того, что он применяется к строкам, значения замены предоставляются в виде списка, а альтернативными аргументами являются условия и списки. Кроме того, все участки всегда выполняются с применением значений замены к строкам, удовлетворяющим условиям (в отличие от выполнения замены только на первом истинном участке для каждой строки). Чтобы получить эффект, аналогичный row_case_, убедитесь, что условия исключают друг друга.

# mutate_cond example
tibTest %>%
  filter(argX != 3) %>%
  mutate(x = NA_integer_, y = NA_integer_) %>%
  mutate_cond(argX == 2, x = argX^2 - 1L, y = argY^2 - 1L) %>%
  mutate_cond(argX < 2, x = argX^2, y = argY^2)

# mutate_when example
tibTest %>%
  filter(argX != 3) %>%
  mutate_when(TRUE, list(x = NA_integer_, y = NA_integer_),
              argX == 2, list(x = argX^2 - 1L, y = argY^2 - 1L), 
              argX < 2, list(x = argX^2, y = argY^2))