R - How to create a custom Ifelse function that repeats

Question

I am well acquainted with the R standard ifelse statement and how to create nested ifelse statements. However, I want to create a “better” version, so I don’t need to copy / paste ifelse many times.

Take this nested ifelse statement, for example:

df <- data.frame(b = 1:5)

df$a <- ifelse(df$b == 1,1,
        ifelse(df$b == 2,2,
        ifelse(df$b == 3,3,4)))

Instead, I would like to create such a function as I could in this way:

df$a <- myFunction(df$b == 1,1,
                   df$b == 2,2,
                   df$b == 3,3,4)

I would like the function to be able to select how many arguments I entered, and therefore I know how many ifelse statements to include, and then connect the arguments to the correct position, right down to how much I want.

There is still some repetition, but when creating longer nested ifelse statements, it would be nice not to repeat this piece of code, and then try to keep track of paren's ending.

Answer 1

Reduce() ifelse(), eval() it:

ifelses <- function(...) {
    ## validate number of args is at least 3 and odd
    stopifnot(nargs()>=3L);
    stopifnot(nargs()%%2L==1L);
    ## precompute the required number of calls and the argument parse tree list
    num <- (nargs()-1L)%/%2L;
    cl <- match.call();
    ## build up the parse tree of nested ifelse() calls using Reduce(), then eval() it
    ## terminology (following docs): ifelse(test,yes,no)
    eval(Reduce(
        function(i,noArg) call('ifelse',cl[[i]],cl[[i+1L]],noArg),
        seq(2L,by=2L,len=num), ## indexes of "test" args
        cl[[length(cl)]], ## first (innermost) "no" arg
        T ## proceed from right-to-left, IOW inside-out wrt parse tree
    ));
}; ## end ifelses()

:

• nargs()
• stopifnot()
• match.call()
• Reduce()
• call()
• eval()
• seq()
• ifelse()

:

ifelses(c(F,T,F,F),1:4,c(T,F,F,F),5:8,c(F,T,F,T),9:12,13:16);
## [1]  5  2 15 12

OP:

df <- data.frame(b=1:5);
df$a <- ifelses(df$b==1L,1L,df$b==2L,2L,df$b==3L,3L,4L);
df;
##   b a
## 1 1 1
## 2 2 2
## 3 3 3
## 4 4 4
## 5 5 4

Answer 2

- if_val expss

 b = sample(1:7, 10, replace = TRUE)
 if_val(b, 1 ~ 1, 2 ~ 2, 3 ~ 3, other ~ 4)

ifs: ifs(b==1 ~ 1, b==2 ~ 2, b==3 ~ 3, TRUE ~ 4).

Answer 3

. , :

df <- data.frame(b = 1:5)

lookupif <- function(df, x, y, else.val = NA, on.col, res.col = "val") {
 lookup <- data.frame(x, y)
 names(lookup)[1] <- res.col
 df <- merge(df, lookup, by.x = on.col, by.y = "y", all.x = TRUE)
 df[is.na(df[[res.col]]), res.col] <- else.val
 df
}

lookupif(df, 1:3, 1:3, 4, "b")
#  b val
#1 1   1
#2 2   2
#3 3   3
#4 4   4
#5 5   4

Answer 4

dplyr::case_when ifelse s, .

library(dplyr)

df <- data.frame(b = 1:5)

df %>% mutate(a = case_when(b == 1 ~ 1, 
                            b == 2 ~ 2, 
                            b == 3 ~ 3, 
                            TRUE ~ 4))
#>   b a
#> 1 1 1
#> 2 2 2
#> 3 3 3
#> 4 4 4
#> 5 5 4

:

df$a <- with(df, dplyr::case_when(b == 1 ~ 1, 
                                  b == 2 ~ 2, 
                                  b == 3 ~ 3, 
                                  TRUE ~ 4))

.

Since it is already as simple as you can get without sacrificing versatility ifelse, it may not need to be injected into a function, but it could if you want. Using the development version of new rlang NSE Syntax,

add_cases <- function(.data, .col, ...){
    .data %>% mutate(!!.col := case_when(!!!quos(...)))
}

df %>% add_cases(.col = 'a', 
                 b == 1 ~ 1,
                 b == 2 ~ 2,
                 b == 3 ~ 3,
                 TRUE ~ 4)
#>   b a
#> 1 1 1
#> 2 2 2
#> 3 3 3
#> 4 4 4
#> 5 5 4