为什么R中只有‘case _ when’给出不同的结果？

Question

当我在本文中使用＜code＞dplyr:：case_when＜code＞而不是＜code＞if＜code＞时，我注意到了下面的这种行为。如果第二个分支的输出是一个显式字符串，它将按预期工作，但如果指定了＜code＞x＜/code＞本身，结果将发生变化。

为什么只有< code>case_when给出不同的结果？

x <- character(0)

dplyr::case_when(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ "Not empty")
#> [1] "Empty"
dplyr::case_when(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ x)
#> character(0)

if (rlang::is_empty(x)) "Empty" else if (!rlang::is_empty(x)) "Not empty"
#> [1] "Empty"
if (rlang::is_empty(x)) "Empty" else if (!rlang::is_empty(x)) x
#> [1] "Empty"

ifelse(rlang::is_empty(x), "Empty", "Not empty")
#> [1] "Empty"
ifelse(rlang::is_empty(x), "Empty", x)
#> [1] "Empty"

由reprex软件包（v2.0.1）于2022年8月16日创建

Answer 1

这是因为< code>case_when试图将所有公式循环到一个共同的长度。文件上说:

LHS 和 RHS 的长度可能相同，为 1 或 n。n 的值在所有情况下都必须一致。n == 0 的情况被视为 n ！= 1 的变体。

在你的第二个例子中，你提供了一个长度为0的向量作为其中一个公式的RHS，这就是返回长度为0的向量的原因；只是巧合，返回值和false case的RHS一样。

在考虑以下示例时，此行为似乎不那么令人惊讶：

library(dplyr, warn.conflicts = FALSE)

case_when(TRUE ~ 1, FALSE ~ numeric(0))
#> numeric(0)

case_when(TRUE ~ 1, FALSE ~ numeric(1))
#> [1] 1

case_when(TRUE ~ 1, FALSE ~ numeric(2))
#> [1] 1 1

case_when(TRUE ~ 1, FALSE ~ numeric(3))
#> [1] 1 1 1

Answer 2

case_when和ifelse之间的一个很大区别是，case_when将右侧参数强制为相同的类型。从 ？case_when：

RHS 不需要是合乎逻辑的，但所有 RHS 的计算结果都必须为相同类型的向量。

它还可能引发错误。

dplyr::case_when(rlang::is_empty(x) ~ 1, !rlang::is_empty(x) ~ "2")
# Error in names(message) <- `*vtmp*` : 
#   'names' attribute [1] must be the same length as the vector [0]
dplyr::case_when(rlang::is_empty(x) ~ "1", !rlang::is_empty(x) ~ "2")
[1] "1"

这些信息肯定可以更具体。

如前所述，这并不能解释我认为case_when源代码中的错误，特别是validate_case_when_length：

m <- dplyr:::validate_case_when_length(query, value, fs, error_call = error_call)

在这种情况下会错误地返回0。

mycase_when <- function (...) 
{
  fs <- dplyr:::compact_null(rlang:::list2(...))
  n <- length(fs)
  error_call <- current_env()
  if (n == 0) {
    abort("No cases provided.", call = error_call)
  }
  query <- vector("list", n)
  value <- vector("list", n)
  default_env <- caller_env()
  quos_pairs <- dplyr:::map2(fs, seq_along(fs), dplyr:::validate_formula, default_env = default_env, 
                     dots_env = current_env(), error_call = error_call)
  for (i in seq_len(n)) {
    pair <- quos_pairs[[i]]
    query[[i]] <- eval_tidy(pair$lhs, env = default_env)
    value[[i]] <- eval_tidy(pair$rhs, env = default_env)
    if (!is.logical(query[[i]])) {
      abort_case_when_logical(pair$lhs, i, query[[i]], 
                              error_call = error_call)
    }
  }
  m <- dplyr:::validate_case_when_length(query, value, fs, error_call = error_call)
  
  print(paste('m',m))
  
  print(paste('value', value))
  print(paste('value[[1]][1]', value[[1]][1]))
  out <- value[[1]][rep(NA_integer_, m)]
  replaced <- rep(FALSE, m)
  print(paste('out 1',out))
  for (i in seq_len(n)) {
    out <- dplyr:::replace_with(out, query[[i]] & !replaced, value[[i]], 
                        NULL, error_call = error_call)
    replaced <- replaced | (query[[i]] & !is.na(query[[i]]))
  }
#  print(paste('out 2',out))
  out
}

mycase_when(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ "Not empty")
mycase_when(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ x)
mycase_when(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ "Not empty")
[1] "m 1"
[1] "value Empty"     "value Not empty"
[1] "value[[1]][1] Empty"
[1] "out 1 NA"
[1] "Empty"
mycase_when(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ x)
[1] "m 0"
[1] "value Empty"        "value character(0)"
[1] "value[[1]][1] Empty"
[1] "out 1 "
character(0)

Answer 3

这可能是case_when或其内部助手函数中的错误。我们可以在case_when的源代码中放置浏览器，以查看在这两种情况下会发生什么。某些内部函数必须通过：调用。

f <- function (...) {
    browser()
    fs <- dplyr:::compact_null(rlang::list2(...))
    n <- length(fs)
    error_call <- rlang::current_env()
    if (n == 0) {
        abort("No cases provided.", call = error_call)
    }
    query <- vector("list", n)
    value <- vector("list", n)
    default_env <- rlang::caller_env()
    quos_pairs <- purrr::map2(fs, seq_along(fs), dplyr:::validate_formula, default_env = default_env, 
                                                        dots_env = rlang::current_env(), error_call = error_call)
    for (i in seq_len(n)) {
        pair <- quos_pairs[[i]]
        query[[i]] <- rlang::eval_tidy(pair$lhs, env = default_env)
        value[[i]] <- rlang::eval_tidy(pair$rhs, env = default_env)
        if (!is.logical(query[[i]])) {
            dplyr:::abort_case_when_logical(pair$lhs, i, query[[i]], 
                                                                            error_call = error_call)
        }
    }
    m <- dplyr:::validate_case_when_length(query, value, fs, error_call = error_call)
    out <- value[[1]][rep(NA_integer_, m)]
    replaced <- rep(FALSE, m)
    for (i in seq_len(n)) {
        out <- dplyr:::replace_with(out, query[[i]] & !replaced, value[[i]], 
                                                NULL, error_call = error_call)
        replaced <- replaced | (query[[i]] & !is.na(query[[i]]))
    }
    out
}

和 dplyr 中的助手内部replace_with，

replacer <- function (x, i, val, name, reason = NULL, error_call = rlang::caller_env()) {
    if (is.null(val)) {
        return(x)
    }
    dplyr:::check_length(val, x, name, reason, error_call = error_call)
    dplyr:::check_type(val, x, name, error_call = error_call)
    dplyr:::check_class(val, x, name, error_call = error_call)
    i[is.na(i)] <- FALSE
    if (length(val) == 1L) {
        x[i] <- val
    }
    else {
        x[i] <- val[i]
    }
    x
}

然后通过

x <- character(0)
f(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ "x")
f(rlang::is_empty(x) ~ "Empty", !rlang::is_empty(x) ~ x)

关键在于值m，即在工作情况下导致1L的值，在故障情况下是0L<代码>输出变为字符（0），而不是初始化为NA，长度为1。

已替换应为逻辑向量，指示值是否已替换。在故障情况下，rep（FALSE，0L）是逻辑（0），稍后通过查询！已替换<代码>错误

当传递给替换程序时会给出一个特殊的子集操作字符（0）[logical（0）]，即给出角色（0）。