R 嵌套ifelse：改进的语法 描述

ifelse（）函数允许通过一系列测试过滤向量中的值，如果结果为正，每个测试都会产生不同的操作。例如，将

xx

设为data.frame，如下所示：

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

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

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), envir = parent.frame())
}

它会发出以下错误消息：

ifelse中的错误（dd$a==1，dd$b，ifelse（dd$a==2，dd$b*100，-dd$b））：
找不到对象“dd”

问题: 既然if.else\uuz（）语法构造函数不应该只从控制台运行，那么它有没有办法从调用它的函数中“知道”变量

注 在“”中，发布了类似的问题。但是，给定的解决方案侧重于使用给定的常量输出值（ifelse（）函数的“then”或“else”槽）构建表的新列，而我的案例解决了一个语法问题，其中“then”或“else”是插槽甚至可以是其他data.frame元素或变量的表达式。

我认为您可以使用inside来实现这一点

库（dplyr）
df%
变异(
foo=case\u当(
.$a==1~.$b，
.$a==2~.$b*100L，
正确~.$b*-1L
)
)
#>#tibble:4 x 3
#>阿福
#>     
#> 1     1     1     1
#> 2     2     2   200
#> 3     1     3     3
#> 4     3     4    -4

在即将发布的

dplyr 0.6.0

中，您不需要使用

$

的akward解决方案，只需使用：

df%>%
变异(
foo=case\u当(
a==1~b，
a==2~b*100L，
真~b*-1L
)
)

考虑到建议，我将if.else（）函数重新编码如下：

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

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

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), envir = parent.frame())
}

[1] 12003-4

---

充分考虑到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     

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

---

xx与其调试这个eval/parse废话，不如在
dplyr
库中使用类似于
case\u的东西。或者您可以在
父框架（）中将函数更改为eval
可能重复的
xx$b*c（-1,1100,1）[交互（xx$a==1，xx$a==2）]
-总是有方法的。这可能不适用于所有情况，但这类事情是可能的。请您解释一下为什么要将所有右侧表达式分别包装在
as.double（）
中？是的，这是因为
对类型要求严格，因此第一行
b
是一个整数，但是
b*100
变成了一个双精度，所以所有的东西都应该是双精度的。中的严格性旨在使输出类型更可预测，并使其更快。我明白了，这是一个很好的观点。谢谢你的暗示。如果使用整数常量
100L
相乘以保持RHS all为整数，可能可以避免显式类型转换为double？我只是相应地修改了我的答案。是的，那绝对是真的，（我会更新我的答案）。我只是在想，在你真正的用例中，它可能不全是整数，然后它就不工作了。太好了！当我第一次接触嵌套的ifelse（）主题时，这是因为我正在寻找一些类似于C++开关（）{case:…}构造的简单语法构造。这个答案符合我的期望：这是最简单、最容易理解、也是我认为最有效的方法。@JulioSergio首先，我不确定是否应该发布这个建议，这似乎与你的问题相去甚远。但多亏了你的反馈，我很高兴我做到了。这太令人鼓舞了！
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     

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

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