# A wrapper around nested ifelse

February 7, 2017
By

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

The `ifelse` function is the way to do vectorised if then else in R. One of the first cool things I learned to do in R a few years back, I got from Norman Matloff’s The Art of R Programming. When you have more than one if then statements, you just nest multiple `ifelse` functions before you reach the else.

``````set.seed(0310)
x <- runif(1000, 1, 20)
y <- runif(1000, 1, 20)

the_old_way <-
ifelse(x < 5 & y < 5, 'A',
ifelse(x < 5 & y < 15, 'B',
ifelse(x < 5, 'C',
ifelse(x < 15 & y < 5, 'D',
ifelse(x < 15 & y < 15, 'E',
ifelse(y < 5, 'F',
ifelse(y < 15, 'G',
'H')))))))
``````

Although this is very functional and fast, it is not exactly pretty. Matters worsen as the variable names get longer and as the logical expressions get more complicated. During the last session of Friday-afternoon-playground at work, I decided to have a go at cleaning this up a bit and having a look at the `lazyeval` package along the way. To fully get my mind around the lazy evaluation philosophy, I will need to revisit the vignette a few times. But the wrapper turned out as I intended.

The idea is simple. Get your if then statements in the function `i`, get your else value in the function `e`, and stitch those together in `ie`.

``````i <- function(if_stat, then) {
if_stat <- lazyeval::expr_text(if_stat)
then    <- lazyeval::expr_text(then)
sprintf("ifelse(%s, %s, ", if_stat, then)
}
i(x < 5 & y < 5, z)
``````
``````##  "ifelse(x < 5 & y < 5, z, "
``````

So `i` takes the logical expression and the value to return when `TRUE`. It spits out a string that is the incomplete part of an `ifelse` function. Next we define the `e` function that returns the final value if all logical statements in the if-statements are evaluated as `FALSE`.

``````e <- function(else_ret) {
else_ret <- lazyeval::expr_text(else_ret)
else_ret
}
``````

And finally we stitch them together. You enter as many `i` functions as you like, but only one `e` function of course.

``````ie <- 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 i functions.", call. = FALSE)
}
}
if (substr(args[[length(args)]], 1, 6) == "ifelse"){
stop("Last argument needs to be an e function.", call. = FALSE)
}
args\$final <- paste(rep(')', length(args) - 1), collapse = '')
eval_string <- do.call('paste', args)
eval(parse(text = eval_string))
}
``````

And there we are. Using the power of the nested `ifelse`, but without the messy code. A whole lot easier to write, read, and debug.

``````the_new_way <-
ie(
i(x < 5 & y < 5,   'A'),
i(x < 5 & y < 15,  'B'),
i(x < 5,           'C'),
i(x < 15 & y < 5,  'D'),
i(x < 15 & y < 15, 'E'),
i(y < 5,           'F'),
i(y < 15,          'G'),
e('H')
)
all.equal(the_old_way, the_new_way)
``````
``````##  TRUE
``````

These functions can be found in the R package on my github, that accompanies this blog. You can easily install it by running `devtools::install_github("edwinth/thatssorandom")`. Enjoy!

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.