Nothing
.BLANK <- list(quote(expr =))
fn_factory <- function(function_) {
function(..., ..env = parent.frame()) {
if (!is.environment(..env))
abort("'..env' must be an environment")
d <- get_fn_declaration(...)
function_(d$args, d$body, ..env)
}
}
get_fn_declaration <- function(...) {
xs <- get_exprs(...)
args <- get_args(xs$front)
remains <- behead(xs$back)
list(args = c(args, remains$head), body = remains$body)
}
get_exprs <- function(...) {
xs <- validate(exprs_(...))
n <- length(xs)
list(front = xs[-n], back = xs[n])
}
validate <- function(xs, n) {
if (is_empty(xs))
abort("No function specified")
n <- length(xs)
is_fml <- vapply(xs, is_formula, logical(1))
if (any(is_fml[-n]))
abort("Only the body (as last argument) should be a formula")
if (!is_fml[n])
abort("Final argument must be a formula (specifying the body)")
xs
}
get_args <- function(xs) {
if (is_empty(xs))
return(NULL)
standardize_bare_arguments(xs)
}
standardize_bare_arguments <- function(xs) {
no_name <- !nzchar(names(xs))
names(xs)[no_name] <- vapply(xs[no_name], expr_name, character(1))
xs[no_name] <- .BLANK
xs
}
behead <- function(x) {
list(head = get_head(x), body = f_rhs(x[[1]]))
}
get_head <- function(x) {
nm <- names(x)
arg <- f_lhs(x[[1]])
if (is_onesided(x[[1]]))
get_empty_head(nm)
else
get_nonempty_head(arg, nm)
}
is_onesided <- function(x) {
length(x) == 2
}
get_empty_head <- function(nm) {
if (nzchar(nm))
abort("Default value of final argument is missing")
NULL
}
get_nonempty_head <- function(arg, nm) {
if (nzchar(nm))
`names<-`(list(arg), nm)
else
`names<-`(.BLANK, expr_name(arg))
}
make_function <- function(args, body, env) {
stopifnot(all(have_name(args)), is.environment(env))
if (is_closure(body)) {
body <- call("function", formals(body), base::body(body))
} else if (!is_expression(body) && !is_call(body)) {
abort("Body must be an expression or closure.")
}
args <- as.pairlist(args)
eval(call("function", args, body), env)
}
#' Low-cost anonymous functions
#'
#' `fn()` enables you to create (anonymous) functions, of arbitrary call
#' signature. Use it in place of the usual `function()` invocation whenever you
#' want to:
#' \itemize{
#' \item type less:
#' \preformatted{
#' fn(x, y = 1 ~ x + y)
#' function(x, y = 1) x + y}
#' are equivalent
#' \item guard against changes in lexical scope: by enabling tidyverse
#' [quasiquotation][rlang::quasiquotation], `fn()` allows you to
#' \dQuote{burn in} values at the point of function creation (see
#' _Pure functions via quasiquotation_)
#' }
#'
#' @param ... Function declaration, which supports
#' [quasiquotation][rlang::quasiquotation].
#' @param ..env Environment in which to create the function (i.e., the
#' function’s [enclosing environment][base::environment]).
#'
#' @return A function whose enclosing environment is `..env`.
#'
#' @section Function declarations: A _function declaration_ is an expression
#' that specifies a function’s arguments and body, as a comma-separated
#' expression of the form
#' ```
#' arg1, arg2, ..., argN ~ body
#' ```
#' or
#' ```
#' arg1, arg2, ..., argN, ~ body
#' ```
#' (Note in the second form that the body is a one-sided formula. This
#' distinction is relevant for argument [splicing][rlang::quasiquotation], see
#' below.)
#'
#' - To the left of `~`, you write a conventional function-argument
#' declaration, just as in `function(<arguments>)`: each of `arg1`, `arg2`,
#' \dots, `argN` is either a bare argument (e.g., `x` or `...`) or an
#' argument with default value (e.g., `x = 1`).
#'
#' - To the right of `~`, you write the function body,
#' i.e., an expression of the arguments.
#'
#' \subsection{Quasiquotation}{
#' All parts of a function declaration support tidyverse
#' [quasiquotation][rlang::quasiquotation]:
#' \itemize{
#' \item To unquote values (of arguments or parts of the body), use `!!`:
#' \preformatted{
#' z <- 0
#' fn(x, y = !!z ~ x + y)
#' fn(x ~ x > !!z)}
#' \item To unquote argument names (with default value), use `:=`
#' (definition operator):
#' \preformatted{
#' arg <- "y"
#' fn(x, !!arg := 0 ~ x + !!as.name(arg))}
#' \item To splice in a (formal) list of arguments, use `!!!`:
#' \preformatted{
#' fn(!!!alist(x, y = 0), ~ x + y)}
#' (Note that the body, in this case, must be given as a one-sided
#' formula.)
#' \item To write literal unquoting operators, use `QUQ()`, `QUQS()`:
#' \preformatted{
#' library(dplyr)
#'
#' my_summarise <- fn(df, ... ~ {
#' group_by <- quos(...)
#' df \%>\%
#' group_by(QUQS(group_by)) \%>\%
#' summarise(a = mean(a))
#' })}
#' (Source:
#' _[Programming with dplyr](https://dplyr.tidyverse.org/articles/programming.html)_)
#' }
#' }
#'
#' @section Pure functions via quasiquotation: Functions in R are generally
#' [impure](https://en.wikipedia.org/wiki/Pure_function), i.e., the return
#' value of a function will _not_ in general be determined by the value of its
#' inputs alone. This is because a function may depend on mutable objects in
#' its
#' [lexical scope](https://adv-r.hadley.nz/functions.html#lexical-scoping).
#' Normally this isn’t an issue. But if you are working interactively and
#' sourcing files into the global environment, say, or using a notebook
#' interface (like Jupyter or R Notebook), it can be tricky to ensure that you
#' haven’t unwittingly mutated an object that an earlier function depends upon.
#'
#' **Example** — Consider the following function:
#' ```
#' a <- 1
#' foo <- function(x) x + a
#' ```
#' What is the value of `foo(1)`? It is not necessarily `2`, because the value
#' of `a` may have changed between the _creation_ of `foo()` and the _calling_
#' of `foo(1)`:
#' ```
#' foo(1) #> [1] 2
#' a <- 0
#' foo(1) #> [1] 1
#' ```
#' In other words, `foo()` is impure because the value of `foo(x)` depends not
#' only on the value of `x` but also on the _externally mutable_ value of `a`.
#'
#' `fn()` enables you to write _pure_ functions by using quasiquotation to
#' eliminate such indeterminacy.
#'
#' **Example** — With `fn()`, you can unquote `a` to \dQuote{burn in} its
#' value at the point of creation:
#' ```
#' a <- 1
#' foo <- fn(x ~ x + !!a)
#' ```
#' Now `foo()` is a pure function, unaffected by changes in its lexical scope:
#' ```
#' foo(1) #> [1] 2
#' a <- 0
#' foo(1) #> [1] 2
#' ```
#'
#' @seealso [as_fn()], [make_fn_aware()], [curry_fn()]
#'
#' @examples
#' fn(x ~ x + 1)
#' fn(x, y ~ x + y)
#' fn(x, y = 2 ~ x + y)
#' fn(x, y = 1, ... ~ log(x + y, ...))
#'
#' ## to specify '...' in the middle, write '... = '
#' fn(x, ... = , y ~ log(x + y, ...))
#'
#' ## use one-sided formula for constant functions or commands
#' fn(~ NA)
#' fn(~ message("!"))
#'
#' ## unquoting is supported (using `!!` from rlang)
#' zero <- 0
#' fn(x = !!zero ~ x > !!zero)
#'
#' ## formals and function bodies can also be spliced in
#' f <- function(x, y) x + y
#' g <- function(y, x, ...) x - y
#' frankenstein <- fn(!!!formals(f), ~ !!body(g))
#' stopifnot(identical(frankenstein, function(x, y) x - y))
#'
#' ## mixing unquoting and literal unquoting is possible
#' if (suppressWarnings(require(dplyr))) {
#' summariser <- quote(mean)
#'
#' my_summarise <- fn(df, ... ~ {
#' group_by <- quos(...)
#' df %>%
#' group_by(QUQS(group_by)) %>%
#' summarise(a = `!!`(summariser)(a))
#' })
#'
#' my_summarise
#' }
#'
#' @export
fn <- fn_factory(make_function)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.