为什么在 R 中只有 `case_when` 给出不同的结果？

Question

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

为什么只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 包于 2022 年 8 月 16 日创建(v2.0.1)}

Answer 1

case_when这可能是其内部辅助函数中的错误。browser我们可以在源代码中放入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
}

replace_with和内部的助手dplyr，

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。out变为长度 1，character(0)而不是初始化为NA1。

replaced应该是一个逻辑向量，指示值是否已被替换。错误的情况rep(FALSE, 0L)是logical(0)，稍后通过 via 查询!replaced。FALSE & logical(0)给出logical(0).

当传递给replacerthis 时，会给出一个特殊的子集操作character(0)[logical(0)]，即给出character(0).