r - 嵌套 ifelse : improved syntax

Question

描述

ifelse() 函数允许通过一系列测试过滤向量中的值，如果结果为正，每个测试都会产生不同的 Action 。例如，让 xx 是一个 data.frame，如下:

xx <- data.frame(a=c(1,2,1,3), b=1:4)
xx

a b
1 1
2 2
1 3
3 4

假设您要从列 b 创建一个新列 c ，但根据列 中的值，按以下方式创建 :

对于每一行，

如果 a 列中的值为 1，则 c 列中的值与 b 列中的值相同。

如果 a 列中的值为 2，则 c 列中的值是 b 列中值的 100 倍。

在任何其他情况下，列 c 中的值是列 b 中的值的负数。

使用 ifelse() ，解决方案可能是:

xx$c <- ifelse(xx$a==1, xx$b, 
               ifelse(xx$a==2, xx$b*100,
                      -xx$b))
xx

a b c
1 1 1
2 2 200
1 3 3
3 4 -4

问题一

当测试次数增加时，会出现美学问题，例如四个测试:

xx$c <- ifelse(xx$a==1, xx$b, 
           ifelse(xx$a==2, xx$b*100,
                  ifelse(xx$a==3, ...,
                         ifelse(xx$a==4, ...,
                                ...))))

我在 this page 中找到了该问题的部分解决方案，它包括函数 if.else_(), i_(), e_() 的定义，如下所示:

library(lazyeval)
i_ <- function(if_stat, then) {
    if_stat <- lazyeval::expr_text(if_stat)
    then    <- lazyeval::expr_text(then)
    sprintf("ifelse(%s, %s, ", if_stat, then)
}

e_ <- function(else_ret) {
    else_ret <- lazyeval::expr_text(else_ret)
    else_ret
}

if.else_ <- function(...) {
    args <- list(...)

    for (i in 1:(length(args) - 1) ) {
        if (substr(args[[i]], 1, 6) != "ifelse") {
            stop("All but the last argument, need to be if.then_ functions.", call. = FALSE)
        }
    }
    if (substr(args[[length(args)]], 1, 6) == "ifelse"){
        stop("Last argument needs to be an else_ function.", call. = FALSE)
    }
    args$final <- paste(rep(')', length(args) - 1), collapse = '')
    eval_string <- do.call('paste', args)
    eval(parse(text = eval_string))
}

这样， 描述 中给出的问题，可以改写如下:

xx <- data.frame(a=c(1,2,1,3), b=1:4)
xx$c <- if.else_(
    i_(xx$a==1, xx$b),
    i_(xx$a==2, xx$b*100),
    e_(-xx$b)
) 
xx

a b c
1 1 1
2 2 200
1 3 3
3 4 -4

四个测试的代码将是:

xx$c <- if.else_(
    i_(xx$a==1, xx$b),
    i_(xx$a==2, xx$b*100),
    i_(xx$a==3, ...), # dots meaning actions for xx$a==3
    i_(xx$a==4, ...), # dots meaning actions for xx$a==4
    e_(...)           # dots meaning actions for any other case
) 

问题 2 & 问题

给定的代码显然解决了这个问题。然后，我编写了以下测试函数:

test.ie <- function() {
    dd <- data.frame(a=c(1,2,1,3), b=1:4)
    if.else_(
        i_(dd$a==1, dd$b),
        i_(dd$a==2, dd$b*100),
        e_(-dd$b)
    ) # it should give c(1, 200, 3, -4)
}

当我尝试测试时:

 test.ie()

它吐出以下错误消息:

Error in ifelse(dd$a == 1, dd$b, ifelse(dd$a == 2, dd$b * 100, -dd$b)) :
object 'dd' not found

问题

由于 if.else_() 语法构造函数不应该只从控制台运行，有没有办法让它从调用它的函数中“知道”变量？

笔记

在“Best way to replace a lengthy ifelse structure in R ”中，发布了一个类似的问题。但是，那里给定的解决方案侧重于使用给定的 常量 输出值(ifelse() 函数的“then”或“else”槽)构建表的新列，而我的案例解决了一个句法问题，其中“then"或 "else"槽甚至可以是其他 data.frame 元素或变量的表达式。

Answer 1

完全尊重 OP 为改进嵌套 ifelse() 所做的非凡努力，我更喜欢一种不同的方法，我认为它易于编写、简洁、可维护且快速:

xx <- data.frame(a=c(1L,2L,1L,3L), b=1:4)

library(data.table)
# coerce to data.table, and set the default first
setDT(xx)[, c:= -b]
xx[a == 1L, c := b]        # 1st special case
xx[a == 2L, c := 100L*b]   # 2nd special case, note use of integer 100L
# xx[a == 3L, c := ...]    # other cases
# xx[a == 4L, c := ...]
#...

xx
#   a b   c
#1: 1 1   1
#2: 2 2 200
#3: 1 3   3
#4: 3 4  -4     

请注意，对于第二个特殊情况，b 乘以整数常量 100L 以确保右侧都是整数类型，以避免类型转换为 double 型。

编辑 2: 这也可以以更简洁(但仍可维护)的方式编写为单行:

setDT(xx)[, c:= -b][a == 1L, c := b][a == 2L, c := 100*b][]

data.table 链在这里工作，因为 c 就地更新，以便后续表达式作用于 xx 的所有行，即使前一个表达式是行子集的选择性更新。

编辑 1: 这种方法也可以用基 R 实现:

xx <- data.frame(a=c(1L,2L,1L,3L), b=1:4)

xx$c <- -xx$b
idx <- xx$a == 1L; xx$c[idx] <- xx$b[idx]
idx <- xx$a == 2L; xx$c[idx] <- 100 * xx$b[idx]

xx
#  a b   c
#1 1 1   1
#2 2 2 200
#3 1 3   3
#4 3 4  -4