A wrapper around nested ifelse

[This article was first published on That’s so Random, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
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)
## [1] "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)
## [1] 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!

To leave a comment for the author, please follow the link and comment on their blog: That’s so Random.

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.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)