返回 tibble：如何使用 case_when 进行矢量化？

Question

我有一个 return 的函数。它运行正常，但我想对其进行矢量化。

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

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

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

我第一次对其进行矢量化尝试失败了，我明白了为什么 - 我不能 return 小标题矢量。

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

我的下一次尝试在简单输入上运行正常。我可以 return 一个 tibbles 列表，这就是我想要的 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。但是在构建 tibble，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 获得与使用 square_it 相同的结果，但使用 case_when 从向量化函数中获得相同的结果？

Answer 1

您需要确保在每次调用该函数时创建一个 1 行小标题，然后对其进行矢量化。

无论您是否有 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

^{由 reprex package (v0.3.0)}

于 2020-05-16 创建

Answer 2

我们定义row_case_when，它有一个与case_when类似的公式接口，除了它有一个第一个参数.data，按行操作，并期望每条腿的值是一个数据框.它returns一个数据。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 与 mutate 类似，只是第二个参数是一个条件，后续参数仅应用于该条件为 TRUE 的行。

mutate_when 定义于与 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))

返回 tibble：如何使用 case_when 进行矢量化？

Returning a tibble: how to vectorize with case_when?

r

dplyr

tibble

unnest

测试运行

mutate_cond 和 mutate_when