嵌套ifelse:改进的语法

Question

描述

ifelse() 函数允许通过一系列测试过滤向量中的值,每个测试都会产生不同的操作.例如,xx设为data.frame,如下所示:

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

ab
1 1
2 2
1 3
3 4

假设您要从列b创建新列c,但是根据以下方式列a中的值:

对于每一行,

• 如果列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

abc
1 1
2 2 2 200
1 3 3
3 4 -4

问题1

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

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

我在这个页面找到了问题的部分解决方案,其中包括函数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))
}

这样,Description中给出的问题可以改写如下:

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

abc
1 1
2 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()

它吐出以下错误消息:

ifelse错误(dd $ a == 1,dd $ b,ifelse(dd $ a == 2,dd $ b*100,-dd $ b)):
找不到对象'dd'

题

由于if.else_()语法构造函数不应仅仅从控制台运行,它是否有办法从调用它的函数中"知道"变量？

注意

在" 替换R中冗长的ifelse结构的最佳方式 "中,发布了类似的问题.但是,给定的解决方案专注于使用给定的常量输出值(ifelse()函数的"then"或"else"槽)构建表的新列,而我的案例解决了句法问题,其中"then"或"else"槽甚至可以是其他data.frame元素或变量的表达式.

Answer 1

我认为你可以用dplyr::case_when内部dplyr::mutate来实现这一目标.

library(dplyr)

df <- tibble(a=c(1,2,1,3), b=1:4)

df %>% 
  mutate(
    foo = case_when(
      .$a == 1 ~ .$b,
      .$a == 2 ~ .$b * 100L,
      TRUE   ~ .$b * -1L
    )
  )

#> # A tibble: 4 x 3
#>       a     b   foo
#>   <dbl> <int> <int>
#> 1     1     1     1
#> 2     2     2   200
#> 3     1     3     3
#> 4     3     4    -4

在即将到来的续约中dplyr 0.6.0你不需要使用akward work-around .$,你可以使用:

df %>% 
  mutate(
    foo = case_when(
      a == 1 ~ b,
      a == 2 ~ b * 100L,
      TRUE   ~ b * -1L
    )
  )

Answer 2

充分尊重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