#' Facilities for writing R code in prefix notation
#'
#' The \code{.} function allows writing an R function call in a Lisp-like
#' prefix format, rather than the Algol-like infix format that R usually
#' uses. \code{prefix} and \code{infix} convert R code between infix and
#' prefix.
#'
#' When evaluated, a call to \code{.} doesn't actually execute the function
#' that's been expressed in prefix style, just generates the corresponding
#' infix call. It's intended as a notational aid, so that entire scripts
#' can be written in the prefix form.
#'
#' A call to \code{prefix()} does not evaluate the passed
#' or the generated expressions, partly for efficiency reasons; \code{infix()},
#' though it still does not evaluate the generated expression, does do
#' partial evaluation of the passed expression: each call to \code{.} is
#' evaluated to the corresponding infix call.
#'
#' \code{infix} and \code{prefix} are not quite inverses of each other, because
#' \code{infix} understands certain pieces of infix syntactic sugar. Examples
#' include the ".q" and ".b" quoting abbreviations, and the lambda lists passed
#' to \code{lambda}, \code{macro} and \code{defmacro}.
#'
#' @param expr A prefix- or infix-formatted expression to convert. Code between
#' "R(" and ")" will not be converted.
#'
#' @return \code{prefix} and \code{infix} return the input expression
#' converted to prefix or infix.
#'
#' @examples
#' prefix(expression(x <- runif(10), y <- runif(10), cor(x, y)))
#'
#' prefix(expression(with(datasets::iris, sum(Sepal.Length^2 + Petal.Width))))
#'
#' @name prefix
#' @rdname prefix
#' @export
prefix <-
function(expr)
{
if(is.expression(expr))
{
lst <- lapply(as.list(expr), prefix)
return(as.expression(lst))
} else if(is.call(expr))
{
if(expr[[1]] == as.symbol("R"))
{
if(length(expr) != 2)
{
stop("R() must have exactly one argument")
}
return(expr[[2]])
}
#Already prefix-ified code should be idempotent under this function
if(expr[[1]] == as.symbol("."))
{
return(as.call(lapply(as.list(expr), prefix)))
}
lst <- lapply(as.list(expr), prefix)
lst <- c(as.symbol("."), lst)
return(as.call(lst))
} else
{
return(expr)
}
}
#' @examples
#'
#' infix(expression(.(`<-`, x, .(runif, 10)), .(`<-`, y, .(runif, 10)),
#' .(cor, x, y)))
#'
#' infix(expression(.(with, .(`::`, datasets, iris),
#' .(sum, .(`+`, .(`^`, Sepal.Length, 2),
#' Petal.Width)))))
#' @rdname prefix
#' @export
infix <-
function(expr)
{
s1 <- infix_transform_dots(expr)
s2 <- infix_transform_quotes(s1)
return(s2)
}
# Stage 1 of prefix=>infix processing
#
# This function takes an expression in full Lisp-like prefix syntax and does
# a few types of processing to bring it closer to the usual R infix syntax.
# First, calls to "." are evaluated and expand to match.call()[-1], but any
# occurrences of the R() construction are not modified.
#
# @param expr The expression to process
#
# @return The transformed expression in a form suitable for passing on to
# infix_remove_quotes
infix_transform_dots <-
function(expr)
{
if(is.expression(expr))
{
lst <- lapply(as.list(expr), infix_transform_dots)
return(as.expression(lst))
} else if(is.call(expr))
{
#Don't convert this - allow embedding R code in the usual infix
#style in blocks of prefix code
if(expr[[1]] == as.symbol("R"))
{
if(length(expr) != 2)
{
stop("R() must have exactly one argument")
}
return(expr[[2]])
} else if(expr[[1]] == as.symbol("."))
{
#Most of what in Lisp are special forms can be handled in the usual
#R way with substitute() and quoting; the exception is the
#parameter lists given to lambda, macro and defmacro, when they
#contain default values. If we don't handle these here, expressions
#like
# .(lambda, .(n=.(curry, `+`, 4), m), .(n, m))
#will not be turned into the correct infix form.
if(expr[[2]] == as.symbol("lambda") ||
expr[[2]] == as.symbol("macro"))
{
params <- as.list(expr[[3]])[-1]
params <- lapply(params, infix_transform_dots)
if(is.null(names(params)))
nms <- replicate(length(params), "")
else
nms <- names(params)
vals <- list()
for(i in seq_along(params))
{
#passing "m" and "m=" are equivalent, but because R is
#terrible, are represented differently. this case is what
#we see when you pass "m" w/o the equals sign
if(nms[[i]] == "")
{
nm <- as.character(params[[i]])
#This one takes some explanation: in building a function by
#hand, the formal argument list is passed in to the "function"
#constructor as a pairlist, whose tags are used as the argument
#names. The values become the argument defaults. If you want an
#argument with no default, which will raise an error if missing,
#the value that has to be passed in is a zero-length symbol.
#There's no obvious way to generate one of these: as.symbol("") and
#related constructs all raise errors. But, as it turns out, alist()
#returns them for arguments that have a tag but no value. The fact
#that this little trick is possible saves us from having to write C
#to generate the necessary zero-length name.
vals[[nm]] <- alist(x=)$x
}
else
{
nm <- as.character(nms[[i]])
vals[[nm]] <- params[[i]] #don't eval
}
}
body <- lapply(as.list(expr[4:length(expr)]),
infix_transform_dots)
return(as.call(c(expr[[2]], list(vals), body)))
} else if(expr[[2]] == as.symbol("defmacro"))
{
name <- expr[[3]]
params <- as.list(expr[[4]])[-1]
params <- lapply(params, infix_transform_dots)
if(is.null(names(params)))
nms <- replicate(length(params), "")
else
nms <- names(params)
vals <- list()
for(i in seq_along(params))
{
if(nms[[i]] == "")
{
nm <- as.character(params[[i]])
vals[[nm]] <- alist(x=)$x
}
else
{
nm <- as.character(nms[[i]])
vals[[nm]] <- params[[i]]
}
}
body <- lapply(as.list(expr[5:length(expr)]),
infix_transform_dots)
return(as.call(c(expr[[2]], name, list(vals), body)))
} else
{
env <- new.env(parent=emptyenv())
assign(".", `.`, envir=env)
expr <- eval(expr, envir=env)
}
}
#Not the else clause - run this regardless
lst <- lapply(as.list(expr), infix_transform_dots)
return(as.call(lst))
} else
{
return(expr)
}
}
# Stage 2 of prefix=>infix processing
#
# This function takes the output of stage 1 (infix_transform_dots), which has
# had "." removed, and then handles a few additional pieces of syntactic
# sugar: ".q" is transformed into a call to base R's quote(), and .b is
# transformed into a call to our quasiquote(), which is like Scheme's
# quasiquote in that it handles by comma (written ".c" here) and comma-at
# (written ".s" for "splice"). The R() construction is again respected and
# expressions so escaped are not modified. (R's bquote is not quite powerful
# enough, so we had to roll our own quasiquote function.)
#
# @param expr The expression to process
#
# @return The transformed expression in infix syntax
infix_transform_quotes <-
function(expr)
{
if(is.expression(expr))
{
lst <- lapply(as.list(expr), infix_transform_quotes)
return(as.expression(lst))
} else if(is.call(expr))
{
#We still need to avoid modifying this in stage 2
if(expr[[1]] == as.symbol("R"))
{
if(length(expr) != 2)
{
stop("R() must have exactly one argument")
}
return(expr[[2]])
} else if(expr[[1]] == as.symbol(".q"))
{
lst <- lapply(as.list(expr[-1]), infix_transform_quotes)
return(as.call(c(as.symbol("quote"), lst)))
} else if(expr[[1]] == as.symbol(".b"))
{
lst <- lapply(as.list(expr[-1]), infix_transform_quotes)
return(as.call(c(as.symbol("quasiquote"), lst)))
} else
{
lst <- lapply(as.list(expr), infix_transform_quotes)
return(as.call(lst))
}
} else
{
return(expr)
}
}
#' @param f The function that \code{.} should generate a call to.
#' @param ... Further arguments to the function f.
#'
#' @return \code{.} returns an unevaluated call to f with \code{...} arguments
#' carried through.
#'
#' @examples
#' .(`+`, 1, 2)
#'
#' .(sum, .(runif, 10), .(runif, 10))
#'
#' @rdname prefix
#' @export
. <-
function(f, ...)
{
match.call()[-1]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.