返回 tibble : how to vectorize with case_when?

Question

我有一个返回小标题的函数。它运行正常，但我想对其进行矢量化。

library(tidyverse)

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

square_it <- function(xx, yy) {
  if(xx >= 4){
    tibble(x = NA, y = NA)
  } else if(xx == 3){
    tibble(x = as.integer(), y = as.integer())
  } else if (xx == 2){
    tibble(x = xx^2 - 1, y = yy^2 -1)
  } else {
    tibble(x = xx^2, y = yy^2)
  }
}

它在 mutate 中运行正常当我用 map2 调用它时，给我我想要的结果:

tibTest %>%
  mutate(sq = map2(argX, argY, square_it)) %>%
  unnest()
## 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

我第一次尝试对它进行矢量化失败了，我明白为什么 - 我无法返回小标题的矢量。

square_it2 <- function(xx, yy){
  case_when(
    x >= 4 ~ tibble(x = NA, y = NA),
    x == 3 ~ tibble(x = as.integer(), y = as.integer()),
    x == 2 ~ tibble(x = xx^2 - 1, y = yy^2 -1),
    TRUE   ~ tibble(x = xx^2,     y = yy^2)
  )
}
# square_it2(4, 2)  # FAILS

我的下一次尝试在一个简单的输入上运行正常。我可以返回一个小标题列表，这就是我想要的 unnest

square_it3 <- function(xx, yy){
  case_when(
    xx >= 4 ~ list(tibble(x = NA, y = NA)),
    xx == 3 ~ list(tibble(x = as.integer(), y = as.integer())),
    xx == 2 ~ list(tibble(x = xx^2 - 1, y = yy^2 -1)),
    TRUE   ~ list(tibble(x = xx^2,     y = yy^2))
  )
}
square_it3(4, 2)
# [[1]]
# # A tibble: 1 x 2
# x     y    
# <lgl> <lgl>
#   1 NA    NA   

但是当我在 mutate 中调用它时，它没有给我我用 square_it 得到的结果.我能看出是什么
错误的。在 xx == 2条款，xx充当 2 的原子值。但在
build 小玩意，xx是一个长度为 4 的向量。

tibTest %>%
  mutate(sq =  square_it3(argX, argY)) %>%
  unnest()
# # A tibble: 9 x 4
#    argX  argY     x     y
#    <int> <int> <dbl> <dbl>
# 1     1     7     1    49
# 2     1     7     4    36
# 3     1     7     9    25
# 4     1     7    16    16
# 5     2     6     0    48
# 6     2     6     3    35
# 7     2     6     8    24
# 8     2     6    15    15
# 9     4     4    NA    NA

我如何获得与 square_it 相同的结果，但来自使用 case_when 的矢量化函数?

Answer 1

我们定义 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/replace several columns on a subset of rows就像 mutate除了第二个参数是一个条件，随后的参数仅应用于该条件为 TRUE 的行。
mutate_when定义于
dplyr mutate/replace several columns on a subset of rows类似于 case_when除了适用于行之外，替换值在列表中提供，替代参数是条件和列表。此外，所有分支始终运行，将替换值应用于满足条件的行(而不是对于每一行，仅在第一个真正分支上执行替换)。获得类似 row_case 的效果_when 确保条件是互斥的。

# 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))