Clojure-style cond and case macros in R

cond_case.R

library(magrittr)

# Clojure-style cond and case macros in R
# Inspired by
# https://clojuredocs.org/clojure.core/cond and
# https://clojuredocs.org/clojure.core/case.
# See the examples in the bottom.

cond_case_Factory <- function(ENV, obj, message_infix, vectorised, comparFun, ...)  {
    IF <- if (vectorised)
        quote(ifelse) else quote(`if`)
    substitute(list(...)) %>%
        as.list %T>%
        {if (length(.) < 4)
            stop(paste('\ncase requires',
                       message_infix,
                       'at least 3 other arguments!'),
                 call.=FALSE)} %>%
        tail(-1) %T>%
        {if (length(.) %% 2 != 1)
            stop(paste('\ncase requires',
                       message_infix,
                       'an uneven number of arguments!'),
                 call.=FALSE)} %>%
        split(((seq_along(.) + 1)/2) %>%
                  floor) %>%
        rev %>%
        {c(.[[1]], tail(., -1))} %>%
        Reduce(function(x,y)
            `if`(comparFun %>% is.null,
                 bquote(.(IF)(.(y[[1]]),
                              .(y[[2]]), .(x))),
                 bquote(.(IF)(.(comparFun)(.(obj),.(y[[1]])),
                              .(y[[2]]), .(x)))),
            .) %>%
        eval(ENV)
}

cond_Factory <- function(ENV, vectorised, ...)
    cond_case_Factory(ENV, obj=NULL, message_infix="", comparFun=NULL,
                      vectorised=vectorised, ...)

iden <- Vectorize(identical, vectorize.args=c('x','y'), SIMPLIFY=TRUE)

case_Factory <- function(ENV, obj, comparFun, vectorised, ...)
    cond_case_Factory(ENV, obj=obj, message_infix="an object plus",
                      comparFun=comparFun,
                      vectorised=vectorised, ...)

# Clojure-style cond macro in R -- creates nested if-else calls
cond <- function(...)
    cond_Factory(ENV=parent.frame(), vectorised=FALSE, ...)
condv <- function(...)
    cond_Factory(ENV=parent.frame(), vectorised=TRUE, ...)

# More powerful/general than base::switch and vectorised (casev variants below)
case <- function(obj, ...)
    case_Factory(ENV=parent.frame(), obj=obj, comparFun=quote(identical),
                 vectorised=FALSE, ...)
casevid <- function(obj, ...)
    case_Factory(ENV=parent.frame(), obj=obj, comparFun=quote(iden),
                 vectorised=TRUE, ...)
caseveq <- function(obj, ...)
    case_Factory(ENV=parent.frame(), obj=obj, comparFun=quote(`==`),
                 vectorised=TRUE, ...)


# Examples:

# cond
# Example based on the first example from
# https://clojuredocs.org/clojure.core/cond
`pos-neg-or-zero` <- function(n)
                     cond(n < 0, 'negative',
                          n > 0, 'positive',
                                 'zero')
`pos-neg-or-zero`(5)
# => "positive"
`pos-neg-or-zero`(-1)
# => "negative"
`pos-neg-or-zero`(0)
# => "zero"

# case
f <- base::mean
case(f,
     stats::median, 1,
     base::mean,    2,
                    3)
# => 2

x <- c(1/0, as.numeric(NA), NaN, 0)
casevid(x,
        Inf,             "infinity",
        as.numeric(NA),  "not available",
                         "other")
# => "infinity"  "not available"  "other"  "other"
caseveq(x,
        Inf,             "infinity",
        as.numeric(NA),  "not available",
                         "other")
# => "infinity"  NA  NA  NA