R - How to Create Custom Ifelse function that repeats

Question

I am quite familiar with R's standard ifelse statement, and how to create nested ifelse statements. I however want to create a "better" version, so that I dont have to copy / paste ifelse so 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, what I would like to do is create a function like I could call like this:

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

I would want the function to be able to pick up how many arguments I have entered, and thus know how many ifelse statements to include and then plug the arguments into the correct position, up to however many I want.

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

Answer 1

We can use Reduce() to build up the required parse tree of nested ifelse() calls and then 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()

Useful docs:

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

Demo:

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's example:

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

This is a job for merging with a lookup table. You can wrap that in a function, but usually I wouldn't bother:

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 3

dplyr::case_when is a cascading alternative to nested ifelses, e.g.

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

or just steal it and put it in base syntax:

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

which returns the same thing.

Since it's already about as simple as you can get without sacrificing the versatility of ifelse, it may not need to be put into a function, but it could, if you like. Using the development version's 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